summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/cjr_print.sml22
-rw-r--r--tests/blobOpt.ur38
-rw-r--r--tests/blobOpt.urp5
-rw-r--r--tests/blobOpt.urs1
4 files changed, 56 insertions, 10 deletions
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 1447d9e5..8ce4433f 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -392,7 +392,7 @@ fun patConInfo env pc =
"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 @@ fun p_unsql wontLeakStrings env (tAll as (t, loc)) e =
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 @@ fun p_getcol wontLeakStrings env (tAll as (t, loc)) i =
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 @@ fun p_ensql t e =
| 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 @@ fun p_exp' par env (e, loc) =
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 --git a/tests/blobOpt.ur b/tests/blobOpt.ur
new file mode 100644
index 00000000..261ce226
--- /dev/null
+++ b/tests/blobOpt.ur
@@ -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 --git a/tests/blobOpt.urp b/tests/blobOpt.urp
new file mode 100644
index 00000000..fef3c5d2
--- /dev/null
+++ b/tests/blobOpt.urp
@@ -0,0 +1,5 @@
+debug
+database dbname=blobopt
+sql blobOpt.sql
+
+blobOpt
diff --git a/tests/blobOpt.urs b/tests/blobOpt.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/blobOpt.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page