diff options
| -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 | ||||
| -rw-r--r-- | tests/blob.ur | 4 | ||||
| -rw-r--r-- | tests/blob.urp | 4 |
8 files changed, 28 insertions, 14 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 diff --git a/tests/blob.ur b/tests/blob.ur index 4c368a86..c6106686 100644 --- a/tests/blob.ur +++ b/tests/blob.ur @@ -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 @@ fun save r = 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 --git a/tests/blob.urp b/tests/blob.urp index 2c6be994..6e0de2ee 100644 --- a/tests/blob.urp +++ b/tests/blob.urp @@ -1,5 +1,7 @@ debug -database dbname=blob +database dbname=blobo sql blob.sql +allow mime image/gif +allow mime image/png blob |