/testsrc/TestSbasics.hs

  1module TestSbasics(tests) where
  2import Test.HUnit
  3import Data.List
  4import Database.HDBC
  5import TestUtils
  6import System.IO
  7import Control.Exception
  8
  9openClosedb = sqlTestCase $ 
 10    do dbh <- connectDB
 11       disconnect dbh
 12
 13multiFinish = dbTestCase (\dbh ->
 14    do sth <- prepare dbh "SELECT 1 + 1"
 15       sExecute sth []
 16       finish sth
 17       finish sth
 18       finish sth
 19                          )
 20
 21runRawTest = dbTestCase (\dbh ->
 22    do runRaw dbh "CREATE TABLE valid1 (a int); CREATE TABLE valid2 (a int)"
 23       tables <- getTables dbh
 24       assertBool "valid1 table not created!" ("valid1" `elem` tables)
 25       assertBool "valid2 table not created!" ("valid2" `elem` tables)
 26                        )
 27
 28runRawErrorTest = dbTestCase (\dbh ->
 29    let expected = "ERROR:  syntax error at or near \"INVALID\""
 30    in do err <- (runRaw dbh "CREATE TABLE valid1 (a int); INVALID" >> return "No error") `catchSql`
 31                 (return . seErrorMsg)
 32          assertBool "Error message inappropriate" (expected `isInfixOf` err)
 33          rollback dbh
 34          tables <- getTables dbh
 35          assertBool "valid1 table created!" (not $ "valid1" `elem` tables)
 36                             )
 37
 38
 39basicQueries = dbTestCase (\dbh ->
 40    do sth <- prepare dbh "SELECT 1 + 1"
 41       sExecute sth []
 42       sFetchRow sth >>= (assertEqual "row 1" (Just [Just "2"]))
 43       sFetchRow sth >>= (assertEqual "last row" Nothing)
 44                          )
 45    
 46createTable = dbTestCase (\dbh ->
 47    do sRun dbh "CREATE TABLE hdbctest1 (testname VARCHAR(20), testid INTEGER, testint INTEGER, testtext TEXT)" []
 48       commit dbh
 49                         )
 50
 51dropTable = dbTestCase (\dbh ->
 52    do sRun dbh "DROP TABLE hdbctest1" []
 53       commit dbh
 54                       )
 55
 56runReplace = dbTestCase (\dbh ->
 57    do sRun dbh "INSERT INTO hdbctest1 VALUES (?, ?, ?, ?)" r1
 58       sRun dbh "INSERT INTO hdbctest1 VALUES (?, ?, 2, ?)" r2
 59       commit dbh
 60       sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = 'runReplace' ORDER BY testid"
 61       sExecute sth []
 62       sFetchRow sth >>= (assertEqual "r1" (Just r1))
 63       sFetchRow sth >>= (assertEqual "r2" (Just [Just "runReplace", Just "2",
 64                                                 Just "2", Nothing]))
 65       sFetchRow sth >>= (assertEqual "lastrow" Nothing)
 66                       )
 67    where r1 = [Just "runReplace", Just "1", Just "1234", Just "testdata"]
 68          r2 = [Just "runReplace", Just "2", Nothing]
 69
 70executeReplace = dbTestCase (\dbh ->
 71    do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('executeReplace',?,?,?)"
 72       sExecute sth [Just "1", Just "1234", Just "Foo"]
 73       sExecute sth [Just "2", Nothing, Just "Bar"]
 74       commit dbh
 75       sth <- prepare dbh "SELECT * FROM hdbctest1 WHERE testname = ? ORDER BY testid"
 76       sExecute sth [Just "executeReplace"]
 77       sFetchRow sth >>= (assertEqual "r1" 
 78                         (Just $ map Just ["executeReplace", "1", "1234", 
 79                                           "Foo"]))
 80       sFetchRow sth >>= (assertEqual "r2"
 81                         (Just [Just "executeReplace", Just "2", Nothing,
 82                                Just "Bar"]))
 83       sFetchRow sth >>= (assertEqual "lastrow" Nothing)
 84                            )
 85
 86testExecuteMany = dbTestCase (\dbh ->
 87    do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('multi',?,?,?)"
 88       sExecuteMany sth rows
 89       commit dbh
 90       sth <- prepare dbh "SELECT testid, testint, testtext FROM hdbctest1 WHERE testname = 'multi'"
 91       sExecute sth []
 92       mapM_ (\r -> sFetchRow sth >>= (assertEqual "" (Just r))) rows
 93       sFetchRow sth >>= (assertEqual "lastrow" Nothing)
 94                          )
 95    where rows = [map Just ["1", "1234", "foo"],
 96                  map Just ["2", "1341", "bar"],
 97                  [Just "3", Nothing, Nothing]]
 98
 99testsFetchAllRows = dbTestCase (\dbh ->
100    do sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('sFetchAllRows', ?, NULL, NULL)"
101       sExecuteMany sth rows
102       commit dbh
103       sth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'sFetchAllRows' ORDER BY testid"
104       sExecute sth []
105       results <- sFetchAllRows sth
106       assertEqual "" rows results
107                               )
108    where rows = map (\x -> [Just . show $ x]) [1..9]
109
110basicTransactions = dbTestCase (\dbh ->
111    do assertBool "Connected database does not support transactions; skipping transaction test" (dbTransactionSupport dbh)
112       sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('basicTransactions', ?, NULL, NULL)"
113       sExecute sth [Just "0"]
114       commit dbh
115       qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'basicTransactions' ORDER BY testid"
116       sExecute qrysth []
117       sFetchAllRows qrysth >>= (assertEqual "initial commit" [[Just "0"]])
118
119       -- Now try a rollback
120       sExecuteMany sth rows
121       rollback dbh
122       sExecute qrysth []
123       sFetchAllRows qrysth >>= (assertEqual "rollback" [[Just "0"]])
124
125       -- Now try another commit
126       sExecuteMany sth rows
127       commit dbh
128       sExecute qrysth []
129       sFetchAllRows qrysth >>= (assertEqual "final commit" ([Just "0"]:rows))
130                               )
131    where rows = map (\x -> [Just . show $ x]) [1..9]
132
133testWithTransaction = dbTestCase (\dbh ->
134    do assertBool "Connected database does not support transactions; skipping transaction test" (dbTransactionSupport dbh)
135       sth <- prepare dbh "INSERT INTO hdbctest1 VALUES ('withTransaction', ?, NULL, NULL)"
136       sExecute sth [Just "0"]
137       commit dbh
138       qrysth <- prepare dbh "SELECT testid FROM hdbctest1 WHERE testname = 'withTransaction' ORDER BY testid"
139       sExecute qrysth []
140       sFetchAllRows qrysth >>= (assertEqual "initial commit" [[Just "0"]])
141       
142       -- Let's try a rollback.
143       catch (withTransaction dbh (\_ -> do sExecuteMany sth rows
144                                            fail "Foo"))
145             (\SomeException{} -> return ())
146       sExecute qrysth []
147       sFetchAllRows qrysth >>= (assertEqual "rollback" [[Just "0"]])
148
149       -- And now a commit.
150       withTransaction dbh (\_ -> sExecuteMany sth rows)
151       sExecute qrysth []
152       sFetchAllRows qrysth >>= (assertEqual "final commit" ([Just "0"]:rows))
153                               )
154    where rows = map (\x -> [Just . show $ x]) [1..9]
155       
156tests = TestList
157        [
158         TestLabel "openClosedb" openClosedb,
159         TestLabel "multiFinish" multiFinish,
160         TestLabel "runRawTest" runRawTest,
161         TestLabel "runRawErrorTest" runRawErrorTest,
162         TestLabel "basicQueries" basicQueries,
163         TestLabel "createTable" createTable,
164         TestLabel "runReplace" runReplace,
165         TestLabel "executeReplace" executeReplace,
166         TestLabel "executeMany" testExecuteMany,
167         TestLabel "sFetchAllRows" testsFetchAllRows,
168         TestLabel "basicTransactions" basicTransactions,
169         TestLabel "withTransaction" testWithTransaction,
170         TestLabel "dropTable" dropTable
171         ]