From 44729d96795768c87fb042f01a62e7b14469b170 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 18 Jul 2009 10:27:32 -0400
Subject: Blobs tested in MySQL and SQLite

---
 src/monoize.sml  |  6 +++++-
 src/mysql.sml    |  3 ++-
 src/postgres.sml |  3 ++-
 src/settings.sig |  3 ++-
 src/settings.sml |  6 ++++--
 src/sqlite.sml   | 13 ++++++++-----
 6 files changed, 23 insertions(+), 11 deletions(-)

(limited to 'src')

diff --git a/src/monoize.sml b/src/monoize.sml
index 37df70d1..a6e38fd7 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2333,7 +2333,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                              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 --git a/src/mysql.sml b/src/mysql.sml
index 03563101..32df47d4 100644
--- a/src/mysql.sml
+++ b/src/mysql.sml
@@ -1506,6 +1506,7 @@ val () = addDbms {name = "mysql",
                   textKeysNeedLengths = true,
                   supportsNextval = false,
                   supportsNestedPrepared = false,
-                  sqlPrefix = "SET storage_engine=InnoDB;\n\n"}
+                  sqlPrefix = "SET storage_engine=InnoDB;\n\n",
+                  supportsOctetLength = true}
 
 end
diff --git a/src/postgres.sml b/src/postgres.sml
index f82b567d..bf58fe1a 100644
--- a/src/postgres.sml
+++ b/src/postgres.sml
@@ -895,7 +895,8 @@ val () = addDbms {name = "postgres",
                   textKeysNeedLengths = false,
                   supportsNextval = true,
                   supportsNestedPrepared = true,
-                  sqlPrefix = ""}
+                  sqlPrefix = "",
+                  supportsOctetLength = true}
 
 val () = setDbms "postgres"
 
diff --git a/src/settings.sig b/src/settings.sig
index b0abcef2..3e8a14ac 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -155,7 +155,8 @@ signature SETTINGS = sig
          textKeysNeedLengths : bool,
          supportsNextval : bool,
          supportsNestedPrepared : bool,
-         sqlPrefix : string
+         sqlPrefix : string,
+         supportsOctetLength : bool
     }
 
     val addDbms : dbms -> unit
diff --git a/src/settings.sml b/src/settings.sml
index 08a44471..c28e1102 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -345,7 +345,8 @@ type dbms = {
      textKeysNeedLengths : bool,
      supportsNextval : bool,
      supportsNestedPrepared : bool,
-     sqlPrefix : string
+     sqlPrefix : string,
+     supportsOctetLength : bool
 }
 
 val dbmses = ref ([] : dbms list)
@@ -369,7 +370,8 @@ val curDb = ref ({name = "",
                   textKeysNeedLengths = false,
                   supportsNextval = false,
                   supportsNestedPrepared = false,
-                  sqlPrefix = ""} : dbms)
+                  sqlPrefix = "",
+                  supportsOctetLength = false} : dbms)
 
 fun addDbms v = dbmses := v :: !dbmses
 fun setDbms s =
diff --git a/src/sqlite.sml b/src/sqlite.sml
index b515d313..b1252b95 100644
--- a/src/sqlite.sml
+++ b/src/sqlite.sml
@@ -374,13 +374,15 @@ fun p_getcol {loc, wontLeakStrings, col = i, typ = t} =
               | 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 @@ fun p_inputs loc =
                                                      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 @@ val () = addDbms {name = "sqlite",
                   textKeysNeedLengths = false,
                   supportsNextval = false,
                   supportsNestedPrepared = false,
-                  sqlPrefix = ""}
+                  sqlPrefix = "",
+                  supportsOctetLength = false}
 
 end
-- 
cgit v1.2.3