diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -12,7 +12,7 @@ *.hi *.dyn_hi *.dyn_o -tests/test +tests/test-main tests/test-derive tests/test-error tests/test-fun diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -45,6 +45,9 @@ - ghc: 'head' env: GHCVER=head CABALVER=head addons: {apt: {packages: [ghc-head, cabal-install-head], sources: hvr-ghc}} + - ghc: '8.6' + env: GHCVER=8.6.1 CABALVER=2.4 + addons: {apt: {packages: [ghc-8.6.1, cabal-install-2.4], sources: hvr-ghc}} - ghc: '8.4' env: GHCVER=8.4.2 CABALVER=2.2 addons: {apt: {packages: [ghc-8.4.2, cabal-install-2.2], sources: hvr-ghc}} diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -3,7 +3,7 @@ # Copyright: (c) 2015-2018 Rudy Matela # License: 3-Clause BSD (see the file LICENSE) # Maintainer: Rudy Matela -TESTS = tests/test \ +TESTS = tests/test-main \ tests/test-derive \ tests/test-error \ tests/test-fun \ @@ -51,6 +51,14 @@ eg/%.update-diff-test: eg/% ./$< > tests/diff/$<.out +# Evaluation order changed from GHC 8.4 to GHC 8.6, so we need to skip the +# contents of the exception for test-list.diff-test. +eg/test-list.diff-test: eg/test-list + ./$< | sed -e "s/Exception '[^']*'/Exception '...'/" | diff -rud tests/diff/$<.out - + +eg/test-list.update-diff-test: eg/test-list + ./$< | sed -e "s/Exception '[^']*'/Exception '...'/" > tests/diff/$<.out + clean: clean-hi-o clean-haddock rm -f bench/tiers-colistable.hs rm -f bench/tiers-listsofpairs.hs @@ -68,7 +76,7 @@ tests/test-operators.runhugs \ tests/test-stats.runhugs \ tests/test-tiers.runhugs \ - tests/test.runhugs + tests/test-main.runhugs # tests/test-error.runhugs # TODO: make this pass # tests/test-funshow.runhugs # TODO: make this pass # tests/test-types.runhugs # TODO: make this pass @@ -79,6 +87,9 @@ test-sdist: ./tests/test-sdist +test-via-cabal: + cabal test + test-via-stack: stack test @@ -222,6 +233,9 @@ bench/tiers-colistable.hs \ bench/tiers-funlistable.hs \ bench/tiers-mixed.hs + +prepare-depend-and-depend: prepare-depend + make depend TLF = "import\ Test.LeanCheck.Function" diff --git a/leancheck.cabal b/leancheck.cabal --- a/leancheck.cabal +++ b/leancheck.cabal @@ -11,7 +11,7 @@ -- this cabal file too complicated. -- Rudy name: leancheck -version: 0.7.4 +version: 0.7.5 synopsis: Enumerative property-based testing description: LeanCheck is a simple enumerative property-based testing library. @@ -70,7 +70,7 @@ source-repository this type: git location: https://github.com/rudymatela/leancheck - tag: v0.7.4 + tag: v0.7.5 library exposed-modules: Test.LeanCheck @@ -101,9 +101,9 @@ build-depends: base >= 4 && < 5, template-haskell default-language: Haskell2010 -test-suite test +test-suite main type: exitcode-stdio-1.0 - main-is: test.hs + main-is: test-main.hs other-modules: Test hs-source-dirs: tests build-depends: base >= 4 && < 5, leancheck diff --git a/mk/depend.mk b/mk/depend.mk --- a/mk/depend.mk +++ b/mk/depend.mk @@ -503,9 +503,9 @@ tests/Test.hs \ tests/test-io.hs \ mk/toplibs -tests/test-operators.o: \ +tests/test-main.o: \ tests/Test.hs \ - tests/test-operators.hs \ + tests/test-main.hs \ src/Test/LeanCheck/Utils/Types.hs \ src/Test/LeanCheck/Utils/TypeBinding.hs \ src/Test/LeanCheck/Utils.hs \ @@ -517,28 +517,32 @@ src/Test/LeanCheck/Derive.hs \ src/Test/LeanCheck/Core.hs \ src/Test/LeanCheck/Basic.hs -tests/test-operators: \ +tests/test-main: \ tests/Test.hs \ - tests/test-operators.hs \ + tests/test-main.hs \ mk/toplibs -tests/Test.o: \ +tests/test-operators.o: \ tests/Test.hs \ + tests/test-operators.hs \ src/Test/LeanCheck/Utils/Types.hs \ + src/Test/LeanCheck/Utils/TypeBinding.hs \ + src/Test/LeanCheck/Utils.hs \ + src/Test/LeanCheck/Utils/Operators.hs \ src/Test/LeanCheck/Tiers.hs \ + src/Test/LeanCheck/Stats.hs \ src/Test/LeanCheck.hs \ src/Test/LeanCheck/IO.hs \ src/Test/LeanCheck/Derive.hs \ src/Test/LeanCheck/Core.hs \ src/Test/LeanCheck/Basic.hs -tests/test.o: \ +tests/test-operators: \ tests/Test.hs \ - tests/test.hs \ + tests/test-operators.hs \ + mk/toplibs +tests/Test.o: \ + tests/Test.hs \ src/Test/LeanCheck/Utils/Types.hs \ - src/Test/LeanCheck/Utils/TypeBinding.hs \ - src/Test/LeanCheck/Utils.hs \ - src/Test/LeanCheck/Utils/Operators.hs \ src/Test/LeanCheck/Tiers.hs \ - src/Test/LeanCheck/Stats.hs \ src/Test/LeanCheck.hs \ src/Test/LeanCheck/IO.hs \ src/Test/LeanCheck/Derive.hs \ @@ -558,10 +562,6 @@ tests/test-stats: \ tests/test-stats.hs \ tests/Test.hs \ - mk/toplibs -tests/test: \ - tests/Test.hs \ - tests/test.hs \ mk/toplibs tests/test-tiers.o: \ tests/test-tiers.hs \ diff --git a/tests/diff/eg/test-list.out b/tests/diff/eg/test-list.out --- a/tests/diff/eg/test-list.out +++ b/tests/diff/eg/test-list.out @@ -2,5 +2,5 @@ [] [0,0] *** Failed! Falsifiable (after 1 tests): [] -*** Failed! Exception 'Prelude.head: empty list' (after 1 tests): +*** Failed! Exception '...' (after 1 tests): [] diff --git a/tests/test-main.hs b/tests/test-main.hs new file mode 100644 --- /dev/null +++ b/tests/test-main.hs @@ -0,0 +1,101 @@ +-- Copyright (c) 2015-2018 Rudy Matela. +-- Distributed under the 3-Clause BSD licence (see the file LICENSE). +import Test + +import System.Exit (exitFailure) +import Data.List (elemIndices) + +import Test.LeanCheck +import Test.LeanCheck.Utils + +import Data.Ratio +import Data.Word (Word) + +main :: IO () +main = + case elemIndices False tests of + [] -> putStrLn "Tests passed!" + is -> do putStrLn ("Failed tests:" ++ show is) + exitFailure + +tests :: [Bool] +tests = + [ True + + -- interleave + , [1,2,3] +| [0,0,0] == [1,0,2,0,3,0] + , take 3 ([1,2] +| (0:undefined)) == [1,0,2] + , [0,2..] +| [1,3..] =| 100 |= [0,1..] + + -- etc + , tNatPairOrd 100 + , tNatTripleOrd 200 + , tNatQuadrupleOrd 300 + , tNatQuintupleOrd 400 + , tNatListOrd 500 + , tListsOfNatOrd 500 + , listsOf (tiers::[[Nat]]) =| 10 |= tiers + + -- tests! + , counterExample 10 (\x y -> x + y /= (x::Int)) == Just ["0", "0"] + , counterExample 10 (\x y -> x + y == (x::Int)) == Just ["0", "1"] + , counterExample 10 (maybe True (==(0::Int))) == Just ["(Just 1)"] + , holds 100 (\x -> x == (x::Int)) + + -- For when NaN is in the enumeration (by default, it is not): + --, fails 100 (\x -> x == (x::Float)) -- NaN != NaN :-) + --, counterExample 100 (\x -> x == (x::Float)) == Just ["NaN"] + , counterExample 10 (\x y -> x + y == (x::Float)) == Just ["0.0","1.0"] + , counterExample 10 (\x y -> x + y == (x::Double)) == Just ["0.0","1.0"] + , holds 50 (\x -> x + 1 /= (x::Int)) + , counterExample 50 (\x -> x + 1 /= (x::Float)) == Just ["Infinity"] + || counterExample 50 (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs 2006-09? + , counterExample 50 (\x -> x + 1 /= (x::Double)) == Just ["Infinity"] + || counterExample 50 (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs 2006-09? + , allUnique (take 100 list :: [Float]) + , allUnique (take 500 list :: [Double]) + + , allUnique (take 500 list :: [Rational]) + , allUnique (take 100 list :: [Ratio Nat]) + , orderedOn (\r -> numerator r + denominator r) (take 500 (list :: [Ratio Nat])) + , orderedOn (\r -> abs (numerator r) + abs(denominator r)) (take 500 (list :: [Rational])) + + , list == [LT, EQ, GT] + , orderedOn length (take 500 (list :: [[Ordering]])) + , orderedOn length (take 500 (list :: [[Bool]])) + + , strictlyOrderedOn (\xs -> (sum $ map (+1) xs, xs)) (take 500 (list :: [[Word]])) + + , tPairEqParams 100 + , tTripleEqParams 100 + + , tProductsIsFilterByLength (tiers :: [[ Nat ]]) 10 `all` [1..10] + , tProductsIsFilterByLength (tiers :: [[ Bool ]]) 6 `all` [1..10] + , tProductsIsFilterByLength (tiers :: [[ [Nat] ]]) 6 `all` [1..10] + + , holds 100 $ (\/) ==== zipWith' (++) [] [] -:> [[uint2]] + , holds 100 $ (\/) ==== zipWith' (++) [] [] -:> [[bool]] + , holds 100 $ (\\//) ==== zipWith' (+|) [] [] -:> [[uint2]] + , holds 100 $ (\\//) ==== zipWith' (+|) [] [] -:> [[bool]] + ] + +allUnique :: Ord a => [a] -> Bool +allUnique [] = True +allUnique (x:xs) = x `notElem` xs + && allUnique (filter (< x) xs) + && allUnique (filter (> x) xs) + + +-- | 'zipwith\'' works similarly to 'zipWith', but takes neutral elements to +-- operate when one of the lists is exhausted, so, you don't loose elements. +-- +-- > zipWith' f z e [x,y] [a,b,c,d] == [f x a, f y b, f z c, f z d] +-- +-- > zipWith' f z e [x,y,z] [a] == [f x a, f y e, f z e] +-- +-- > zipWith' (+) 0 0 [1,2,3] [1,2,3,4,5,6] == [2,4,6,4,5,6] +zipWith' :: (a->b->c) -> a -> b -> [a] -> [b] -> [c] +zipWith' _ _ _ [] [] = [] +zipWith' f _ zy xs [] = map (`f` zy) xs +zipWith' f zx _ [] ys = map (f zx) ys +zipWith' f zx zy (x:xs) (y:ys) = f x y : zipWith' f zx zy xs ys diff --git a/tests/test-sdist b/tests/test-sdist --- a/tests/test-sdist +++ b/tests/test-sdist @@ -4,12 +4,17 @@ # # Copyright (c) 2015-2018 Rudy Matela. # Distributed under the 3-Clause BSD licence. +export LC_ALL=C # consistent sort pkgver=` cat *.cabal | grep "^version:" | sed -e "s/version: *//"` pkgname=`cat *.cabal | grep "^name:" | sed -e "s/name: *//"` pkg=$pkgname-$pkgver set -x cabal sdist && cd dist && +tar -tf $pkg.tar.gz | sort --ignore-case > ls-cabal-i && +tar -tf $pkg.tar.gz | sort --ignore-case --unique > ls-cabal-iu && +diff -rud ls-cabal-i ls-cabal-iu && +rm -f ls-cabal ls-cabal-ignore-case && if [ -d ../.git ] then # on git repo, test if files are the same diff --git a/tests/test.hs b/tests/test.hs deleted file mode 100644 --- a/tests/test.hs +++ /dev/null @@ -1,101 +0,0 @@ --- Copyright (c) 2015-2018 Rudy Matela. --- Distributed under the 3-Clause BSD licence (see the file LICENSE). -import Test - -import System.Exit (exitFailure) -import Data.List (elemIndices) - -import Test.LeanCheck -import Test.LeanCheck.Utils - -import Data.Ratio -import Data.Word (Word) - -main :: IO () -main = - case elemIndices False tests of - [] -> putStrLn "Tests passed!" - is -> do putStrLn ("Failed tests:" ++ show is) - exitFailure - -tests :: [Bool] -tests = - [ True - - -- interleave - , [1,2,3] +| [0,0,0] == [1,0,2,0,3,0] - , take 3 ([1,2] +| (0:undefined)) == [1,0,2] - , [0,2..] +| [1,3..] =| 100 |= [0,1..] - - -- etc - , tNatPairOrd 100 - , tNatTripleOrd 200 - , tNatQuadrupleOrd 300 - , tNatQuintupleOrd 400 - , tNatListOrd 500 - , tListsOfNatOrd 500 - , listsOf (tiers::[[Nat]]) =| 10 |= tiers - - -- tests! - , counterExample 10 (\x y -> x + y /= (x::Int)) == Just ["0", "0"] - , counterExample 10 (\x y -> x + y == (x::Int)) == Just ["0", "1"] - , counterExample 10 (maybe True (==(0::Int))) == Just ["(Just 1)"] - , holds 100 (\x -> x == (x::Int)) - - -- For when NaN is in the enumeration (by default, it is not): - --, fails 100 (\x -> x == (x::Float)) -- NaN != NaN :-) - --, counterExample 100 (\x -> x == (x::Float)) == Just ["NaN"] - , counterExample 10 (\x y -> x + y == (x::Float)) == Just ["0.0","1.0"] - , counterExample 10 (\x y -> x + y == (x::Double)) == Just ["0.0","1.0"] - , holds 50 (\x -> x + 1 /= (x::Int)) - , counterExample 50 (\x -> x + 1 /= (x::Float)) == Just ["Infinity"] - || counterExample 50 (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs 2006-09? - , counterExample 50 (\x -> x + 1 /= (x::Double)) == Just ["Infinity"] - || counterExample 50 (\x -> x + 1 /= (x::Float)) == Just ["inf"] -- bug on Hugs 2006-09? - , allUnique (take 100 list :: [Float]) - , allUnique (take 500 list :: [Double]) - - , allUnique (take 500 list :: [Rational]) - , allUnique (take 100 list :: [Ratio Nat]) - , orderedOn (\r -> numerator r + denominator r) (take 500 (list :: [Ratio Nat])) - , orderedOn (\r -> abs (numerator r) + abs(denominator r)) (take 500 (list :: [Rational])) - - , list == [LT, EQ, GT] - , orderedOn length (take 500 (list :: [[Ordering]])) - , orderedOn length (take 500 (list :: [[Bool]])) - - , strictlyOrderedOn (\xs -> (sum $ map (+1) xs, xs)) (take 500 (list :: [[Word]])) - - , tPairEqParams 100 - , tTripleEqParams 100 - - , tProductsIsFilterByLength (tiers :: [[ Nat ]]) 10 `all` [1..10] - , tProductsIsFilterByLength (tiers :: [[ Bool ]]) 6 `all` [1..10] - , tProductsIsFilterByLength (tiers :: [[ [Nat] ]]) 6 `all` [1..10] - - , holds 100 $ (\/) ==== zipWith' (++) [] [] -:> [[uint2]] - , holds 100 $ (\/) ==== zipWith' (++) [] [] -:> [[bool]] - , holds 100 $ (\\//) ==== zipWith' (+|) [] [] -:> [[uint2]] - , holds 100 $ (\\//) ==== zipWith' (+|) [] [] -:> [[bool]] - ] - -allUnique :: Ord a => [a] -> Bool -allUnique [] = True -allUnique (x:xs) = x `notElem` xs - && allUnique (filter (< x) xs) - && allUnique (filter (> x) xs) - - --- | 'zipwith\'' works similarly to 'zipWith', but takes neutral elements to --- operate when one of the lists is exhausted, so, you don't loose elements. --- --- > zipWith' f z e [x,y] [a,b,c,d] == [f x a, f y b, f z c, f z d] --- --- > zipWith' f z e [x,y,z] [a] == [f x a, f y e, f z e] --- --- > zipWith' (+) 0 0 [1,2,3] [1,2,3,4,5,6] == [2,4,6,4,5,6] -zipWith' :: (a->b->c) -> a -> b -> [a] -> [b] -> [c] -zipWith' _ _ _ [] [] = [] -zipWith' f _ zy xs [] = map (`f` zy) xs -zipWith' f zx _ [] ys = map (f zx) ys -zipWith' f zx zy (x:xs) (y:ys) = f x y : zipWith' f zx zy xs ys