# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1240757616 14400
# Node ID cd67c3a942e326ca76c845f7072e8909f213b59f
# Parent  43553c93dd8cf00c5297865930dde762664e11f5
Handling nullable blobs

diff -r 43553c93dd8c -r cd67c3a942e3 src/cjr_print.sml
--- a/src/cjr_print.sml	Sun Apr 26 10:45:59 2009 -0400
+++ b/src/cjr_print.sml	Sun Apr 26 10:53:36 2009 -0400
@@ -392,7 +392,7 @@
          "uw_" ^ ident m ^ "_" ^ ident con,
          "uw_" ^ ident con)
 
-fun p_unsql wontLeakStrings env (tAll as (t, loc)) e =
+fun p_unsql wontLeakStrings env (tAll as (t, loc)) e eLen =
     case t of
         TFfi ("Basis", "int") => box [string "uw_Basis_stringToInt_error(ctx, ", e, string ")"]
       | TFfi ("Basis", "float") => box [string "uw_Basis_stringToFloat_error(ctx, ", e, string ")"]
@@ -403,6 +403,11 @@
             box [string "uw_strdup(ctx, ", e, string ")"]
       | TFfi ("Basis", "bool") => box [string "uw_Basis_stringToBool_error(ctx, ", e, string ")"]
       | TFfi ("Basis", "time") => box [string "uw_Basis_stringToTime_error(ctx, ", e, string ")"]
+      | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, ",
+                                       e,
+                                       string ", ",
+                                       eLen,
+                                       string ")"]
       | TFfi ("Basis", "channel") => box [string "uw_Basis_stringToChannel_error(ctx, ", e, string ")"]
       | TFfi ("Basis", "client") => box [string "uw_Basis_stringToClient_error(ctx, ", e, string ")"]
 
@@ -434,18 +439,14 @@
                            newline,
                            string "})"],
              string ")"]
-
-      | TFfi ("Basis", "blob") => box [string "uw_Basis_stringToBlob_error(ctx, PQgetvalue(res, i, ",
-                                       string (Int.toString i),
-                                       string "), PQgetlength(res, i, ",
-                                       string (Int.toString i),
-                                       string "))"]
-             
       | _ =>
         p_unsql wontLeakStrings env tAll
                 (box [string "PQgetvalue(res, i, ",
                       string (Int.toString i),
                       string ")"])
+                (box [string "PQgetlength(res, i, ",
+                      string (Int.toString i),
+                      string ")"])
 
 datatype sql_type =
          Int
@@ -526,7 +527,7 @@
       | Nullable t => box [string "(",
                            e,
                            string " == NULL ? NULL : ",
-                           p_ensql t (box [string "*", e]),
+                           p_ensql t (box [string "(*", e, string ")"]),
                            string ")"]
 
 fun notLeaky env allowHeapAllocated =
@@ -1821,7 +1822,8 @@
 
                  string "n = ",
                  p_unsql true env (TFfi ("Basis", "int"), loc)
-                         (string "PQgetvalue(res, 0, 0)"),
+                         (string "PQgetvalue(res, 0, 0)")
+                         (box []),
                  string ";",
                  newline,
                  string "PQclear(res);",
diff -r 43553c93dd8c -r cd67c3a942e3 tests/blobOpt.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/blobOpt.ur	Sun Apr 26 10:53:36 2009 -0400
@@ -0,0 +1,38 @@
+sequence s
+table t : { Id : int, Data : option blob, Typ : string }
+
+fun view id =
+    r <- oneRow (SELECT t.Data, t.Typ FROM t WHERE t.Id = {[id]});
+    case r.T.Data of
+        None => return <xml>This one's empty.</xml>
+      | Some data => returnBlob data (blessMime r.T.Typ)
+
+fun save r =
+    id <- nextval s;
+    dml (INSERT INTO t (Id, Data, Typ)
+         VALUES ({[id]}, {[Some (fileData r.Data)]}, {[fileMimeType r.Data]}));
+    main ()
+
+and saveEmpty () =
+    id <- nextval s;
+    dml (INSERT INTO t (Id, Data, Typ)
+         VALUES ({[id]}, {[None]}, "bogus"));
+    main ()
+
+and main () =
+    ls <- queryX (SELECT t.Id FROM t)
+          (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Id]}</a></li></xml>);
+    return <xml><body>
+      {ls}
+
+      <br/>
+
+      <form>
+        <upload{#Data}/>
+        <submit action={save}/>
+      </form>
+
+      <form>
+        <submit action={saveEmpty}/>
+      </form>
+    </body></xml>
diff -r 43553c93dd8c -r cd67c3a942e3 tests/blobOpt.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/blobOpt.urp	Sun Apr 26 10:53:36 2009 -0400
@@ -0,0 +1,5 @@
+debug
+database dbname=blobopt
+sql blobOpt.sql
+
+blobOpt
diff -r 43553c93dd8c -r cd67c3a942e3 tests/blobOpt.urs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/blobOpt.urs	Sun Apr 26 10:53:36 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page