Fixed late binding and function-names.

finnsson · May 12, 2010 · 94fbb02 · 94fbb02
1 parent 83e5e7a
commit 94fbb02
Show file tree

Hide file tree

Showing 5 changed files with 105 additions and 98 deletions.
diff --git a/README.markdown b/README.markdown
@@ -1,6 +1,6 @@
-# test-generator
+# test-framework-th
 
-Haskell-module to automagically generate repetetive code when writing HUnit-tests.
+Haskell-module to automagically generate repetetive code when writing HUnit/Quickcheck/Quickcheck2-tests.
 
 ## testGroupGenerator
 
@@ -17,16 +17,18 @@ Haskell-module to automagically generate repetetive code when writing HUnit-test
     -- file SomeModule.hs
     fooTestGroup = $(testGroupGenerator)
     main = defaultMain [fooTestGroup]
-    case1 = do 1 @=? 1
-    case2 = do 2 @=? 2
+    case_1 = do 1 @=? 1
+    case_2 = do 2 @=? 2
+    prop_reverse = reverse (reverse xs) == xs where types = xs::[Int]
 
 is the same as
 
     -- file SomeModule.hs
-    fooTestGroup = testGroup "SomeModule" [testCase "case1" case1, testCase "case2" case2]
+    fooTestGroup = testGroup "SomeModule" [testCase "1" case_1, testCase "2" case_2, testProperty "reverse" prop_reverse]
     main = defaultMain [fooTestGroup]
-    case1 = do 1 @=? 1
-    case2 = do 2 @=? 2
+    case_1 = do 1 @=? 1
+    case_2 = do 2 @=? 2
+    prop_reverse = reverse (reverse xs) == xs where types = xs::[Int]
 
 ## defaultMainGenerator
 
@@ -47,11 +49,13 @@ is the same as
 
     main = $(defaultMainGenerator)
 
-    caseFoo = do 4 @=? 4
+    case_Foo = do 4 @=? 4
 
-    caseBar = do "hej" @=? "hej"
+    case_Bar = do "hej" @=? "hej"
 
-will automagically extract testFoo and testBar and run them as well as present them as belonging to the testGroup 'MyModuleTest'. The above code is the same as
+    prop_reverse = reverse (reverse xs) == xs where types = xs::[Int]
+
+will automagically extract prop_reverse, case_Foo and case_Bar and run them as well as present them as belonging to the testGroup 'MyModuleTest'. The above code is the same as
 
     {-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}
     module MyModuleTest where
@@ -60,21 +64,25 @@ will automagically extract testFoo and testBar and run them as well as present t
 
     main =
       defaultMain [
-        testGroup "MyModuleTest" [ testCase "caseFoo" caseFoo, testCase "caseBar" caseBar]
+        testGroup "MyModuleTest" [ testCase "Foo" case_Foo, testCase "Bar" case_Bar, testProperty "reverse" prop_reverse]
         ]
 
-    caseFoo = do 4 @=? 4
+    case_Foo = do 4 @=? 4
 
-    caseBar = do "hej" @=? "hej"
+    case_Bar = do "hej" @=? "hej"
+
+    prop_reverse = reverse (reverse xs) == xs where types = xs::[Int]
 
 and will give the following result
 
     me: runghc MyModuleTest.hs 
     MyModuleTest:
-      caseFoo: [OK]
-      caseBar: [OK]
+      reverse: [OK, passed 100 tests]
+      Foo: [OK]
+      Bar: [OK]
      
-             Test Cases  Total      
-     Passed  2           2          
-     Failed  0           0          
-     Total   2           2 
+            Properties  Test Cases  Total      
+    Passed  1           2           3          
+    Failed  0           0           0          
+    Total   1           2           3 
+
diff --git a/src/TestGenerator.hs → src/Test/Framework/TH.hs b/src/TestGenerator.hs → src/Test/Framework/TH.hs
@@ -12,7 +12,7 @@
 -----------------------------------------------------------------------------
 {-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}
 
