/testsrc/TestSbasics.hs

http://github.com/hdbc/hdbc-postgresql · Haskell · 171 lines · 148 code · 19 blank · 4 comment · 0 complexity · b079ed6407889f38df19f00f3b3631a6 MD5 · raw file

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