summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/cjr_print.sml3
-rw-r--r--src/mysql.sml13
-rw-r--r--src/postgres.sml6
-rw-r--r--src/settings.sig5
-rw-r--r--src/settings.sml5
5 files changed, 23 insertions, 9 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 3e4ccdd0..6dc3a83c 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1605,7 +1605,8 @@ fun p_exp' par env (e, loc) =
space,
string "=",
space,
- p_getcol {wontLeakStrings = wontLeakStrings,
+ p_getcol {loc = loc,
+ wontLeakStrings = wontLeakStrings,
col = i,
typ = sql_type_in env t},
string ";",
diff --git a/src/mysql.sml b/src/mysql.sml
index e6d42687..eef05a6a 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -596,7 +596,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
newline]
end
-fun p_getcol {wontLeakStrings = _, col = i, typ = t} =
+fun p_getcol {loc, wontLeakStrings = _, col = i, typ = t} =
let
fun getter t =
case t of
@@ -933,7 +933,11 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
newline,
string "if (stmt == NULL) uw_error(ctx, FATAL, \"Out of memory allocating prepared statement\");",
newline,
- string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
+ if nested then
+ box [string "uw_push_cleanup(ctx, (void (*)(void *))mysql_stmt_close, stmt);",
+ newline]
+ else
+ box [],
string "if (mysql_stmt_prepare(stmt, \"",
string (String.toString query),
string "\", ",
@@ -946,6 +950,11 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
newline,
string "msg[1023] = 0;",
newline,
+ if nested then
+ box []
+ else
+ box [string "mysql_stmt_close(stmt);",
+ newline],
string "uw_error(ctx, FATAL, \"Error preparing statement: %s\", msg);",
newline],
string "}",
diff --git a/src/postgres.sml b/src/postgres.sml
index e1ef0514..163bc0b8 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -494,7 +494,7 @@ fun init {dbstring, prepared = ss, tables, views, sequences} =
newline,
string "}"]
-fun p_getcol {wontLeakStrings, col = i, typ = t} =
+fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
let
fun p_unsql t e eLen =
case t of
@@ -550,7 +550,9 @@ fun p_getcol {wontLeakStrings, col = i, typ = t} =
space,
string "tmp;",
newline,
- string "uw_error(ctx, FATAL, \"Unexpectedly NULL field #",
+ string "uw_error(ctx, FATAL, \"",
+ string (ErrorMsg.spanToString loc),
+ string ": Unexpectedly NULL field #",
string (Int.toString i),
string "\");",
newline,
diff --git a/src/settings.sig b/src/settings.sig
index c1a6d871..f6b005b9 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -131,12 +131,13 @@ signature SETTINGS = sig
sequences : string list} -> Print.PD.pp_desc,
(* Define uw_client_init(), uw_db_init(), uw_db_close(), uw_db_begin(), uw_db_commit(), and uw_db_rollback() *)
query : {loc : ErrorMsg.span, cols : sql_type list,
- doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
+ doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
-> Print.PD.pp_desc}
-> Print.PD.pp_desc,
queryPrepared : {loc : ErrorMsg.span, id : int, query : string,
inputs : sql_type list, cols : sql_type list,
- doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
+ doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int,
+ typ : sql_type} -> Print.PD.pp_desc)
-> Print.PD.pp_desc,
nested : bool}
-> Print.PD.pp_desc,
diff --git a/src/settings.sml b/src/settings.sml
index 812e323f..d47e7d0e 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -321,12 +321,13 @@ type dbms = {
views : (string * (string * sql_type) list) list,
sequences : string list} -> Print.PD.pp_desc,
query : {loc : ErrorMsg.span, cols : sql_type list,
- doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
+ doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
-> Print.PD.pp_desc}
-> Print.PD.pp_desc,
queryPrepared : {loc : ErrorMsg.span, id : int, query : string,
inputs : sql_type list, cols : sql_type list,
- doCols : ({wontLeakStrings : bool, col : int, typ : sql_type} -> Print.PD.pp_desc)
+ doCols : ({loc : ErrorMsg.span, wontLeakStrings : bool, col : int,
+ typ : sql_type} -> Print.PD.pp_desc)
-> Print.PD.pp_desc,
nested : bool}
-> Print.PD.pp_desc,