Commit 57ecf3a3 authored by ijones's avatar ijones
Browse files

added HUnit test/example

** added some parsing of build-dep, so we could get some kind of dependency to the package stuff.  see TODO item
** assertCmd to simplify testing
** added test case basically like this:
make semiclean
./setup configure --prefix=",tmp"
./setup build
./setup install --user
ghc -package-conf $HOME/.ghc-packages  -package HUnit-1.0 HUnitTester.hs -o ./hunitTest
./hunitTest 
ghc-pkg --config-file=$HOME/.ghc-packages -r HUnit-1.0
make clean
parent 02dcebe6
......@@ -64,11 +64,11 @@ import qualified Distribution.Simple.Register as D.S.R (hunitTests)
-- base
import Control.Monad(when)
import Directory(setCurrentDirectory, doesFileExist,
doesDirectoryExist)
doesDirectoryExist, getCurrentDirectory)
import System.Cmd(system)
import System.Exit(ExitCode(..))
import HUnit(runTestTT, Test(..), Counts, assertBool, assertEqual)
import HUnit(runTestTT, Test(..), Counts, assertBool, assertEqual, Assertion)
label :: String -> String
label t = "-= " ++ t ++ " =-"
......@@ -96,8 +96,28 @@ checkTargetDir targetDir suffixes
| (e, f) <- zip allFilesE files]
return ()
-- |Run this command, and assert it returns a successful error code.
assertCmd :: String -- ^Command
-> String -- ^Comment
-> Assertion
assertCmd command comment
= system command >>= assertEqual (command ++ ":" ++ comment) ExitSuccess
tests :: [Test]
tests = [TestLabel "configure GHC, sdist" $ TestCase $
tests = [TestLabel "testing the HUnit package" $ TestCase $
do oldDir <- getCurrentDirectory
setCurrentDirectory "test/HUnit-1.0"
-- assertCmd "make semiclean" "make semiclean"
system "ghc-pkg --config-file=$HOME/.ghc-packages -r HUnit-1.0"
assertCmd "./setup configure --prefix=\",tmp\"" "hunit configure"
assertCmd "./setup build" "hunit build"
assertCmd "./setup install --user" "hunit install"
assertCmd "ghc -package-conf $HOME/.ghc-packages -package HUnit-1.0 HUnitTester.hs -o ./hunitTest" "compile w/ hunit"
assertCmd "./hunitTest" "hunit test"
assertCmd "ghc-pkg --config-file=$HOME/.ghc-packages -r HUnit-1.0" "package remove"
setCurrentDirectory oldDir,
TestLabel "configure GHC, sdist" $ TestCase $
do system "ghc-pkg -r test-1.0 --config-file=$HOME/.ghc-packages"
setCurrentDirectory "test/A"
dirE1 <- doesDirectoryExist ",tmp"
......
......@@ -52,7 +52,7 @@ module Distribution.Package (
#endif
) where
import Distribution.Version(Version, showVersion)
import Distribution.Version(Version(..), showVersion)
import Distribution.Misc(License(..), Dependency, Extension)
import Distribution.Setup(CompilerFlavor)
......@@ -65,6 +65,7 @@ data PackageIdentifier
deriving (Read, Show, Eq)
showPackageId :: PackageIdentifier -> String
showPackageId (PackageIdentifier n (Version [] _)) = n -- if no version, don't show version.
showPackageId pkgid =
pkgName pkgid ++ '-': showVersion (pkgVersion pkgid)
......
......@@ -50,6 +50,7 @@ module Distribution.Simple.Configure (writePersistBuildConfig,
)
where
import Distribution.Misc(Dependency(..))
import Distribution.Setup(ConfigFlags,CompilerFlavor(..), Compiler(..))
import Distribution.Package(PackageDescription(..), emptyPackageDescription,
PackageIdentifier(..)
......@@ -121,7 +122,13 @@ configure pkg_descr (maybe_hc_flavor, maybe_hc_path, maybe_prefix)
message $ "Using compiler flavor: " ++ (show f')
message $ "Using compiler: " ++ p'
message $ "Using package tool: " ++ pkg
return LocalBuildInfo{prefix=prefix, compiler=compiler, packageDeps=[]}
return LocalBuildInfo{prefix=prefix, compiler=compiler,
packageDeps=map buildDepToDep (buildDepends pkg_descr)}
-- |Converts build dependencies to real dependencies. FIX: doesn't
-- set any version information.
buildDepToDep :: Dependency -> PackageIdentifier
buildDepToDep (Dependency s _) = PackageIdentifier s (Version [] [])
system_default_prefix :: PackageDescription -> String
system_default_prefix PackageDescription{package=package} =
......
......@@ -19,6 +19,9 @@
** test / port code for Hugs and nhc
* Code
** buildDepToDep in Configure doesn't set version dependency.
** Extensions -> flags interface (Misc.hs)
** Change mainModules to [(String, String)] for (Module, executable name)
......
......@@ -4,11 +4,13 @@ main:
ghc -Wall --make -i../:/usr/local/src/HUnit-1.0 Distribution/ModuleTest -o moduleTest
tests:
cd test/A && make
cd test/HUnit-1.0 && make
clean:
-rm -f Distribution/*.{o,hi} Distribution/Simple/*.{o,hi}
rm -f library-infrastructure--darcs.tar.gz
check: tests
check: tests main
./moduleTest
pushall:
......@@ -18,3 +20,4 @@ pushall:
dist: pushall
darcs dist
scp library-infrastructure--darcs.tar.gz ijones@www.haskell.org:~/libraryInfrastructure/libraryInfrastructure-code.tgz
rm -f library-infrastructure--darcs.tar.gz
This diff is collapsed.
module Main where
import HUnit
main :: IO ()
main = do runTestTT $ TestCase $ assertBool "foo!" True
putStrLn "Works :)"
HUnit is Copyright (c) Dean Herington, 2002, all rights reserved,
and is distributed as free software under the following license.
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.
- The names of the copyright holders may not be used to endorse or
promote products derived from this software without specific prior
written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.
all:
ghc -Wall --make -i../../:/usr/local/src/HUnit-1.0 Setup.lhs -o setup
semiclean:
rm -rf ,tmp dist
find . -name "*.o" |xargs rm -f
find . -name "*.hi" |xargs rm -f
clean: semiclean
rm -f setup a.out hunitTest
rm -f installed-pkg-config
check: all
./setup configure --user --prefix=/tmp/foo
./setup install --install-prefix=/tmp/bar
ls /tmp/bar*
# install w/ register!
./setup install
# ls /tmp/foo*
./setup sdist
ls dist
HUnit is a unit testing framework for Haskell, inspired by the JUnit
tool for Java. HUnit is free software; see its "License" file for
details. HUnit is available at <http://hunit.sourceforge.net>.
HUnit 1.0 consists of a number of files. Besides Haskell source files
(whose names end in ".hs" or ".lhs"), these files include:
* README -- this file
* Guide.html -- user's guide, in HTML format
* License -- license for use of HUnit
See the user's guide for more information.
#!/usr/bin/runhugs
> module Main where
> import Distribution.Simple
> pkg_descr = emptyPackageDescription {
> package = PackageIdentifier "HUnit" (Version [1,0] []),
> allModules = ["HUnitText", "HUnit", "HUnitLang",
> "HUnitTestBase", "Terminal", "HUnitBase"],
> exposedModules = ["HUnit"],
> buildDepends = [Dependency "haskell-src" AnyVersion],
> hsSourceDir = "src"
> }
> main :: IO ()
> main = do defaultMain pkg_descr
-- Example.hs -- Examples from HUnit user's guide
-- $Id: Example.hs,v 1.2 2002/02/19 17:05:21 heringto Exp $
module Main where
import HUnit
foo :: Int -> (Int, Int)
foo x = (1, x)
partA :: Int -> IO (Int, Int)
partA v = return (v+2, v+3)
partB :: Int -> IO Bool
partB v = return (v > 5)
test1 = TestCase (assertEqual "for (foo 3)," (1,2) (foo 3))
test2 = TestCase (do (x,y) <- partA 3
assertEqual "for the first result of partA," 5 x
b <- partB y
assertBool ("(partB " ++ show y ++ ") failed") b)
tests = TestList [TestLabel "test1" test1, TestLabel "test2" test2]
tests' = test [ "test1" ~: "(foo 3)" ~: (1,2) ~=? (foo 3),
"test2" ~: do (x, y) <- partA 3
assertEqual "for the first result of partA," 5 x
partB y @? "(partB " ++ show y ++ ") failed" ]
main = do runTestTT tests
runTestTT tests'
HUnit.lhs -- interface module for HUnit
$Id: HUnit.lhs,v 1.3 2002/02/09 04:25:12 heringto Exp $
> module HUnit
> (
> module HUnitBase,
> module HUnitText
> )
> where
> import HUnitBase
> import HUnitText
HUnitBase.lhs -- basic definitions
$Id: HUnitBase.lhs,v 1.12 2002/02/14 19:31:57 heringto Exp $
> module HUnitBase
> (
> {- from HUnitLang: -} Assertion, assertFailure,
> assertString, assertBool, assertEqual,
> Assertable(..), ListAssertable(..),
> AssertionPredicate, AssertionPredicable(..),
> (@?), (@=?), (@?=),
> Test(..), Node(..), Path,
> testCaseCount,
> Testable(..),
> (~?), (~=?), (~?=), (~:),
> Counts(..), State(..),
> ReportStart, ReportProblem,
> testCasePaths,
> performTest
> )
> where
> import Monad (unless, foldM)
Assertion Definition
====================
> import HUnitLang
Conditional Assertion Functions
-------------------------------
> assertBool :: String -> Bool -> Assertion
> assertBool msg b = unless b (assertFailure msg)
> assertString :: String -> Assertion
> assertString s = unless (null s) (assertFailure s)
> assertEqual :: (Eq a, Show a) => String -> a -> a -> Assertion
> assertEqual preface expected actual =
> unless (actual == expected) (assertFailure msg)
> where msg = (if null preface then "" else preface ++ "\n") ++
> "expected: " ++ show expected ++ "\n but got: " ++ show actual
Overloaded `assert` Function
----------------------------
> class Assertable t
> where assert :: t -> Assertion
> instance Assertable ()
> where assert = return
> instance Assertable Bool
> where assert = assertBool ""
> instance (ListAssertable t) => Assertable [t]
> where assert = listAssert
> instance (Assertable t) => Assertable (IO t)
> where assert = (>>= assert)
We define the assertability of `[Char]` (that is, `String`) and leave
other types of list to possible user extension.
> class ListAssertable t
> where listAssert :: [t] -> Assertion
> instance ListAssertable Char
> where listAssert = assertString
Overloaded `assertionPredicate` Function
----------------------------------------
> type AssertionPredicate = IO Bool
> class AssertionPredicable t
> where assertionPredicate :: t -> AssertionPredicate
> instance AssertionPredicable Bool
> where assertionPredicate = return
> instance (AssertionPredicable t) => AssertionPredicable (IO t)
> where assertionPredicate = (>>= assertionPredicate)
Assertion Construction Operators
--------------------------------
> infix 1 @?, @=?, @?=
> (@?) :: (AssertionPredicable t) => t -> String -> Assertion
> pred @? msg = assertionPredicate pred >>= assertBool msg
> (@=?) :: (Eq a, Show a) => a -> a -> Assertion
> expected @=? actual = assertEqual "" expected actual
> (@?=) :: (Eq a, Show a) => a -> a -> Assertion
> actual @?= expected = assertEqual "" expected actual
Test Definition
===============
> data Test = TestCase Assertion
> | TestList [Test]
> | TestLabel String Test
> instance Show Test where
> showsPrec p (TestCase _) = showString "TestCase _"
> showsPrec p (TestList ts) = showString "TestList " . showList ts
> showsPrec p (TestLabel l t) = showString "TestLabel " . showString l
> . showChar ' ' . showsPrec p t
> testCaseCount :: Test -> Int
> testCaseCount (TestCase _) = 1
> testCaseCount (TestList ts) = sum (map testCaseCount ts)
> testCaseCount (TestLabel _ t) = testCaseCount t
> data Node = ListItem Int | Label String
> deriving (Eq, Show, Read)
> type Path = [Node] -- Node order is from test case to root.
> testCasePaths :: Test -> [Path]
> testCasePaths t = tcp t []
> where tcp (TestCase _) p = [p]
> tcp (TestList ts) p =
> concat [ tcp t (ListItem n : p) | (t,n) <- zip ts [0..] ]
> tcp (TestLabel l t) p = tcp t (Label l : p)
Overloaded `test` Function
--------------------------
> class Testable t
> where test :: t -> Test
> instance Testable Test
> where test = id
> instance (Assertable t) => Testable (IO t)
> where test = TestCase . assert
> instance (Testable t) => Testable [t]
> where test = TestList . map test
Test Construction Operators
---------------------------
> infix 1 ~?, ~=?, ~?=
> infixr 0 ~:
> (~?) :: (AssertionPredicable t) => t -> String -> Test
> pred ~? msg = TestCase (pred @? msg)
> (~=?) :: (Eq a, Show a) => a -> a -> Test
> expected ~=? actual = TestCase (expected @=? actual)
> (~?=) :: (Eq a, Show a) => a -> a -> Test
> actual ~?= expected = TestCase (actual @?= expected)
> (~:) :: (Testable t) => String -> t -> Test
> label ~: t = TestLabel label (test t)
Test Execution
==============
> data Counts = Counts { cases, tried, errors, failures :: Int }
> deriving (Eq, Show, Read)
> data State = State { path :: Path, counts :: Counts }
> deriving (Eq, Show, Read)
> type ReportStart us = State -> us -> IO us
> type ReportProblem us = String -> State -> us -> IO us
Note that the counts in a start report do not include the test case
being started, whereas the counts in a problem report do include the
test case just finished. The principle is that the counts are sampled
only between test case executions. As a result, the number of test
case successes always equals the difference of test cases tried and
the sum of test case errors and failures.
> performTest :: ReportStart us -> ReportProblem us -> ReportProblem us
> -> us -> Test -> IO (Counts, us)
> performTest reportStart reportError reportFailure us t = do
> (ss', us') <- pt initState us t
> unless (null (path ss')) $ error "performTest: Final path is nonnull"
> return (counts ss', us')
> where
> initState = State{ path = [], counts = initCounts }
> initCounts = Counts{ cases = testCaseCount t, tried = 0,
> errors = 0, failures = 0}
> pt ss us (TestCase a) = do
> us' <- reportStart ss us
> r <- performTestCase a
> case r of Nothing -> do return (ss', us')
> Just (True, m) -> do usF <- reportFailure m ssF us'
> return (ssF, usF)
> Just (False, m) -> do usE <- reportError m ssE us'
> return (ssE, usE)
> where c@Counts{ tried = t } = counts ss
> ss' = ss{ counts = c{ tried = t + 1 } }
> ssF = ss{ counts = c{ tried = t + 1, failures = failures c + 1 } }
> ssE = ss{ counts = c{ tried = t + 1, errors = errors c + 1 } }
> pt ss us (TestList ts) = foldM f (ss, us) (zip ts [0..])
> where f (ss, us) (t, n) = withNode (ListItem n) ss us t
> pt ss us (TestLabel label t) = withNode (Label label) ss us t
> withNode node ss0 us0 t = do (ss2, us1) <- pt ss1 us0 t
> return (ss2{ path = path0 }, us1)
> where path0 = path ss0
> ss1 = ss0{ path = node : path0 }
HUnitLang98.lhs -- HUnit language support, generic Haskell 98 variant
Note: The Haskell system you use needs to find this file when looking
for module `HUnitLang`.
$Id: HUnitLang98.lhs,v 1.2 2002/02/14 19:27:56 heringto Exp $
> module HUnitLang
> (
> Assertion,
> assertFailure,
> performTestCase
> )
> where
When adapting this module for other Haskell language systems, change
the imports and the implementations but not the interfaces.
Imports
-------
> import List (isPrefixOf)
> import IO (ioeGetErrorString, try)
Interfaces
----------
An assertion is an `IO` computation with trivial result.
> type Assertion = IO ()
`assertFailure` signals an assertion failure with a given message.
> assertFailure :: String -> Assertion
`performTestCase` performs a single test case. The meaning of the
result is as follows:
Nothing test case success
Just (True, msg) test case failure with the given message
Just (False, msg) test case error with the given message
> performTestCase :: Assertion -> IO (Maybe (Bool, String))
Implementations
---------------
> hunitPrefix = "HUnit:"
> hugsPrefix = "IO Error: User error\nReason: "
> nhc98Prefix = "I/O error (user-defined), call to function `userError':\n "
> -- GHC prepends no prefix to the user-supplied string.
> assertFailure msg = ioError (userError (hunitPrefix ++ msg))
> performTestCase action = do r <- try action
> case r of Right () -> return Nothing
> Left e -> return (Just (decode e))
> where
> decode e = let s0 = ioeGetErrorString e
> (_, s1) = dropPrefix hugsPrefix s0
> (_, s2) = dropPrefix nhc98Prefix s1
> in dropPrefix hunitPrefix s2
> dropPrefix pref str = if pref `isPrefixOf` str
> then (True, drop (length pref) str)
> else (False, str)
HUnitLang98.lhs -- HUnit language support, generic Haskell 98 variant
Note: The Haskell system you use needs to find this file when looking
for module `HUnitLang`.
$Id: HUnitLang98.lhs,v 1.2 2002/02/14 19:27:56 heringto Exp $
> module HUnitLang
> (
> Assertion,
> assertFailure,
> performTestCase
> )
> where
When adapting this module for other Haskell language systems, change
the imports and the implementations but not the interfaces.
Imports
-------
> import List (isPrefixOf)
> import IO (ioeGetErrorString, try)
Interfaces
----------
An assertion is an `IO` computation with trivial result.
> type Assertion = IO ()
`assertFailure` signals an assertion failure with a given message.
> assertFailure :: String -> Assertion
`performTestCase` performs a single test case. The meaning of the
result is as follows:
Nothing test case success
Just (True, msg) test case failure with the given message
Just (False, msg) test case error with the given message