tryDml

21 files changed, 139 insertions, 83 deletions

diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index c06482ed..6cd9915e 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -535,6 +535,8 @@ val query : tables ::: {{Type}} -> exps ::: {Type}
 
 type dml
 val dml : dml -> transaction unit
+val tryDml : dml -> transaction (option string)
+(* Returns an error message on failure. *)
 
 val insert : fields ::: {Type} -> uniques ::: {{Unit}}
              -> sql_table fields uniques
diff --git a/src/checknest.sml b/src/checknest.sml
index a53c7083..1147d3e6 100644
--- a/src/checknest.sml
+++ b/src/checknest.sml
@@ -138,9 +138,10 @@ fun annotateExp globals =
                                       | SOME {id, query, ...} => SOME {id = id, query = query,
                                                                        nested = IS.member (expUses globals body, id)}},
                  loc)
-              | EDml {dml, prepared} =>
+              | EDml {dml, prepared, mode} =>
                 (EDml {dml = ae dml,
-                       prepared = prepared}, loc)
+                       prepared = prepared,
+                       mode = mode}, loc)
 
               | ENextval {seq, prepared} =>
                 (ENextval {seq = ae seq,
diff --git a/src/cjr.sml b/src/cjr.sml
index a19109d2..f34662dc 100644
--- a/src/cjr.sml
+++ b/src/cjr.sml
@@ -56,6 +56,8 @@ datatype pat' =
 
 withtype pat = pat' located
 
+datatype failure_mode = datatype Settings.failure_mode
+
 datatype exp' =
          EPrim of Prim.t
        | ERel of int
@@ -92,7 +94,8 @@ datatype exp' =
                      initial : exp,
                      prepared : {id : int, query : string, nested : bool} option }
        | EDml of { dml : exp,
-                   prepared : {id : int, dml : string} option }
+                   prepared : {id : int, dml : string} option,
+                   mode : failure_mode }
        | ENextval of { seq : exp,
                        prepared : {id : int, query : string} option }
        | ESetval of { seq : exp, count : exp }
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 412531a6..7331196f 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -1791,8 +1791,11 @@ fun p_exp' par env (e, loc) =
                      box []]
         end
 
-      | EDml {dml, prepared} =>
-        box [string "(uw_begin_region(ctx), ({",
+      | EDml {dml, prepared, mode} =>
+        box [case mode of
+                 Settings.Error => box []
+               | Settings.None => string "({const char *uw_errmsg = NULL;",
+             string "(uw_begin_region(ctx), ({",
              newline,
              case prepared of
                  NONE => box [string "char *dml = ",
@@ -1800,7 +1803,7 @@ fun p_exp' par env (e, loc) =
                               string ";",
                               newline,
                               newline,
-                              #dml (Settings.currentDbms ()) loc]
+                              #dml (Settings.currentDbms ()) (loc, mode)]
                | SOME {id, dml = dml'} =>
                  let
                      val inputs = getPargs dml
@@ -1823,16 +1826,23 @@ fun p_exp' par env (e, loc) =
                           #dmlPrepared (Settings.currentDbms ()) {loc = loc,
                                                                   id = id,
                                                                   dml = dml',
-                                                                  inputs = map #2 inputs}]
+                                                                  inputs = map #2 inputs,
+                                                                  mode = mode}]
                  end,
              newline,
              newline,
-
              string "uw_end_region(ctx);",
              newline,
-             string "uw_unit_v;",
+
+             case mode of
+                 Settings.Error => string "uw_unit_v;"
+               | Settings.None => string "uw_errmsg ? uw_strdup(ctx, uw_errmsg) : NULL;",
+
              newline,
-             string "}))"]
+             string "}))",
+             case mode of
+                 Settings.Error => box []
+               | Settings.None => string ";})"]
 
       | ENextval {seq, prepared} =>
         box [string "({",
diff --git a/src/cjrize.sml b/src/cjrize.sml
index b98b3c25..22463cd4 100644
--- a/src/cjrize.sml
+++ b/src/cjrize.sml
@@ -455,11 +455,11 @@ fun cifyExp (eAll as (e, loc), sm) =
                          query = query, body = body, initial = initial, prepared = NONE}, loc), sm)
         end
 
