diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/cjr_print.sml | 3 | ||||
| -rw-r--r-- | src/mysql.sml | 13 | ||||
| -rw-r--r-- | src/postgres.sml | 6 | ||||
| -rw-r--r-- | src/settings.sig | 5 | ||||
| -rw-r--r-- | src/settings.sml | 5 |
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, |