From ec734c14f2569e58e462097d5953a26f9fa84f69 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 17 Jul 2009 12:25:34 -0400 Subject: Testing nested queries --- src/cjr_print.sml | 3 ++- src/mysql.sml | 13 +++++++++++-- src/postgres.sml | 6 ++++-- src/settings.sig | 5 +++-- src/settings.sml | 5 +++-- tests/nested.ur | 29 +++++++++++++++++++++++++++++ tests/nested.urp | 5 +++++ tests/nested.urs | 1 + 8 files changed, 58 insertions(+), 9 deletions(-) create mode 100644 tests/nested.ur create mode 100644 tests/nested.urp create mode 100644 tests/nested.urs 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 => ({[r.T.A]}, {[r.T.B]}))) + +fun hard id = + queryX' (SELECT t.B AS N FROM t WHERE t.A = {[id]}) + (fn r => + b <- hard r.N; + return ({[id]}, {[r.N]}); {b}) + +fun doit () = + init (); + b1 <- easy (); + b2 <- hard 1; + return + {b1}
+ {b2} + + +fun main () = return
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 -- cgit v1.2.3