-      | L.EDml e =>
+      | L.EDml (e, mode) =>
         let
             val (e, sm) = cifyExp (e, sm)
         in
-            ((L'.EDml {dml = e, prepared = NONE}, loc), sm)
+            ((L'.EDml {dml = e, prepared = NONE, mode = mode}, loc), sm)
         end
 
       | L.ENextval e =>
diff --git a/src/iflow.sml b/src/iflow.sml
index 92e568a1..c0e92cb1 100644
--- a/src/iflow.sml
+++ b/src/iflow.sml
@@ -2040,7 +2040,7 @@ fun evalExp env (e as (_, loc)) k =
                                   val (ts, cs) = MonoUtil.Exp.fold {typ = fn (_, st) => st,
                                                                    exp = fn (e, st as (cs, ts)) =>
                                                                             case e of
-                                                                                EDml e =>
+                                                                                EDml (e, _) =>
                                                                                 (case parse dml e of
                                                                                      NONE => st
                                                                                    | SOME c =>
@@ -2080,7 +2080,7 @@ fun evalExp env (e as (_, loc)) k =
                                                               (St.assert [AReln (Eq, [r, x])];
                                                                evalExp (acc :: r :: env) b k))} q
                               end)
-          | EDml e =>
+          | EDml (e, _) =>
             (case parse dml e of
                  NONE => (print ("Warning: Information flow checker can't parse DML command at "
                                  ^ ErrorMsg.spanToString loc ^ "\n");
@@ -2400,7 +2400,7 @@ fun check file =
                                      query = doExp env query,
                                      body = doExp (Unknown :: Unknown :: env) body,
                                      initial = doExp env initial}, loc)
-                          | EDml e1 =>
+                          | EDml (e1, mode) =>
                             (case parse dml e1 of
                                  NONE => ()
                                | SOME c =>
@@ -2410,7 +2410,7 @@ fun check file =
                                      tables := SS.add (!tables, tab)
                                    | Update (tab, _, _) =>
                                      tables := SS.add (!tables, tab);
-                             (EDml (doExp env e1), loc))
+                             (EDml (doExp env e1, mode), loc))
                           | ENextval e1 => (ENextval (doExp env e1), loc)
                           | ESetval (e1, e2) => (ESetval (doExp env e1, doExp env e2), loc)
                           | EUnurlify (e1, t, b) => (EUnurlify (doExp env e1, t, b), loc)
diff --git a/src/jscomp.sml b/src/jscomp.sml
index f97725eb..2f7ee5ab 100644
--- a/src/jscomp.sml
+++ b/src/jscomp.sml
@@ -1147,11 +1147,11 @@ fun process file =
                      ((EQuery {exps = exps, tables = tables, state = state,
                                query = query, body = body, initial = initial}, loc), st)
                  end
-               | EDml e =>
+               | EDml (e, mode) =>
                  let
                      val (e, st) = exp outer (e, st)
                  in
-                     ((EDml e, loc), st)
+                     ((EDml (e, mode), loc), st)
                  end
                | ENextval e =>
                  let
diff --git a/src/mono.sml b/src/mono.sml
index 9a960cd0..554b1dc5 100644
--- a/src/mono.sml
+++ b/src/mono.sml
@@ -66,6 +66,8 @@ datatype javascript_mode =
 datatype effect = datatype Export.effect
 datatype export_kind = datatype Export.export_kind
 
+datatype failure_mode = datatype Settings.failure_mode
+
 datatype exp' =
          EPrim of Prim.t
        | ERel of int
@@ -104,7 +106,7 @@ datatype exp' =
                      query : exp,
                      body : exp,
                      initial : exp }
-       | EDml of exp
+       | EDml of exp * failure_mode
        | ENextval of exp
        | ESetval of exp * exp
 
diff --git a/src/mono_print.sml b/src/mono_print.sml
index 25a8e9d8..c3f2866e 100644
--- a/src/mono_print.sml
+++ b/src/mono_print.sml
@@ -322,9 +322,9 @@ fun p_exp' par env (e, _) =
              string "in",
              space,
              p_exp (E.pushERel (E.pushERel env "r" dummyt NONE) "acc" dummyt NONE) body]
