Testing nested queries

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