HDBC-odbc 2.1.0.0 → 2.2.0.0
raw patch · 10 files changed
+632/−9 lines, 10 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Database/HDBC/ODBC/Statement.hsc +15/−5
- HDBC-odbc.cabal +4/−4
- testsrc/SpecificDB.hs +24/−0
- testsrc/SpecificDBTests.hs +5/−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/ODBC/Statement.hsc view
@@ -281,9 +281,15 @@ return (stmt, Just res) where getCol cstmt icol = do let defaultLen = 128+ colinfo <- readMVar (colinfomv sstate)+ let cBinding = case colType (snd (colinfo !! ((fromIntegral icol) - 1))) of+ SqlBinaryT -> #{const SQL_C_BINARY}+ SqlVarBinaryT -> #{const SQL_C_BINARY}+ SqlLongVarBinaryT -> #{const SQL_C_BINARY}+ _ -> #{const SQL_CHAR} alloca $ \plen -> allocaBytes defaultLen $ \buf ->- do res <- sqlGetData cstmt (fromIntegral icol) #{const SQL_CHAR}+ do res <- sqlGetData cstmt (fromIntegral icol) cBinding buf (fromIntegral defaultLen) plen case res of #{const SQL_SUCCESS} ->@@ -291,17 +297,21 @@ case len of #{const SQL_NULL_DATA} -> return SqlNull #{const SQL_NO_TOTAL} -> fail $ "Unexpected SQL_NO_TOTAL"- len -> do bs <- B.packCString buf+ len -> do bs <- B.packCStringLen (buf, fromIntegral len) l $ "col is: " ++ show (BUTF8.toString bs) return (SqlByteString bs) #{const SQL_SUCCESS_WITH_INFO} -> do len <- peek plen allocaBytes (fromIntegral len + 1) $ \buf2 ->- do sqlGetData cstmt (fromIntegral icol) #{const SQL_CHAR}+ do sqlGetData cstmt (fromIntegral icol) cBinding buf2 (fromIntegral len + 1) plen >>= checkError "sqlGetData" (StmtHandle cstmt)- bs <- liftM2 (B.append) (B.packCString buf)- (B.packCString buf2)+ len2 <- peek plen+ let firstbuf = case cBinding of+ #{const SQL_C_BINARY} -> defaultLen+ _ -> defaultLen - 1 -- strip off NUL+ bs <- liftM2 (B.append) (B.packCStringLen (buf, firstbuf))+ (B.packCStringLen (buf2, fromIntegral len2)) l $ "col is: " ++ (BUTF8.toString bs) return (SqlByteString bs) res -> raiseError "sqlGetData" res (StmtHandle cstmt)
HDBC-odbc.cabal view
@@ -1,5 +1,5 @@ Name: HDBC-odbc-Version: 2.1.0.0+Version: 2.2.0.0 Cabal-Version: >=1.2.3 Build-type: Simple License: LGPL@@ -33,7 +33,7 @@ ExistentialQuantification, ForeignFunctionInterface, PatternSignatures- Build-Depends: base, mtl, HDBC>=2.1.0, utf8-string, bytestring+ Build-Depends: base >= 3 && < 5, mtl, HDBC>=2.1.0, utf8-string, bytestring if impl(ghc >= 6.9) Build-Depends: base >= 4 GHC-Options: -O2@@ -48,10 +48,10 @@ Executable runtests if flag(buildtests) Buildable: True+ Build-Depends: HUnit, QuickCheck, testpack, containers, old-time,+ time, old-locale, convertible else Buildable: False- Build-Depends: HUnit, QuickCheck, testpack, containers, old-time,- time, old-locale, convertible Main-Is: runtests.hs Other-Modules: Database.HDBC.ODBC, Database.HDBC.ODBC.Connection,
+ testsrc/SpecificDB.hs view
@@ -0,0 +1,24 @@+module SpecificDB where+import Database.HDBC+import Database.HDBC.ODBC+import Test.HUnit++connectDB = + handleSqlError (connectODBC "DSN=hdbctest")+++-- These are copied from PostgreSQL for now, except for interval+dateTimeTypeOfSqlValue :: SqlValue -> String+dateTimeTypeOfSqlValue (SqlLocalDate _) = "date"+dateTimeTypeOfSqlValue (SqlLocalTimeOfDay _) = "time without time zone"+dateTimeTypeOfSqlValue (SqlZonedLocalTimeOfDay _ _) = "time with time zone"+dateTimeTypeOfSqlValue (SqlLocalTime _) = "timestamp without time zone"+dateTimeTypeOfSqlValue (SqlZonedTime _) = "timestamp with time zone"+dateTimeTypeOfSqlValue (SqlUTCTime _) = "timestamp with time zone"+dateTimeTypeOfSqlValue (SqlDiffTime _) = "numeric"+dateTimeTypeOfSqlValue (SqlPOSIXTime _) = "numeric"+dateTimeTypeOfSqlValue (SqlEpochTime _) = "integer"+dateTimeTypeOfSqlValue (SqlTimeDiff _) = "numeric"+dateTimeTypeOfSqlValue _ = "text"++supportsFracTime = True
+ testsrc/SpecificDBTests.hs view
@@ -0,0 +1,5 @@+module SpecificDBTests where+import Database.HDBC+import Test.HUnit++tests = TestList []
+ 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 ('sFetchAllRows', ?, NULL, NULL)"+ executeMany sth rows+ commit dbh+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'sFetchAllRows' 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 ('sFetchAllRows2', ?, NULL, NULL)"+ executeMany sth rows+ commit dbh+ sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'sFetchAllRows2' 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+