-      | EDml e => box [string "dml(",
-                       p_exp env e,
-                       string ")"]
+      | EDml (e, _) => box [string "dml(",
+                            p_exp env e,
+                            string ")"]
       | ENextval e => box [string "nextval(",
                            p_exp env e,
                            string ")"]
diff --git a/src/mono_reduce.sml b/src/mono_reduce.sml
index 5e735b79..ce9f4a4e 100644
--- a/src/mono_reduce.sml
+++ b/src/mono_reduce.sml
@@ -465,7 +465,7 @@ fun reduce file =
                                      [ReadDb],
                                      summarize (d + 2) body]
 
-                      | EDml e => summarize d e @ [WriteDb]
+                      | EDml (e, _) => summarize d e @ [WriteDb]
                       | ENextval e => summarize d e @ [WriteDb]
                       | ESetval (e1, e2) => summarize d e1 @ summarize d e2 @ [WriteDb]
                       | EUnurlify (e, _, _) => summarize d e
diff --git a/src/mono_util.sml b/src/mono_util.sml
index 6bbbecb1..8a567e83 100644
--- a/src/mono_util.sml
+++ b/src/mono_util.sml
@@ -332,10 +332,10 @@ fun mapfoldB {typ = fc, exp = fe, bind} =
                                                                                        initial = initial'},
                                                                                loc)))))))
 
-              | EDml e =>
+              | EDml (e, fm) =>
                 S.map2 (mfe ctx e,
                      fn e' =>
-                        (EDml e', loc))
+                        (EDml (e', fm), loc))
               | ENextval e =>
                 S.map2 (mfe ctx e,
                      fn e' =>
diff --git a/src/monoize.sml b/src/monoize.sml
index cde1af70..07e69834 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1748,7 +1748,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             let
                 val (e, fm) = monoExp (env, st, fm) e
             in
-                ((L'.EDml e, loc),
+                ((L'.EDml (e, L'.Error), loc),
+                 fm)
+            end
+
+          | L.EFfiApp ("Basis", "tryDml", [e]) =>
+            let
+                val (e, fm) = monoExp (env, st, fm) e
+            in
+                ((L'.EDml (e, L'.None), loc),
                  fm)
             end
 
@@ -4014,13 +4022,13 @@ fun monoize env file =
                             val e =
                                 foldl (fn ((x, v), e) =>
                                           (L'.ESeq (
-                                           (L'.EDml (L'.EStrcat (
-                                                     (L'.EPrim (Prim.String ("UPDATE uw_"
-                                                                             ^ tab
-                                                                             ^ " SET uw_"
-                                                                             ^ x
-                                                                             ^ " = NULL WHERE ")), loc),
-                                                     cond (x, v)), loc), loc),
+                                           (L'.EDml ((L'.EStrcat (
+                                                      (L'.EPrim (Prim.String ("UPDATE uw_"
+                                                                              ^ tab
+                                                                              ^ " SET uw_"
+                                                                              ^ x
+                                                                              ^ " = NULL WHERE ")), loc),
+                                                      cond (x, v)), loc), L'.Error), loc),
                                            e), loc))
                                       e nullable
 
@@ -4039,7 +4047,7 @@ fun monoize env file =
                                                                                         ^ tab
                                                                                         ^ " WHERE ")), loc),
                                                                 cond eb), loc)
-                                                   ebs), loc),
+                                                   ebs, L'.Error), loc),
                                      e), loc)
                         in
                             e
@@ -4067,15 +4075,15 @@ fun monoize env file =
                                     [] => e
                                   | (x, _) :: ebs =>
                                     (L'.ESeq (
-                                     (L'.EDml (L'.EPrim (Prim.String
-                                                             (foldl (fn ((x, _), s) =>
-                                                                        s ^ ", uw_" ^ x ^ " = NULL")
-                                                                    ("UPDATE uw_"
-                                                                     ^ tab
-                                                                     ^ " SET uw_"
-                                                                     ^ x
-                                                                     ^ " = NULL")
-                                                                    ebs)), loc), loc),
+                                     (L'.EDml ((L'.EPrim (Prim.String
+                                                              (foldl (fn ((x, _), s) =>
+                                                                         s ^ ", uw_" ^ x ^ " = NULL")
+                                                                     ("UPDATE uw_"
+                                                                      ^ tab
+                                                                      ^ " SET uw_"
+                                                                      ^ x
+                                                                      ^ " = NULL")
+                                                                     ebs)), loc), L'.Error), loc),
                                      e), loc)
 
                             val e =
