# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1247847934 14400
# Node ID 8e9f2d247dba030981bd3966e5f8840cf085b7b7
# Parent  b2a175a0f2efe23c8f293bd511c36ceb1b193e8e
Testing nested queries

diff -r b2a175a0f2ef -r 8e9f2d247dba src/cjr_print.sml
--- a/src/cjr_print.sml	Thu Jul 16 18:10:29 2009 -0400
+++ b/src/cjr_print.sml	Fri Jul 17 12:25:34 2009 -0400
@@ -1605,7 +1605,8 @@
                                                    space,
                                                    string "=",
                                                    space,
-                                                   p_getcol {wontLeakStrings = wontLeakStrings,
+                                                   p_getcol {loc = loc,
+                                                             wontLeakStrings = wontLeakStrings,
                                                              col = i,
                                                              typ = sql_type_in env t},
                                                    string ";",
diff -r b2a175a0f2ef -r 8e9f2d247dba src/mysql.sml
--- a/src/mysql.sml	Thu Jul 16 18:10:29 2009 -0400
+++ b/src/mysql.sml	Fri Jul 17 12:25:34 2009 -0400
@@ -596,7 +596,7 @@
              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 @@
               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 @@
                    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 -r b2a175a0f2ef -r 8e9f2d247dba src/postgres.sml
--- a/src/postgres.sml	Thu Jul 16 18:10:29 2009 -0400
+++ b/src/postgres.sml	Fri Jul 17 12:25:34 2009 -0400
@@ -494,7 +494,7 @@
          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 @@
                           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 -r b2a175a0f2ef -r 8e9f2d247dba src/settings.sig
--- a/src/settings.sig	Thu Jul 16 18:10:29 2009 -0400
+++ b/src/settings.sig	Fri Jul 17 12:25:34 2009 -0400
@@ -131,12 +131,13 @@
                  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 -r b2a175a0f2ef -r 8e9f2d247dba src/settings.sml
--- a/src/settings.sml	Thu Jul 16 18:10:29 2009 -0400
+++ b/src/settings.sml	Fri Jul 17 12:25:34 2009 -0400
@@ -321,12 +321,13 @@
              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 -r b2a175a0f2ef -r 8e9f2d247dba tests/nested.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/nested.ur	Fri Jul 17 12:25:34 2009 -0400
@@ -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 -r b2a175a0f2ef -r 8e9f2d247dba tests/nested.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/nested.urp	Fri Jul 17 12:25:34 2009 -0400
@@ -0,0 +1,5 @@
+debug
+database dbname=nested
+sql nested.sql
+
+nested
diff -r b2a175a0f2ef -r 8e9f2d247dba tests/nested.urs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/nested.urs	Fri Jul 17 12:25:34 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page