Commits

Luke Plant committed b0a875f

Added basic tests for slug generation

  • Participants
  • Parent commits de4c0c3

Comments (0)

Files changed (4)

src/Blog/settingslocal.hs

 sqlite_path = "/home/luke/httpd/lukeplant.me.uk/web/cgi-bin/data/test1.db"
 root_url = "/blog/"
 
+-- Testing
+testdb_sqlite_path = "/home/luke/devel/haskell/haskellblog/testsuite/test.db"
 
 -- Migration time settings:
 

testsuite/tests/Blog/DBUtils.hs

-module Tests.Blog.DBUtils
-
-where
-
-import Blog.DBUtils
-import Test.HUnit
-
-tests = test [
-         "slugFromTitle1" ~: "this-is-a-title" ~=? (slugFromTitle "This is a % $ /title ^£$")
-        ]

testsuite/tests/Test/Blog/DBUtils.hs

+module Tests.Blog.DBUtils
+
+where
+
+import Blog.DBUtils
+import Database.HDBC
+import Test.HUnit
+import qualified Test.Blog.TestDB as TestDB
+
+makeTestSlugTable cn = do
+  quickQuery cn "CREATE TABLE slugs (id INTEGER PRIMARY KEY AUTOINCREMENT, title TEXT, slug TEXT);" []
+
+insertSlug cn title slug = do
+  quickQuery cn "INSERT INTO slugs (title, slug) VALUES (?, ?);" [toSql title, toSql slug]
+
+slugFromTitle1 =  "this-is-a-title" ~=? (slugFromTitle "This is a % $ /title ^£$")
+makeSlugGeneric1 = do
+  cn <- TestDB.connect;
+  makeTestSlugTable cn
+  slug1 <- makeSlugGeneric cn "This is a title" "slugs" 1
+  assertEqual "" "this-is-a-title" slug1
+  insertSlug cn "This is a title" slug1
+  slug2 <- makeSlugGeneric cn "This is a title" "slugs" 1
+  insertSlug cn "This is a title" slug2
+  assertEqual "" "this-is-a-title2" slug2
+
+tests = test [
+         slugFromTitle1,
+         TestCase makeSlugGeneric1
+        ]

testsuite/tests/Test/Blog/TestDB.hs

+module Test.Blog.TestDB where
+
+import Database.HDBC.Sqlite3 (connectSqlite3)
+import qualified Blog.Settings as Settings
+
+connect = connectSqlite3 Settings.testdb_sqlite_path