HDBC-sqlite3 2.1.0.0 → 2.1.0.2
raw patch · 11 files changed
+634/−11 lines, 11 filesdep ~basePVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Database.HDBC.Sqlite3: connectSqlite3Raw :: FilePath -> IO Connection
Files
- Database/HDBC/Sqlite3.hs +2/−2
- Database/HDBC/Sqlite3/Connection.hs +17/−3
- HDBC-sqlite3.cabal +6/−6
- testsrc/SpecificDB.hs +14/−0
- testsrc/SpecificDBTests.hs +11/−0
- testsrc/TestMisc.hs +180/−0
- testsrc/TestSbasics.hs +150/−0
- testsrc/TestUtils.hs +25/−0
- testsrc/Testbasics.hs +168/−0
- testsrc/Tests.hs +34/−0
- testsrc/runtests.hs +27/−0
Database/HDBC/Sqlite3.hs view
@@ -33,13 +33,13 @@ module Database.HDBC.Sqlite3 ( -- * Sqlite3 Basics- connectSqlite3, Connection(), setBusyTimeout,+ connectSqlite3, connectSqlite3Raw, Connection(), setBusyTimeout, -- * Sqlite3 Error Consts module Database.HDBC.Sqlite3.Consts ) where -import Database.HDBC.Sqlite3.Connection(connectSqlite3, Connection())+import Database.HDBC.Sqlite3.Connection(connectSqlite3, connectSqlite3Raw, Connection()) import Database.HDBC.Sqlite3.ConnectionImpl(setBusyTimeout) import Database.HDBC.Sqlite3.Consts
Database/HDBC/Sqlite3/Connection.hs view
@@ -19,7 +19,7 @@ -} module Database.HDBC.Sqlite3.Connection - (connectSqlite3, Impl.Connection())+ (connectSqlite3, connectSqlite3Raw, Impl.Connection()) where import Database.HDBC.Types@@ -44,8 +44,22 @@ All database accessor functions are provided in the main HDBC module. -} connectSqlite3 :: FilePath -> IO Impl.Connection-connectSqlite3 fp = - B.useAsCString (BUTF8.fromString fp)+connectSqlite3 = + genericConnect (B.useAsCString . BUTF8.fromString)++{- | Connects to a Sqlite v3 database as with 'connectSqlite3', but+instead of converting the supplied 'FilePath' to a C String by performing+a conversion to Unicode, instead converts it by simply dropping all bits past+the eighth. This may be useful in rare situations+if your application or filesystemare not running in Unicode space. -}+connectSqlite3Raw :: FilePath -> IO Impl.Connection+connectSqlite3Raw = genericConnect withCString++genericConnect :: (String -> (CString -> IO Impl.Connection) -> IO Impl.Connection) + -> FilePath+ -> IO Impl.Connection+genericConnect strAsCStrFunc fp =+ strAsCStrFunc fp (\cs -> alloca (\(p::Ptr (Ptr CSqlite3)) -> do res <- sqlite3_open cs p
HDBC-sqlite3.cabal view
@@ -1,5 +1,5 @@ Name: HDBC-sqlite3-Version: 2.1.0.0+Version: 2.1.0.2 License: LGPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -22,12 +22,12 @@ Library if flag(splitBase)- Build-Depends: base>=3, bytestring+ Build-Depends: base>=3 && < 5, bytestring else- Build-Depends: base<3+ Build-Depends: base<3 && < 5 if impl(ghc >= 6.9)- Build-Depends: base >= 4+ Build-Depends: base >= 4 && < 5 Build-Depends: mtl, HDBC>=2.1.0, utf8-string C-Sources: hdbc-sqlite3-helper.c@@ -50,10 +50,10 @@ Executable runtests if flag(buildtests) Buildable: True+ Build-Depends: HUnit, QuickCheck, testpack, containers, convertible, + old-time, time, old-locale else Buildable: False- Build-Depends: HUnit, QuickCheck, testpack, containers, convertible, - old-time, time, old-locale Main-Is: runtests.hs Other-Modules: SpecificDB, SpecificDBTests,
+ testsrc/SpecificDB.hs view
@@ -0,0 +1,14 @@+module SpecificDB where+import Database.HDBC+import Database.HDBC.Sqlite3+import Test.HUnit++connectDB = + handleSqlError (connectSqlite3 "testtmp.sql3")++dateTimeTypeOfSqlValue :: SqlValue -> String+dateTimeTypeOfSqlValue (SqlPOSIXTime _) = "TEXT"+dateTimeTypeOfSqlValue (SqlEpochTime _) = "INTEGER"+dateTimeTypeOfSqlValue _ = "TEXT"++supportsFracTime = True
+ testsrc/SpecificDBTests.hs view
@@ -0,0 +1,11 @@+module SpecificDBTests where+import Database.HDBC+import Database.HDBC.Sqlite3+import Test.HUnit+import TestMisc(setup)++testgetTables = setup $ \dbh ->+ do r <- getTables dbh+ ["hdbctest2"] @=? r++tests = TestList [TestLabel "getTables" testgetTables]
+ testsrc/TestMisc.hs view
@@ -0,0 +1,180 @@+module TestMisc(tests, setup) where+import Test.HUnit+import Database.HDBC+import TestUtils+import System.IO+import Control.Exception+import Data.Char+import Control.Monad+import qualified Data.Map as Map++rowdata = + [[SqlInt32 0, toSql "Testing", SqlNull],+ [SqlInt32 1, toSql "Foo", SqlInt32 5],+ [SqlInt32 2, toSql "Bar", SqlInt32 9]]++colnames = ["testid", "teststring", "testint"]+alrows :: [[(String, SqlValue)]]+alrows = map (zip colnames) rowdata++setup f = dbTestCase $ \dbh ->+ do run dbh "CREATE TABLE hdbctest2 (testid INTEGER PRIMARY KEY NOT NULL, teststring TEXT, testint INTEGER)" []+ sth <- prepare dbh "INSERT INTO hdbctest2 VALUES (?, ?, ?)"+ executeMany sth rowdata+ commit dbh+ finally (f dbh)+ (do run dbh "DROP TABLE hdbctest2" []+ commit dbh+ )++cloneTest dbh a =+ do dbh2 <- clone dbh+ finally (handleSqlError (a dbh2))+ (handleSqlError (disconnect dbh2))++testgetColumnNames = setup $ \dbh ->+ do sth <- prepare dbh "SELECT * from hdbctest2"+ execute sth []+ cols <- getColumnNames sth+ finish sth+ ["testid", "teststring", "testint"] @=? map (map toLower) cols++testdescribeResult = setup $ \dbh -> when (not ((hdbcDriverName dbh) `elem`+ ["sqlite3"])) $+ do sth <- prepare dbh "SELECT * from hdbctest2"+ execute sth []+ cols <- describeResult sth+ ["testid", "teststring", "testint"] @=? map (map toLower . fst) cols+ let coldata = map snd cols+ assertBool "r0 type" (colType (coldata !! 0) `elem`+ [SqlBigIntT, SqlIntegerT])+ assertBool "r1 type" (colType (coldata !! 1) `elem`+ [SqlVarCharT, SqlLongVarCharT])+ assertBool "r2 type" (colType (coldata !! 2) `elem`+ [SqlBigIntT, SqlIntegerT])+ finish sth++testdescribeTable = setup $ \dbh -> when (not ((hdbcDriverName dbh) `elem`+ ["sqlite3"])) $+ do cols <- describeTable dbh "hdbctest2"+ ["testid", "teststring", "testint"] @=? map (map toLower . fst) cols+ let coldata = map snd cols+ assertBool "r0 type" (colType (coldata !! 0) `elem`+ [SqlBigIntT, SqlIntegerT])+ assertEqual "r0 nullable" (Just False) (colNullable (coldata !! 0))+ assertBool "r1 type" (colType (coldata !! 1) `elem`+ [SqlVarCharT, SqlLongVarCharT])+ assertEqual "r1 nullable" (Just True) (colNullable (coldata !! 1))+ assertBool "r2 type" (colType (coldata !! 2) `elem`+ [SqlBigIntT, SqlIntegerT])+ assertEqual "r2 nullable" (Just True) (colNullable (coldata !! 2))++testquickQuery = setup $ \dbh ->+ do results <- quickQuery dbh "SELECT * from hdbctest2 ORDER BY testid" []+ rowdata @=? results++testfetchRowAL = setup $ \dbh ->+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid" + execute sth []+ fetchRowAL sth >>= (Just (head alrows) @=?)+ fetchRowAL sth >>= (Just (alrows !! 1) @=?)+ fetchRowAL sth >>= (Just (alrows !! 2) @=?)+ fetchRowAL sth >>= (Nothing @=?)+ finish sth++testfetchRowMap = setup $ \dbh ->+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid" + execute sth []+ fetchRowMap sth >>= (Just (Map.fromList $ head alrows) @=?)+ fetchRowMap sth >>= (Just (Map.fromList $ alrows !! 1) @=?)+ fetchRowMap sth >>= (Just (Map.fromList $ alrows !! 2) @=?)+ fetchRowMap sth >>= (Nothing @=?)+ finish sth++testfetchAllRowsAL = setup $ \dbh ->+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid"+ execute sth []+ fetchAllRowsAL sth >>= (alrows @=?)++testfetchAllRowsMap = setup $ \dbh ->+ do sth <- prepare dbh "SELECT * from hdbctest2 ORDER BY testid"+ execute sth []+ fetchAllRowsMap sth >>= (map (Map.fromList) alrows @=?)++testexception = setup $ \dbh ->+ catchSql (do sth <- prepare dbh "SELECT invalidcol FROM hdbctest2"+ execute sth []+ assertFailure "No exception was raised"+ )+ (\e -> commit dbh)++testrowcount = setup $ \dbh ->+ do r <- run dbh "UPDATE hdbctest2 SET testint = 25 WHERE testid = 20" []+ assertEqual "UPDATE with no change" 0 r+ r <- run dbh "UPDATE hdbctest2 SET testint = 26 WHERE testid = 0" []+ assertEqual "UPDATE with 1 change" 1 r+ r <- run dbh "UPDATE hdbctest2 SET testint = 27 WHERE testid <> 0" []+ assertEqual "UPDATE with 2 changes" 2 r+ commit dbh+ res <- quickQuery dbh "SELECT * from hdbctest2 ORDER BY testid" []+ assertEqual "final results"+ [[SqlInt32 0, toSql "Testing", SqlInt32 26],+ [SqlInt32 1, toSql "Foo", SqlInt32 27],+ [SqlInt32 2, toSql "Bar", SqlInt32 27]] res+ +{- Since we might be running against a live DB, we can't look at a specific+list here (though a SpecificDB test case may be able to). We can ensure+that our test table is, or is not, present, as appropriate. -}+ +testgetTables1 = setup $ \dbh ->+ do r <- getTables dbh+ True @=? "hdbctest2" `elem` r++testgetTables2 = dbTestCase $ \dbh ->+ do r <- getTables dbh+ False @=? "hdbctest2" `elem` r++testclone = setup $ \dbho -> cloneTest dbho $ \dbh ->+ do results <- quickQuery dbh "SELECT * from hdbctest2 ORDER BY testid" []+ rowdata @=? results++testnulls = setup $ \dbh ->+ do let dn = hdbcDriverName dbh+ when (not (dn `elem` ["postgresql", "odbc"])) (+ do sth <- prepare dbh "INSERT INTO hdbctest2 VALUES (?, ?, ?)"+ executeMany sth rows+ finish sth+ res <- quickQuery dbh "SELECT * from hdbctest2 WHERE testid > 99 ORDER BY testid" []+ seq (length res) rows @=? res+ )+ where rows = [[SqlInt32 100, SqlString "foo\NULbar", SqlNull],+ [SqlInt32 101, SqlString "bar\NUL", SqlNull],+ [SqlInt32 102, SqlString "\NUL", SqlNull],+ [SqlInt32 103, SqlString "\xFF", SqlNull],+ [SqlInt32 104, SqlString "regular", SqlNull]]+ +testunicode = setup $ \dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest2 VALUES (?, ?, ?)"+ executeMany sth rows+ finish sth+ res <- quickQuery dbh "SELECT * from hdbctest2 WHERE testid > 99 ORDER BY testid" []+ seq (length res) rows @=? res+ where rows = [[SqlInt32 100, SqlString "foo\x263a", SqlNull],+ [SqlInt32 101, SqlString "bar\x00A3", SqlNull],+ [SqlInt32 102, SqlString (take 263 (repeat 'a')), SqlNull]]++tests = TestList [TestLabel "getColumnNames" testgetColumnNames,+ TestLabel "describeResult" testdescribeResult,+ TestLabel "describeTable" testdescribeTable,+ TestLabel "quickQuery" testquickQuery,+ TestLabel "fetchRowAL" testfetchRowAL,+ TestLabel "fetchRowMap" testfetchRowMap,+ TestLabel "fetchAllRowsAL" testfetchAllRowsAL,+ TestLabel "fetchAllRowsMap" testfetchAllRowsMap,+ TestLabel "sql exception" testexception,+ TestLabel "clone" testclone,+ TestLabel "update rowcount" testrowcount,+ TestLabel "get tables1" testgetTables1,+ TestLabel "get tables2" testgetTables2,+ TestLabel "nulls" testnulls,+ TestLabel "unicode" testunicode]
+ testsrc/TestSbasics.hs view
@@ -0,0 +1,150 @@+module TestSbasics(tests) where+import Test.HUnit+import Database.HDBC+import TestUtils+import System.IO+import Control.Exception hiding (catch)++openClosedb = sqlTestCase $ + do dbh <- connectDB+ disconnect dbh++multiFinish = dbTestCase (\dbh ->+ do sth <- prepare dbh "SELECT 1 + 1"+ sExecute sth []+ finish sth+ finish sth+ finish sth+ )++basicQueries = dbTestCase (\dbh ->+ do sth <- prepare dbh "SELECT 1 + 1"+ sExecute sth []+ sFetchRow sth >>= (assertEqual "row 1" (Just [Just "2"]))+ sFetchRow sth >>= (assertEqual "last row" Nothing)+ )+ +createTable = dbTestCase (\dbh ->+ do sRun dbh "CREATE TABLE hdbctest1 (testname VARCHAR(20), testid INTEGER, testint INTEGER, testtext TEXT)" []+ commit dbh+ )++dropTable = dbTestCase (\dbh ->+ do sRun dbh "DROP TABLE hdbctest1" []+ commit dbh+ )++runReplace = dbTestCase (\dbh ->+ do sRun dbh "INSERT INTO hdbctest1 VALUES (?, ?, ?, ?)" r1+ sRun dbh "INSERT INTO hdbctest1 VALUES (?, ?, 2, ?)" r2+ commit dbh+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = 'runReplace' ORDER BY testid"+ sExecute sth []+ sFetchRow sth >>= (assertEqual "r1" (Just r1))+ sFetchRow sth >>= (assertEqual "r2" (Just [Just "runReplace", Just "2",+ Just "2", Nothing]))+ sFetchRow sth >>= (assertEqual "lastrow" Nothing)+ )+ where r1 = [Just "runReplace", Just "1", Just "1234", Just "testdata"]+ r2 = [Just "runReplace", Just "2", Nothing]++executeReplace = dbTestCase (\dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('executeReplace',?,?,?)"+ sExecute sth [Just "1", Just "1234", Just "Foo"]+ sExecute sth [Just "2", Nothing, Just "Bar"]+ commit dbh+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = ? ORDER BY testid"+ sExecute sth [Just "executeReplace"]+ sFetchRow sth >>= (assertEqual "r1" + (Just $ map Just ["executeReplace", "1", "1234", + "Foo"]))+ sFetchRow sth >>= (assertEqual "r2"+ (Just [Just "executeReplace", Just "2", Nothing,+ Just "Bar"]))+ sFetchRow sth >>= (assertEqual "lastrow" Nothing)+ )++testExecuteMany = dbTestCase (\dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('multi',?,?,?)"+ sExecuteMany sth rows+ commit dbh+ sth <- prepare dbh "SELECT testid, testint, testtext FROM hdbctest1 WHERE testname = 'multi'"+ sExecute sth []+ mapM_ (\r -> sFetchRow sth >>= (assertEqual "" (Just r))) rows+ sFetchRow sth >>= (assertEqual "lastrow" Nothing)+ )+ where rows = [map Just ["1", "1234", "foo"],+ map Just ["2", "1341", "bar"],+ [Just "3", Nothing, Nothing]]++testsFetchAllRows = dbTestCase (\dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('sFetchAllRows', ?, NULL, NULL)"+ sExecuteMany sth rows+ commit dbh+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'sFetchAllRows' ORDER BY testid"+ sExecute sth []+ results <- sFetchAllRows sth+ assertEqual "" rows results+ )+ where rows = map (\x -> [Just . show $ x]) [1..9]++basicTransactions = dbTestCase (\dbh ->+ do assertBool "Connected database does not support transactions; skipping transaction test" (dbTransactionSupport dbh)+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('basicTransactions', ?, NULL, NULL)"+ sExecute sth [Just "0"]+ commit dbh+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'basicTransactions' ORDER BY testid"+ sExecute qrysth []+ sFetchAllRows qrysth >>= (assertEqual "initial commit" [[Just "0"]])++ -- Now try a rollback+ sExecuteMany sth rows+ rollback dbh+ sExecute qrysth []+ sFetchAllRows qrysth >>= (assertEqual "rollback" [[Just "0"]])++ -- Now try another commit+ sExecuteMany sth rows+ commit dbh+ sExecute qrysth []+ sFetchAllRows qrysth >>= (assertEqual "final commit" ([Just "0"]:rows))+ )+ where rows = map (\x -> [Just . show $ x]) [1..9]++testWithTransaction = dbTestCase (\dbh ->+ do assertBool "Connected database does not support transactions; skipping transaction test" (dbTransactionSupport dbh)+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('withTransaction', ?, NULL, NULL)"+ sExecute sth [Just "0"]+ commit dbh+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'withTransaction' ORDER BY testid"+ sExecute qrysth []+ sFetchAllRows qrysth >>= (assertEqual "initial commit" [[Just "0"]])+ + -- Let's try a rollback.+ catch (withTransaction dbh (\_ -> do sExecuteMany sth rows+ fail "Foo"))+ (\_ -> return ())+ sExecute qrysth []+ sFetchAllRows qrysth >>= (assertEqual "rollback" [[Just "0"]])++ -- And now a commit.+ withTransaction dbh (\_ -> sExecuteMany sth rows)+ sExecute qrysth []+ sFetchAllRows qrysth >>= (assertEqual "final commit" ([Just "0"]:rows))+ )+ where rows = map (\x -> [Just . show $ x]) [1..9]+ +tests = TestList+ [+ TestLabel "openClosedb" openClosedb,+ TestLabel "multiFinish" multiFinish,+ TestLabel "basicQueries" basicQueries,+ TestLabel "createTable" createTable,+ TestLabel "runReplace" runReplace,+ TestLabel "executeReplace" executeReplace,+ TestLabel "executeMany" testExecuteMany,+ TestLabel "sFetchAllRows" testsFetchAllRows,+ TestLabel "basicTransactions" basicTransactions,+ TestLabel "withTransaction" testWithTransaction,+ TestLabel "dropTable" dropTable+ ]
+ testsrc/TestUtils.hs view
@@ -0,0 +1,25 @@+module TestUtils(connectDB, sqlTestCase, dbTestCase, printDBInfo) where+import Database.HDBC+import Test.HUnit+import Control.Exception+import SpecificDB(connectDB)++sqlTestCase a = + TestCase (handleSqlError a)++dbTestCase a =+ TestCase (do dbh <- connectDB+ finally (handleSqlError (a dbh))+ (handleSqlError (disconnect dbh))+ )++printDBInfo = handleSqlError $+ do dbh <- connectDB+ putStrLn "+-------------------------------------------------------------------------"+ putStrLn $ "| Testing HDBC database module: " ++ hdbcDriverName dbh +++ ", bound to client: " ++ hdbcClientVer dbh+ putStrLn $ "| Proxied driver: " ++ proxiedClientName dbh +++ ", bound to version: " ++ proxiedClientVer dbh+ putStrLn $ "| Connected to server version: " ++ dbServerVer dbh+ putStrLn "+-------------------------------------------------------------------------\n"+ disconnect dbh
+ testsrc/Testbasics.hs view
@@ -0,0 +1,168 @@+module Testbasics(tests) where+import Test.HUnit+import Database.HDBC+import TestUtils+import System.IO+import Control.Exception hiding (catch)++openClosedb = sqlTestCase $ + do dbh <- connectDB+ disconnect dbh++multiFinish = dbTestCase (\dbh ->+ do sth <- prepare dbh "SELECT 1 + 1"+ r <- execute sth []+ assertEqual "basic count" 0 r+ finish sth+ finish sth+ finish sth+ )++basicQueries = dbTestCase (\dbh ->+ do sth <- prepare dbh "SELECT 1 + 1"+ execute sth [] >>= (0 @=?)+ r <- fetchAllRows sth+ assertEqual "converted from" [["2"]] (map (map fromSql) r)+ assertEqual "int32 compare" [[SqlInt32 2]] r+ assertEqual "iToSql compare" [[iToSql 2]] r+ assertEqual "num compare" [[toSql (2::Int)]] r+ assertEqual "nToSql compare" [[nToSql (2::Int)]] r+ assertEqual "string compare" [[SqlString "2"]] r+ )+ +createTable = dbTestCase (\dbh ->+ do run dbh "CREATE TABLE hdbctest1 (testname VARCHAR(20), testid INTEGER, testint INTEGER, testtext TEXT)" []+ commit dbh+ )++dropTable = dbTestCase (\dbh ->+ do run dbh "DROP TABLE hdbctest1" []+ commit dbh+ )++runReplace = dbTestCase (\dbh ->+ do r <- run dbh "INSERT INTO hdbctest1 VALUES (?, ?, ?, ?)" r1+ assertEqual "insert retval" 1 r+ run dbh "INSERT INTO hdbctest1 VALUES (?, ?, ?, ?)" r2+ commit dbh+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = 'runReplace' ORDER BY testid"+ rv2 <- execute sth []+ assertEqual "select retval" 0 rv2+ r <- fetchAllRows sth+ assertEqual "" [r1, r2] r+ )+ where r1 = [toSql "runReplace", iToSql 1, iToSql 1234, SqlString "testdata"] + r2 = [toSql "runReplace", iToSql 2, iToSql 2, SqlNull]++executeReplace = dbTestCase (\dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('executeReplace',?,?,?)"+ execute sth [iToSql 1, iToSql 1234, toSql "Foo"]+ execute sth [SqlInt32 2, SqlNull, toSql "Bar"]+ commit dbh+ sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = ? ORDER BY testid"+ execute sth [SqlString "executeReplace"]+ r <- fetchAllRows sth+ assertEqual "result"+ [[toSql "executeReplace", iToSql 1, toSql "1234",+ toSql "Foo"],+ [toSql "executeReplace", iToSql 2, SqlNull,+ toSql "Bar"]]+ r+ )++testExecuteMany = dbTestCase (\dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('multi',?,?,?)"+ executeMany sth rows+ commit dbh+ sth <- prepare dbh "SELECT testid, testint, testtext FROM hdbctest1 WHERE testname = 'multi'"+ execute sth []+ r <- fetchAllRows sth+ assertEqual "" rows r+ )+ where rows = [map toSql ["1", "1234", "foo"],+ map toSql ["2", "1341", "bar"],+ [toSql "3", SqlNull, SqlNull]]++testFetchAllRows = dbTestCase (\dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('fetchAllRows', ?, NULL, NULL)"+ executeMany sth rows+ commit dbh+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'fetchAllRows' ORDER BY testid"+ execute sth []+ results <- fetchAllRows sth+ assertEqual "" rows results+ )+ where rows = map (\x -> [iToSql x]) [1..9]++testFetchAllRows' = dbTestCase (\dbh ->+ do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('fetchAllRows2', ?, NULL, NULL)"+ executeMany sth rows+ commit dbh+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'fetchAllRows2' ORDER BY testid"+ execute sth []+ results <- fetchAllRows' sth+ assertEqual "" rows results+ )+ where rows = map (\x -> [iToSql x]) [1..9]++basicTransactions = dbTestCase (\dbh ->+ do assertBool "Connected database does not support transactions; skipping transaction test" (dbTransactionSupport dbh)+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('basicTransactions', ?, NULL, NULL)"+ execute sth [iToSql 0]+ commit dbh+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'basicTransactions' ORDER BY testid"+ execute qrysth []+ fetchAllRows qrysth >>= (assertEqual "initial commit" [[toSql "0"]])++ -- Now try a rollback+ executeMany sth rows+ rollback dbh+ execute qrysth []+ fetchAllRows qrysth >>= (assertEqual "rollback" [[toSql "0"]])++ -- Now try another commit+ executeMany sth rows+ commit dbh+ execute qrysth []+ fetchAllRows qrysth >>= (assertEqual "final commit" ([SqlString "0"]:rows))+ )+ where rows = map (\x -> [iToSql $ x]) [1..9]++testWithTransaction = dbTestCase (\dbh ->+ do assertBool "Connected database does not support transactions; skipping transaction test" (dbTransactionSupport dbh)+ sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('withTransaction', ?, NULL, NULL)"+ execute sth [toSql "0"]+ commit dbh+ qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'withTransaction' ORDER BY testid"+ execute qrysth []+ fetchAllRows qrysth >>= (assertEqual "initial commit" [[toSql "0"]])+ + -- Let's try a rollback.+ catch (withTransaction dbh (\_ -> do executeMany sth rows+ fail "Foo"))+ (\_ -> return ())+ execute qrysth []+ fetchAllRows qrysth >>= (assertEqual "rollback" [[SqlString "0"]])++ -- And now a commit.+ withTransaction dbh (\_ -> executeMany sth rows)+ execute qrysth []+ fetchAllRows qrysth >>= (assertEqual "final commit" ([iToSql 0]:rows))+ )+ where rows = map (\x -> [iToSql x]) [1..9]+ +tests = TestList+ [+ TestLabel "openClosedb" openClosedb,+ TestLabel "multiFinish" multiFinish,+ TestLabel "basicQueries" basicQueries,+ TestLabel "createTable" createTable,+ TestLabel "runReplace" runReplace,+ TestLabel "executeReplace" executeReplace,+ TestLabel "executeMany" testExecuteMany,+ TestLabel "fetchAllRows" testFetchAllRows,+ TestLabel "fetchAllRows'" testFetchAllRows',+ TestLabel "basicTransactions" basicTransactions,+ TestLabel "withTransaction" testWithTransaction,+ TestLabel "dropTable" dropTable+ ]
+ testsrc/Tests.hs view
@@ -0,0 +1,34 @@+{- arch-tag: Tests main file+Copyright (C) 2004-2005 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Tests(tests) where+import Test.HUnit+import qualified Testbasics+import qualified TestSbasics+import qualified SpecificDBTests+import qualified TestMisc+import qualified TestTime++test1 = TestCase ("x" @=? "x")++tests = TestList [TestLabel "test1" test1,+ TestLabel "String basics" TestSbasics.tests,+ TestLabel "SqlValue basics" Testbasics.tests,+ TestLabel "SpecificDB" SpecificDBTests.tests,+ TestLabel "Misc tests" TestMisc.tests,+ TestLabel "Time tests" TestTime.tests]
+ testsrc/runtests.hs view
@@ -0,0 +1,27 @@+{- arch-tag: Test runner+Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Main where ++import Test.HUnit+import Tests+import TestUtils++main = do printDBInfo+ runTestTT tests+