@@ -4083,8 +4091,8 @@ fun monoize env file =
                                     [] => e
                                   | eb :: ebs =>
                                     (L'.ESeq (
-                                     (L'.EDml (L'.EPrim (Prim.String ("DELETE FROM uw_"
-                                                                      ^ tab)), loc), loc),
+                                     (L'.EDml ((L'.EPrim (Prim.String ("DELETE FROM uw_"
+                                                                       ^ tab)), loc), L'.Error), loc),
                                      e), loc)
                         in
                             e
diff --git a/src/mysql.sml b/src/mysql.sml
index 12d52255..44d88c1d 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1194,16 +1194,19 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
          else
              box []]
 
-fun dmlCommon {loc, dml} =
-    box [string "if (mysql_stmt_execute(stmt)) uw_error(ctx, FATAL, \"",
-         string (ErrorMsg.spanToString loc),
-         string ": Error executing DML: %s\\n%s\", ",
-         dml,
-         string ", mysql_error(conn->conn));",
+fun dmlCommon {loc, dml, mode} =
+    box [string "if (mysql_stmt_execute(stmt)) ",
+         case mode of
+             Settings.Error => box [string "uw_error(ctx, FATAL, \"",
+                                    string (ErrorMsg.spanToString loc),
+                                    string ": Error executing DML: %s\\n%s\", ",
+                                    dml,
+                                    string ", mysql_error(conn->conn));"]
+           | Settings.None => string "uw_errmsg = mysql_error(conn->conn);",
          newline,
          newline]
 
-fun dml loc =
+fun dml (loc, mode) =
     box [string "uw_conn *conn = uw_get_db(ctx);",
          newline,
          string "MYSQL_STMT *stmt = mysql_stmt_init(conn->conn);",
@@ -1220,12 +1223,12 @@ fun dml loc =
          newline,
          newline,
 
-         dmlCommon {loc = loc, dml = string "dml"},
+         dmlCommon {loc = loc, dml = string "dml", mode = mode},
 
          string "uw_pop_cleanup(ctx);",
          newline]
 
-fun dmlPrepared {loc, id, dml, inputs} =
+fun dmlPrepared {loc, id, dml, inputs, mode} =
     box [string "uw_conn *conn = uw_get_db(ctx);",
          newline,
          string "MYSQL_BIND in[",
@@ -1471,7 +1474,7 @@ fun dmlPrepared {loc, id, dml, inputs} =
 
          dmlCommon {loc = loc, dml = box [string "\"",
                                           string (String.toCString dml),
-                                          string "\""]}]
+                                          string "\""], mode = mode}]
 
 fun nextval {loc, seqE, seqName} =
     box [string "uw_conn *conn = uw_get_db(ctx);",
diff --git a/src/postgres.sml b/src/postgres.sml
index 12e928c5..bf1e8536 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -708,7 +708,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested = _} =
                                                                             string (String.toCString query),
                                                                             string "\""]}]
 
-fun dmlCommon {loc, dml} =
+fun dmlCommon {loc, dml, mode} =
     box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating DML result.\");",
          newline,
          newline,
@@ -723,13 +723,15 @@ fun dmlCommon {loc, dml} =
                    newline],
               string "}",
               newline,
-              string "PQclear(res);",
-              newline,
-              string "uw_error(ctx, FATAL, \"",
-              string (ErrorMsg.spanToString loc),
-              string ": DML failed:\\n%s\\n%s\", ",
-              dml,
-              string ", PQerrorMessage(conn));",
+              case mode of
+                  Settings.Error => box [string "PQclear(res);",
+                                         newline,
+                                         string "uw_error(ctx, FATAL, \"",
+                                         string (ErrorMsg.spanToString loc),
+                                         string ": DML failed:\\n%s\\n%s\", ",
+                                         dml,
+                                         string ", PQerrorMessage(conn));"]
+                | Settings.None => string "uw_errmsg = PQerrorMessage(conn);",
               newline],
          string "}",
          newline,
