Mercurial > urweb
changeset 880:8e9f2d247dba
Testing nested queries
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Fri, 17 Jul 2009 12:25:34 -0400 |
parents | b2a175a0f2ef |
children | 45a63416adb4 |
files | src/cjr_print.sml src/mysql.sml src/postgres.sml src/settings.sig src/settings.sml tests/nested.ur tests/nested.urp tests/nested.urs |
diffstat | 8 files changed, 58 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- 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 ";",
--- 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 "}",
--- 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,
--- 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,
--- 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,
--- /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>