-module TestGenerator (
+module Test.Framework.TH (
   defaultMainGenerator,
   testGroupGenerator
 ) where
@@ -22,18 +22,12 @@ import Language.Haskell.Exts.Syntax
 import Text.Regex.Posix
 import Maybe
 import Language.Haskell.Exts.Extension
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
 import TemplateHelper
-import Test.Framework (Test)
-
-import Test.HUnit
-
 
 import Test.Framework (defaultMain, testGroup)
-import Test.Framework.Providers.HUnit
 
--- | Generate the usual code and extract the usual functions needed in order to run HUnit.
+-- | Generate the usual code and extract the usual functions needed in order to run HUnit/Quickcheck/Quickcheck2.
+--   All functions beginning with case_ or prop_ will be extracted.
 --  
 --   > {-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}
 --   > module MyModuleTest where
@@ -42,20 +36,20 @@ import Test.Framework.Providers.HUnit
 --   > 
 --   > main = $(defaultMainGenerator)
 --   >
---   > caseFoo = do 4 @=? 4
+--   > case_Foo = do 4 @=? 4
 --   >
---   > caseBar = do "hej" @=? "hej"
+--   > case_Bar = do "hej" @=? "hej"
 --   > 
---   > propReverse xs = reverse (reverse xs) == xs
+--   > prop_Reverse xs = reverse (reverse xs) == xs
 --   >   where types = xs :: [Int]
 --   
---   will automagically extract caseFoo and caseBar and run them as well as present them as belonging to the testGroup 'MyModuleTest' such as
+--   will automagically extract prop_Reverse, case_Foo and case_Bar and run them as well as present them as belonging to the testGroup 'MyModuleTest' such as
 --
 --   > me: runghc MyModuleTest.hs 
 --   > MyModuleTest:
---   >   propReverse: [OK, passed 100 tests]
---   >   caseFoo: [OK]
---   >   caseBar: [OK]
+--   >   Reverse: [OK, passed 100 tests]
+--   >   Foo: [OK]
+--   >   Bar: [OK]
 --   > 
 --   >          Properties  Test Cases   Total       
 --   >  Passed  1           2            3          
@@ -65,36 +59,52 @@ import Test.Framework.Providers.HUnit
 --   
 defaultMainGenerator :: ExpQ
 defaultMainGenerator = 
-  [| defaultMain [ testGroup $(locationModule) $ $(propListGenerator) ++ (mapTestCases $(functionExtractor "^case") ) ] |]
+  [| defaultMain [ testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) ] |]
 
--- | Generate the usual code and extract the usual functions needed for a testGroup in HUnit.
+-- | Generate the usual code and extract the usual functions needed for a testGroup in HUnit/Quickcheck/Quickcheck2.
+--   All functions beginning with case_ or prop_ will be extracted.
 --  
 --   > -- file SomeModule.hs
 --   > fooTestGroup = $(testGroupGenerator)
 --   > main = defaultMain [fooTestGroup]
---   > case1 = do 1 @=? 1
---   > case2 = do 2 @=? 2
---   > prop1 xs = reverse (reverse xs) == xs
+--   > case_1 = do 1 @=? 1
+--   > case_2 = do 2 @=? 2
+--   > prop_p xs = reverse (reverse xs) == xs
 --   >  where types = xs :: [Int]
 --   
 --   is the same as
 --
 --   > -- file SoomeModule.hs
---   > fooTestGroup = testGroup "SomeModule" [testProperty "prop1" prop1, testCase "case1" case1, testCase "case2" case2]
+--   > fooTestGroup = testGroup "SomeModule" [testProperty "p" prop_1, testCase "1" case_1, testCase "2" case_2]
 --   > main = defaultMain [fooTestGroup]
---   > case1 = do 1 @=? 1
---   > case2 = do 2 @=? 2
---   > prop1 xs = reverse (reverse xs) == xs
+--   > case_1 = do 1 @=? 1
+--   > case_2 = do 2 @=? 2
+--   > prop_1 xs = reverse (reverse xs) == xs
 --   >  where types = xs :: [Int]
 --
 testGroupGenerator :: ExpQ
 testGroupGenerator =
-  [| testGroup $(locationModule) $ $(propListGenerator) ++ (mapTestCases $(functionExtractor "^case") ) |]
+  [| testGroup $(locationModule) $ $(propListGenerator) ++ $(caseListGenerator) |]
+
+listGenerator :: String -> String -> ExpQ
+listGenerator beginning funcName =
+  functionExtractorMap beginning (applyNameFix funcName)
 
 propListGenerator :: ExpQ
