diff --git a/Database/HDBC/Sqlite3.hs b/Database/HDBC/Sqlite3.hs --- a/Database/HDBC/Sqlite3.hs +++ b/Database/HDBC/Sqlite3.hs @@ -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 diff --git a/Database/HDBC/Sqlite3/Connection.hs b/Database/HDBC/Sqlite3/Connection.hs --- a/Database/HDBC/Sqlite3/Connection.hs +++ b/Database/HDBC/Sqlite3/Connection.hs @@ -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 diff --git a/HDBC-sqlite3.cabal b/HDBC-sqlite3.cabal --- a/HDBC-sqlite3.cabal +++ b/HDBC-sqlite3.cabal @@ -1,5 +1,5 @@ Name: HDBC-sqlite3 -Version: 2.1.0.0 +Version: 2.1.0.2 License: LGPL Maintainer: John Goerzen 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, diff --git a/testsrc/SpecificDB.hs b/testsrc/SpecificDB.hs new file mode 100644 --- /dev/null +++ b/testsrc/SpecificDB.hs @@ -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 diff --git a/testsrc/SpecificDBTests.hs b/testsrc/SpecificDBTests.hs new file mode 100644 --- /dev/null +++ b/testsrc/SpecificDBTests.hs @@ -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] diff --git a/testsrc/TestMisc.hs b/testsrc/TestMisc.hs new file mode 100644 --- /dev/null +++ b/testsrc/TestMisc.hs @@ -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] diff --git a/testsrc/TestSbasics.hs b/testsrc/TestSbasics.hs new file mode 100644 --- /dev/null +++ b/testsrc/TestSbasics.hs @@ -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 + ] diff --git a/testsrc/TestUtils.hs b/testsrc/TestUtils.hs new file mode 100644 --- /dev/null +++ b/testsrc/TestUtils.hs @@ -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 diff --git a/testsrc/Testbasics.hs b/testsrc/Testbasics.hs new file mode 100644 --- /dev/null +++ b/testsrc/Testbasics.hs @@ -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 + ] diff --git a/testsrc/Tests.hs b/testsrc/Tests.hs new file mode 100644 --- /dev/null +++ b/testsrc/Tests.hs @@ -0,0 +1,34 @@ +{- arch-tag: Tests main file +Copyright (C) 2004-2005 John Goerzen + +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] diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs new file mode 100644 --- /dev/null +++ b/testsrc/runtests.hs @@ -0,0 +1,27 @@ +{- arch-tag: Test runner +Copyright (C) 2004 John Goerzen + +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 +