summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-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
-rw-r--r--tests/nested.ur29
-rw-r--r--tests/nested.urp5
-rw-r--r--tests/nested.urs1
8 files changed, 58 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,
diff --git a/tests/nested.ur b/tests/nested.ur
new file mode 100644
index 00000000..a23ae2ac
--- /dev/null
+++ b/tests/nested.ur
@@ -0,0 +1,29 @@
+table t : {A : int, B : int}
+
+fun init () =
+ dml (DELETE FROM t WHERE TRUE);
+ dml (INSERT INTO t (A, B) VALUES (1, 2));
+ dml (INSERT INTO t (A, B) VALUES (2, 3))
+
+fun easy () =
+ queryX' (SELECT MAX(t.A) AS M FROM t)
+ (fn r =>
+ queryX (SELECT * FROM t WHERE t.A = {[r.M]})
+ (fn r => <xml>({[r.T.A]}, {[r.T.B]})</xml>))
+
+fun hard id =
+ queryX' (SELECT t.B AS N FROM t WHERE t.A = {[id]})
+ (fn r =>
+ b <- hard r.N;
+ return <xml>({[id]}, {[r.N]}); {b}</xml>)
+
+fun doit () =
+ init ();
+ b1 <- easy ();
+ b2 <- hard 1;
+ return <xml><body>
+ {b1}<br/>
+ {b2}
+ </body></xml>
+
+fun main () = return <xml><body><form><submit action={doit}/></form></body></xml>
diff --git a/tests/nested.urp b/tests/nested.urp
new file mode 100644
index 00000000..67cb7e1d
--- /dev/null
+++ b/tests/nested.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=nested
+sql nested.sql
+
+nested
diff --git a/tests/nested.urs b/tests/nested.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/nested.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-04 12:10:17 +0000