@@ -738,15 +740,15 @@ fun dmlCommon {loc, dml} =
          string "PQclear(res);",
          newline]
 
-fun dml loc =
+fun dml (loc, mode) =
     box [string "PGconn *conn = uw_get_db(ctx);",
          newline,
          string "PGresult *res = PQexecParams(conn, dml, 0, NULL, NULL, NULL, NULL, 0);",
          newline,
          newline,
-         dmlCommon {loc = loc, dml = string "dml"}]
+         dmlCommon {loc = loc, dml = string "dml", mode = mode}]
 
-fun dmlPrepared {loc, id, dml, inputs} =
+fun dmlPrepared {loc, id, dml, inputs, mode} =
     box [string "PGconn *conn = uw_get_db(ctx);",
          newline,
          string "const int paramFormats[] = { ",
@@ -787,7 +789,7 @@ fun dmlPrepared {loc, id, dml, inputs} =
          newline,
          dmlCommon {loc = loc, dml = box [string "\"",
                                           string (String.toCString dml),
-                                          string "\""]}]
+                                          string "\""], mode = mode}]
 
 fun nextvalCommon {loc, query} =
     box [string "if (res == NULL) uw_error(ctx, FATAL, \"Out of memory allocating nextval result.\");",
diff --git a/src/prepare.sml b/src/prepare.sml
index 2f49405b..81de2fa7 100644
--- a/src/prepare.sml
+++ b/src/prepare.sml
@@ -246,11 +246,11 @@ fun prepExp (e as (_, loc), st) =
                           initial = initial, prepared = SOME {id = id, query = s, nested = true}}, loc), st)
         end
 
-      | EDml {dml, ...} =>
+      | EDml {dml, mode, ...} =>
         (case prepString (dml, st) of
              NONE => (e, st)
            | SOME (id, s, st) =>
-             ((EDml {dml = dml, prepared = SOME {id = id, dml = s}}, loc), st))
+             ((EDml {dml = dml, prepared = SOME {id = id, dml = s}, mode = mode}, loc), st))
 
       | ENextval {seq, ...} =>
         if #supportsNextval (Settings.currentDbms ()) then
diff --git a/src/settings.sig b/src/settings.sig
index a5f0cfa7..51d06902 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -124,6 +124,8 @@ signature SETTINGS = sig
     val isBlob : sql_type -> bool
     val isNotNull : sql_type -> bool
 
+    datatype failure_mode = Error | None
+
     type dbms = {
          name : string,
          (* Call it this on the command line *)
@@ -149,9 +151,9 @@ signature SETTINGS = sig
                                    -> Print.PD.pp_desc,
                           nested : bool}
                          -> Print.PD.pp_desc,
-         dml : ErrorMsg.span -> Print.PD.pp_desc,
+         dml : ErrorMsg.span * failure_mode -> Print.PD.pp_desc,
          dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
-                        inputs : sql_type list} -> Print.PD.pp_desc,
+                        inputs : sql_type list, mode : failure_mode} -> Print.PD.pp_desc,
          nextval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, seqName : string option} -> Print.PD.pp_desc,
          nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc,
          setval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, count : Print.PD.pp_desc} -> Print.PD.pp_desc,
diff --git a/src/settings.sml b/src/settings.sml
index 93b022ab..af16f9ca 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -363,6 +363,8 @@ fun isBlob Blob = true
 fun isNotNull (Nullable _) = false
   | isNotNull _ = true
 
