Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Fixed late binding and function-names.

  • Loading branch information...
commit 94fbb02c73666293d22afbd0c31e7c6ef34f3325 1 parent 83e5e7a
Finnsson authored
46 README.markdown
View
@@ -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
+
72 src/TestGenerator.hs → src/Test/Framework/TH.hs
View
@@ -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)
24 src/Test/Framework/TestTH.hs
View
@@ -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
35 src/TestGeneratorTest.hs
View
@@ -1,35 +0,0 @@
------------------------------------------------------------------------------
---
--- Module : TestGenerator
--- Copyright :
--- License : BSD4
---
--- Maintainer : Oscar Finnsson
--- Stability :
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-{-# OPTIONS_GHC -fglasgow-exts -XTemplateHaskell #-}
-module TestGeneratorTest where
-import TestGenerator
-
-import Test.HUnit
-import TemplateHelper
-
-main = $(defaultMainGenerator)
-
-case_Foo =
- do 4 @=? 4
-
-case_Bar =
- do "hej" @=? "hej"
-
-prop_Reverse xs = reverse (reverse xs) == xs
- where types = xs ::[Int]
-
-case_numProp =
- do let expected = 1
- actual = length $ $(functionExtractor "^prop")
- expected @=? actual
26 test-generator.cabal
View
@@ -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:
Please sign in to comment.
Something went wrong with that request. Please try again.