-propListGenerator =
-  functionExtractorMap "^prop" [|testProperty|]
+propListGenerator = listGenerator "^prop_" "testProperty"
+
+caseListGenerator :: ExpQ
+caseListGenerator = listGenerator "^case_" "testCase"
+
+-- | The same as
+--   e.g. \n f -> testProperty (fixName n) f
+applyNameFix :: String -> ExpQ
+applyNameFix n =
+  do fn <- [|fixName|]
+     return $ LamE [VarP (mkName "n")] (AppE (VarE (mkName n)) (AppE (fn) (VarE (mkName "n"))))
+
+fixName :: String -> String
+fixName name = replace '_' ' ' $ drop 5 name
 
-mapTestCases :: [(String, Assertion)] -> [Test.Framework.Test]
-mapTestCases list =
-  map (uncurry testCase) list
+replace :: Eq a => a -> a -> [a] -> [a]
+replace b v = map (\i -> if b == i then v else i)
diff --git a/src/Test/Framework/TestTH.hs b/src/Test/Framework/TestTH.hs
@@ -0,0 +1,24 @@
+{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}
+module Test.Framework.TestTH where 
+import Test.Framework.TH 
+
+import Test.HUnit
+import Test.Framework.Providers.QuickCheck2
+import Test.Framework.Providers.HUnit
+import TemplateHelper
+
+main = $(defaultMainGenerator)
+
+case_Foo =
+   4 @=? 4
+
+case_Bar =
+   "hej" @=? "hej"
+
+prop_Reverse xs = reverse (reverse xs) == xs
+  where types = xs ::[Int]
+
+case_num_Prop =
+  do let expected = 1
+         actual = length $ $(functionExtractor "^prop")
+     expected @=? actual
diff --git a/src/TestGeneratorTest.hs b/src/TestGeneratorTest.hs
diff --git a/test-generator.cabal b/test-generator.cabal
@@ -1,38 +1,38 @@
-name: test-generator
-version: 0.1.1
+name: test-framework-th
+version: 0.1.2
 cabal-version: -any
 build-type: Simple
 license: BSD4
 license-file: ""
 copyright:
 maintainer: Oscar Finnsson
-build-depends: base >= 4, test-framework-hunit >= 0.2.4, test-framework-quickcheck2 >= 0.2.4, test-framework, HUnit, template-helper, haskell-src-exts, haskell98, regex-posix, template-haskell
+build-depends: base >= 4, test-framework, template-helper, haskell-src-exts, haskell98, regex-posix, template-haskell
 stability:
 homepage: http://github.com/finnsson/test-generator
 package-url:
 bug-reports:
 synopsis: Automagically generate the HUnit- and Quickcheck-bulk-code using Template Haskell.
 description:
-   @test-generator@ contains two interesting functions: @defaultMainGenerator@ and @testGroupGenerator@.
+   @test-framework-th@ contains two interesting functions: @defaultMainGenerator@ and @testGroupGenerator@.
    .
-   @defaultMainGenerator@ will extract all functions beginning with case or prop in the module and put them in a testGroup.
+   @defaultMainGenerator@ will extract all functions beginning with case_ or prop_ in the module and put them in a testGroup.
    .
    > module Foo where
    > main = $(defaultMainGenerator)
    >
-   > caseTwo = 2 @=? 2
-   > caseHi = "hi" @=? "hi"
-   > propReverse xs = reverse (reverse xs) == xs
+   > case_Two = 2 @=? 2
+   > case_Hi = "hi" @=? "hi"
+   > prop_Reverse xs = reverse (reverse xs) == xs
    >  where types = xs :: [Int]
   .
   is the same as
   .
   > module Foo where
-  > main = defaultMain [testGroup "Foo" [testProperty "propReverse" propReverse, testCase "testTwo" testTwo, testCase "testHi" testHi]
+  > main = defaultMain [testGroup "Foo" [testProperty "Reverse" prop_Reverse, testCase "Two" case_Two, testCase "Hi" case_Hi]
   >
-  > testTwo = 2 @=? 2
-  > testHi = "hi" @=? "hi"
-  > propReverse xs = reverse (reverse xs) == xs
+  > case_Two = 2 @=? 2
+  > case_Hi = "hi" @=? "hi"
+  > prop_Reverse xs = reverse (reverse xs) == xs
   >  where types = xs :: [Int]
   .
   @testGroupGenerator@ is like @defaultMainGenerator@ but without @defaultMain@. It is useful if you need a function for the testgroup
@@ -44,7 +44,7 @@ data-files:
 data-dir: ""
 extra-source-files:
 extra-tmp-files:
-exposed-modules: TestGenerator
+exposed-modules: Test.Framework.TH 
 exposed: True
 buildable: True
 build-tools: