1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
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
)
runRawTest = dbTestCase (\dbh ->
do runRaw dbh "CREATE TABLE valid1 (a int); CREATE TABLE valid2 (a int)"
tables <- getTables dbh
assertBool "valid1 table not created!" ("valid1" `elem` tables)
assertBool "valid2 table not created!" ("valid2" `elem` tables)
)
runRawErrorTest = dbTestCase (\dbh ->
do err <- (runRaw dbh "CREATE TABLE valid1 (a int); INVALID" >> return "No error") `catchSql`
(return . seErrorMsg)
assertEqual "exception text" "exec: near \"INVALID\": syntax error" err
rollback dbh
tables <- getTables dbh
assertBool "valid1 table created!" (not $ "valid1" `elem` tables)
)
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 "runRawTest" runRawTest,
TestLabel "runRawErrorTest" runRawErrorTest,
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
]
|
