# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1247927252 14400
# Node ID 034eeb099564fe1607af0d81f72f4b0c7c17bca8
# Parent  bcad392e288e4278950a820e79db4be279a177b9
Blobs tested in MySQL and SQLite

diff -r bcad392e288e -r 034eeb099564 src/monoize.sml
--- a/src/monoize.sml	Fri Jul 17 18:13:02 2009 -0400
+++ b/src/monoize.sml	Sat Jul 18 10:27:32 2009 -0400
@@ -2333,7 +2333,11 @@
                                              sc ")"]), loc)), loc),
                  fm)
             end
-          | L.EFfi ("Basis", "sql_octet_length") => ((L'.EPrim (Prim.String "octet_length"), loc), fm)
+          | L.EFfi ("Basis", "sql_octet_length") =>
+            ((L'.EPrim (Prim.String (if #supportsOctetLength (Settings.currentDbms ()) then
+                                         "octet_length"
+                                     else
+                                         "length")), loc), fm)
 
           | (L.ECApp (
              (L.ECApp (
diff -r bcad392e288e -r 034eeb099564 src/mysql.sml
--- a/src/mysql.sml	Fri Jul 17 18:13:02 2009 -0400
+++ b/src/mysql.sml	Sat Jul 18 10:27:32 2009 -0400
@@ -1506,6 +1506,7 @@
                   textKeysNeedLengths = true,
                   supportsNextval = false,
                   supportsNestedPrepared = false,
-                  sqlPrefix = "SET storage_engine=InnoDB;\n\n"}
+                  sqlPrefix = "SET storage_engine=InnoDB;\n\n",
+                  supportsOctetLength = true}
 
 end
diff -r bcad392e288e -r 034eeb099564 src/postgres.sml
--- a/src/postgres.sml	Fri Jul 17 18:13:02 2009 -0400
+++ b/src/postgres.sml	Sat Jul 18 10:27:32 2009 -0400
@@ -895,7 +895,8 @@
                   textKeysNeedLengths = false,
                   supportsNextval = true,
                   supportsNestedPrepared = true,
-                  sqlPrefix = ""}
+                  sqlPrefix = "",
+                  supportsOctetLength = true}
 
 val () = setDbms "postgres"
 
diff -r bcad392e288e -r 034eeb099564 src/settings.sig
--- a/src/settings.sig	Fri Jul 17 18:13:02 2009 -0400
+++ b/src/settings.sig	Sat Jul 18 10:27:32 2009 -0400
@@ -155,7 +155,8 @@
          textKeysNeedLengths : bool,
          supportsNextval : bool,
          supportsNestedPrepared : bool,
-         sqlPrefix : string
+         sqlPrefix : string,
+         supportsOctetLength : bool
     }
 
     val addDbms : dbms -> unit
diff -r bcad392e288e -r 034eeb099564 src/settings.sml
--- a/src/settings.sml	Fri Jul 17 18:13:02 2009 -0400
+++ b/src/settings.sml	Sat Jul 18 10:27:32 2009 -0400
@@ -345,7 +345,8 @@
      textKeysNeedLengths : bool,
      supportsNextval : bool,
      supportsNestedPrepared : bool,
-     sqlPrefix : string
+     sqlPrefix : string,
+     supportsOctetLength : bool
 }
 
 val dbmses = ref ([] : dbms list)
@@ -369,7 +370,8 @@
                   textKeysNeedLengths = false,
                   supportsNextval = false,
                   supportsNestedPrepared = false,
-                  sqlPrefix = ""} : dbms)
+                  sqlPrefix = "",
+                  supportsOctetLength = false} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =
diff -r bcad392e288e -r 034eeb099564 src/sqlite.sml
--- a/src/sqlite.sml	Fri Jul 17 18:13:02 2009 -0400
+++ b/src/sqlite.sml	Sat Jul 18 10:27:32 2009 -0400
@@ -374,13 +374,15 @@
               | Time => box [string "uw_Basis_stringToTime_error(ctx, sqlite3_column_text(stmt, ", string (Int.toString i), string "))"]
               | Blob => box [string "({",
                              newline,
-                             string "char *data = sqlite3_column_blob(stmt, ",
+                             string "char *data = (char *)sqlite3_column_blob(stmt, ",
                              string (Int.toString i),
                              string ");",
                              newline,
-                             string "uw_Basis_blob b = {sqlite3_column_bytes(stmt, ",
+                             string "int len = sqlite3_column_bytes(stmt, ",
                              string (Int.toString i),
-                             string "), data};",
+                             string ");",
+                             newline,
+                             string "uw_Basis_blob b = {len, uw_memdup(ctx, data, len)};",
                              newline,
                              string "b;",
                              newline,
@@ -537,7 +539,7 @@
                                                      arg,
                                                      string ".data, ",
                                                      arg,
-                                                     string ".size, SQLITE_TRANSIENT"]
+                                                     string ".size, SQLITE_TRANSIENT)"]
                                       | Channel => box [string "sqlite3_bind_int64(stmt, ",
                                                         string (Int.toString (i + 1)),
                                                         string ", ((sqlite3_int64)",
@@ -767,6 +769,7 @@
                   textKeysNeedLengths = false,
                   supportsNextval = false,
                   supportsNestedPrepared = false,
-                  sqlPrefix = ""}
+                  sqlPrefix = "",
+                  supportsOctetLength = false}
 
 end
diff -r bcad392e288e -r 034eeb099564 tests/blob.ur
--- a/tests/blob.ur	Fri Jul 17 18:13:02 2009 -0400
+++ b/tests/blob.ur	Sat Jul 18 10:27:32 2009 -0400
@@ -1,7 +1,7 @@
 sequence s
 table t : { Id : int, Nam : option string, Data : blob, Desc : string, Typ : string }
 
-fun view id =
+fun see id =
     r <- oneRow (SELECT t.Data, t.Typ FROM t WHERE t.Id = {[id]});
     returnBlob r.T.Data (blessMime r.T.Typ)
 
@@ -13,7 +13,7 @@
 
 and main () =
     ls <- queryX (SELECT t.Id, t.Desc, octet_length(t.Data) AS Len FROM t ORDER BY t.Desc)
-          (fn r => <xml><li><a link={view r.T.Id}>{[r.T.Desc]} ({[r.Len]})</a></li></xml>);
+          (fn r => <xml><li><a link={see r.T.Id}>{[r.T.Desc]} ({[r.Len]})</a></li></xml>);
     return <xml><body>
       {ls}
 
diff -r bcad392e288e -r 034eeb099564 tests/blob.urp
--- a/tests/blob.urp	Fri Jul 17 18:13:02 2009 -0400
+++ b/tests/blob.urp	Sat Jul 18 10:27:32 2009 -0400
@@ -1,5 +1,7 @@
 debug
-database dbname=blob
+database dbname=blobo
 sql blob.sql
+allow mime image/gif
+allow mime image/png
 
 blob