diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-07-18 10:27:32 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-07-18 10:27:32 -0400 |
commit | 44729d96795768c87fb042f01a62e7b14469b170 (patch) | |
tree | a26160e55fe25f54defba930744c0345a4ddf7a9 /src | |
parent | 8b9a5a3993e1b92ab06f3fed61b867ade6504e2f (diff) |
Blobs tested in MySQL and SQLite
Diffstat (limited to 'src')
-rw-r--r-- | src/monoize.sml | 6 | ||||
-rw-r--r-- | src/mysql.sml | 3 | ||||
-rw-r--r-- | src/postgres.sml | 3 | ||||
-rw-r--r-- | src/settings.sig | 3 | ||||
-rw-r--r-- | src/settings.sml | 6 | ||||
-rw-r--r-- | src/sqlite.sml | 13 |
6 files changed, 23 insertions, 11 deletions
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 |