+datatype failure_mode = Error | None
+
 type dbms = {
      name : string,
      header : string,
@@ -384,9 +386,9 @@ type dbms = {
                                -> Print.PD.pp_desc,
                       nested : bool}
                      -> Print.PD.pp_desc,
-     dml : ErrorMsg.span -> Print.PD.pp_desc,
+     dml : ErrorMsg.span * failure_mode -> Print.PD.pp_desc,
      dmlPrepared : {loc : ErrorMsg.span, id : int, dml : string,
-                    inputs : sql_type list} -> Print.PD.pp_desc,
+                    inputs : sql_type list, mode : failure_mode} -> Print.PD.pp_desc,
      nextval : {loc : ErrorMsg.span, seqName : string option, seqE : Print.PD.pp_desc} -> Print.PD.pp_desc,
      nextvalPrepared : {loc : ErrorMsg.span, id : int, query : string} -> Print.PD.pp_desc,
      setval : {loc : ErrorMsg.span, seqE : Print.PD.pp_desc, count : Print.PD.pp_desc} -> Print.PD.pp_desc,
diff --git a/src/sqlite.sml b/src/sqlite.sml
index 74093f21..20afd5bc 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -688,7 +688,7 @@ fun queryPrepared {loc, id, query, inputs, cols, doCols, nested} =
              box [string "uw_pop_cleanup(ctx);",
                   newline]]
 
-fun dmlCommon {loc, dml} =
+fun dmlCommon {loc, dml, mode} =
     box [string "int r;",
          newline,
 
@@ -701,14 +701,17 @@ fun dmlCommon {loc, dml} =
          newline,
          newline,
 
-         string "if (r != SQLITE_DONE) uw_error(ctx, FATAL, \"",
-         string (ErrorMsg.spanToString loc),
-         string ": DML step failed: %s<br />%s\", ",
-         dml,
-         string ", sqlite3_errmsg(conn->conn));",
+         string "if (r != SQLITE_DONE) ",
+         case mode of
+             Settings.Error => box [string "uw_error(ctx, FATAL, \"",
+                                    string (ErrorMsg.spanToString loc),
+                                    string ": DML step failed: %s<br />%s\", ",
+                                    dml,
+                                    string ", sqlite3_errmsg(conn->conn));"]
+           | Settings.None => string "uw_errmsg = sqlite3_errmsg(conn->conn);",
          newline]
 
-fun dml loc =
+fun dml (loc, mode) =
     box [string "uw_conn *conn = uw_get_db(ctx);",
          newline,
          string "sqlite3_stmt *stmt;",
@@ -721,12 +724,12 @@ fun dml loc =
          newline,
          newline,
 
-         dmlCommon {loc = loc, dml = string "dml"},
+         dmlCommon {loc = loc, dml = string "dml", mode = mode},
 
          string "uw_pop_cleanup(ctx);",
          newline]
 
-fun dmlPrepared {loc, id, dml, inputs} =
+fun dmlPrepared {loc, id, dml, inputs, mode = mode} =
     box [string "uw_conn *conn = uw_get_db(ctx);",
          newline,
          p_pre_inputs inputs,
@@ -761,7 +764,7 @@ fun dmlPrepared {loc, id, dml, inputs} =
 
          dmlCommon {loc = loc, dml = box [string "\"",
                                           string (String.toCString dml),
-                                          string "\""]},
+                                          string "\""], mode = mode},
 
          string "uw_pop_cleanup(ctx);",
          newline,
diff --git a/tests/tryDml.ur b/tests/tryDml.ur
new file mode 100644
index 00000000..bfe98cdb
--- /dev/null
+++ b/tests/tryDml.ur
@@ -0,0 +1,13 @@
+table t : {Id : int}
+  PRIMARY KEY Id
+
+fun doStuff () =
+    dml (INSERT INTO t (Id) VALUES (0));
+    o1 <- tryDml (INSERT INTO t (Id) VALUES (0));
+    dml (INSERT INTO t (Id) VALUES (1));
+    o2 <- tryDml (INSERT INTO t (Id) VALUES (1));
+    return <xml>{[o1]}; {[o2]}</xml>
+
+fun main () = return <xml><body>
+  <form> <submit action={doStuff}/> </form>
+</body></xml>
diff --git a/tests/tryDml.urp b/tests/tryDml.urp
new file mode 100644
index 00000000..cf42105b
--- /dev/null
+++ b/tests/tryDml.urp
@@ -0,0 +1,4 @@
+database dbname=trydml
+sql trydml.sql
+
+tryDml
diff --git a/tests/tryDml.urs b/tests/tryDml.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/tryDml.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page