Mercurial > urweb
changeset 890:034eeb099564
Blobs tested in MySQL and SQLite
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Sat, 18 Jul 2009 10:27:32 -0400 |
| parents | bcad392e288e |
| children | 8f2159040bbb |
| files | src/monoize.sml src/mysql.sml src/postgres.sml src/settings.sig src/settings.sml src/sqlite.sml tests/blob.ur tests/blob.urp |
| diffstat | 8 files changed, 28 insertions(+), 14 deletions(-) [+] |
line wrap: on
line diff
--- 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 (
--- 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
--- 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"
--- 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
--- 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 =
--- 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
--- 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}