Very rough first cut of testsuite

.gitignore

@@ -3,6 +3,6 @@
 Thumbs.db
 
 # Generated files
-dist/
+*dist/
 *.hi
 *.o

tests/Boilerplater.hs

@@ -0,0 +1,53 @@
+module Boilerplater where
+
+import Data.Char
+import Data.List
+import Data.List.Split
+import Data.Maybe
+
+import Language.Haskell.TH
+
+import Debug.Trace
+
+
+testProperties :: Q [Dec] -> Q Exp
+testProperties mdecs = do
+    decs <- mdecs
+    -- NB: the use of mkName here ensures we do late binding to the testProperty function. This means that
+    -- it can refer to either the function from QuickCheck or QuickCheck2 according to what the user has.
+    property_exprs <- sequence [[| $(varE (mkName "testProperty")) $(stringE prop_name) $(varE nm) |]
+                               | Just nm <- map decName_maybe decs
+                               , Just raw_prop_name <- [stripPrefix_maybe "prop_" (nameBase nm)]
+                               , let prop_name = humanize raw_prop_name ]
+    return $ LetE decs (ListE property_exprs)
+
+-- | Extracts a 'Name' from the declaration if it binds precisely one name
+decName_maybe :: Dec -> Maybe Name
+decName_maybe (FunD nm _clauses)    = Just nm
+decName_maybe (ValD pat _body _dec) = patName_maybe pat
+decName_maybe _                     = Nothing
+
+-- | Extracts a 'Name' from the pattern if it binds precisely one name
+patName_maybe :: Pat -> Maybe Name
+patName_maybe (VarP nm)      = Just nm
+patName_maybe (TildeP pat)   = patName_maybe pat
+patName_maybe (SigP pat _ty) = patName_maybe pat
+patName_maybe _              = Nothing
+
+stripPrefix_maybe :: String -> String -> Maybe String
+stripPrefix_maybe prefix what
+  | what_start == prefix = Just what_end
+  | otherwise            = trace ("Nothing: " ++ what) Nothing
+  where (what_start, what_end) = splitAt (length prefix) what
+
+-- | Makes a valid Haskell identifier more comprehensible to human eyes. For example:
+--
+-- > humanize "new_HashTable_is_empty" == "New HashTable is empty"
+humanize :: String -> String
+humanize identifier = case splitOneOf "_" identifier of
+    [] -> "(no name)"
+    (first_word:next_words) -> intercalate " " $ capitalizeFirstLetter first_word : next_words
+
+capitalizeFirstLetter :: String -> String
+capitalizeFirstLetter []     = []
+capitalizeFirstLetter (c:cs) = toUpper c : cs

tests/LICENSE

@@ -0,0 +1,22 @@
+Copyright (c) 2008, Maximilian Bolingbroke
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are permitted
+provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice, this list of
+      conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright notice, this list of
+      conditions and the following disclaimer in the documentation and/or other materials
+      provided with the distribution.
+    * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to
+      endorse or promote products derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

tests/Main.hs

@@ -0,0 +1,8 @@
+module Main (main) where
+
+import Properties (tests)
+
+import Test.Framework (defaultMain)
+
+main :: IO ()
+main = defaultMain tests

tests/Properties.hs

@@ -0,0 +1,31 @@
+module Properties (tests) where
+
+import Boilerplater
+
+import Data.HashTable.MArray
+
+
+import Control.Monad.ST
+
+import Data.Array.ST ( STArray )
+
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+
+
+tests :: [Test]
+tests = [
+        testGroup "Data.HashTable.MArray" data_hashtable_marray_tests
+    ]
+
+
+data_hashtable_marray_tests :: [Test]
+data_hashtable_marray_tests = $(testProperties [d|
+        --prop_fromList_toList_fromList_is_id (xs :: [(Int, Int)]) = fromList (toList (fromList xs)) == xs
+
+        prop_new_HashTable_is_empty = runST $ do
+            ht <- new :: ST s (HashTable (STArray s) (ST s) Int Int)
+            fmap null (toList ht)
+
+        --prop_insert_changes_value_at_key ht = runST $ ht
+    |])

tests/Setup.lhs

@@ -0,0 +1,4 @@
+#! /usr/bin/env runhaskell
+
+> import Distribution.Simple
+> main = defaultMain

tests/hashtables-tests.cabal

@@ -0,0 +1,27 @@
+Name:               hashtables-tests
+Version:            0.1
+Cabal-Version:      >= 1.2
+Category:           Data Structures
+Synopsis:           Tests for the hashtables package
+License:            BSD3
+License-File:       LICENSE
+Author:             Max Bolingbroke
+Maintainer:         batterseapower@hotmail.com
+Homepage:           http://github.com/batterseapower/hashtables
+Build-Type:         Simple
+
+
+Executable hashtables-tests
+        Main-Is:                Main.hs
+
+        Build-Depends:          base >= 3,
+                                containers >= 0.1.0.1,
+                                array >= 0.1,
+                                template-haskell >= 2.3,
+                                split >= 0.1,
+                                test-framework >= 0.2,
+                                test-framework-quickcheck2 >= 0.2,
+                                hashtables >= 0.1
+
+        Extensions:             ScopedTypeVariables,
+                                TemplateHaskell