fitspec 0.4.7 → 0.4.8
raw patch · 23 files changed
+857/−621 lines, 23 filesdep ~leancheckPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: leancheck
API changes (from Hackage documentation)
- Test.FitSpec.Mutable: instance (GHC.Classes.Eq a, Test.LeanCheck.Core.Listable a) => Test.FitSpec.Mutable.Mutable (GHC.Base.Maybe a)
- Test.FitSpec.ShowMutable: instance (GHC.Classes.Eq a, GHC.Show.Show a) => Test.FitSpec.ShowMutable.ShowMutable (GHC.Base.Maybe a)
+ Test.FitSpec.Mutable: instance (GHC.Classes.Eq a, Test.LeanCheck.Core.Listable a) => Test.FitSpec.Mutable.Mutable (GHC.Maybe.Maybe a)
+ Test.FitSpec.ShowMutable: instance (GHC.Classes.Eq a, GHC.Show.Show a) => Test.FitSpec.ShowMutable.ShowMutable (GHC.Maybe.Maybe a)
- Test.FitSpec.Engine: getResults :: (Mutable a) => a -> (a -> [Property]) -> Int -> Int -> Results a
+ Test.FitSpec.Engine: getResults :: Mutable a => a -> (a -> [Property]) -> Int -> Int -> Results a
- Test.FitSpec.Engine: getResultsExtra :: (Mutable a) => [a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
+ Test.FitSpec.Engine: getResultsExtra :: Mutable a => [a] -> a -> (a -> [Property]) -> Int -> Int -> Results a
- Test.FitSpec.Engine: getResultsExtraTimeout :: (Mutable a) => Int -> [a] -> a -> (a -> [Property]) -> Int -> Int -> IO (Results a)
+ Test.FitSpec.Engine: getResultsExtraTimeout :: Mutable a => Int -> [a] -> a -> (a -> [Property]) -> Int -> Int -> IO (Results a)
Files
- .gitignore +12/−10
- .travis.yml +27/−16
- Makefile +32/−24
- README.md +14/−5
- bench/haskell-src-exts.hs +0/−1
- doc/fitspec.svg +128/−0
- fitspec.cabal +23/−13
- mk/depend.mk +16/−16
- mk/ghcdeps +1/−1
- mk/haddock-i +20/−8
- mk/haskell.mk +29/−5
- mk/install-on +30/−0
- stack.yaml +2/−11
- test/derive.hs +71/−0
- test/mutate.hs +130/−0
- test/sdist +40/−0
- test/showmutable.hs +253/−0
- test/utils.hs +29/−0
- tests/test-derive.hs +0/−71
- tests/test-mutate.hs +0/−130
- tests/test-sdist +0/−28
- tests/test-showmutable.hs +0/−253
- tests/test-utils.hs +0/−29
.gitignore view
@@ -1,8 +1,10 @@ # cabal stuff **/dist+dist-newstyle **/cabal.sandbox.config **/.cabal-sandbox .stack-work+stack.yaml.lock mk/toplibs # vim stuff@@ -40,15 +42,15 @@ eg/alga # test binaries-tests/test-mutate-tests/test-showmutable-tests/test-derive-tests/test-utils+test/mutate+test/showmutable+test/derive+test/utils # Haddock-doc/*.html-doc/*.css-doc/*.js-doc/*.png-doc/*.gif-doc/*.json+doc/**/*.html+doc/**/*.css+doc/**/*.js+doc/**/*.png+doc/**/*.gif+doc/**/*.json
.travis.yml view
@@ -1,6 +1,6 @@ # .travis.yml file for FitSpec #-# Copyright: (c) 2017-2018 Rudy Matela+# Copyright: (c) 2017-2020 Rudy Matela # License: 3-Clause BSD (see the file LICENSE) # Maintainer: Rudy Matela <rudy@matela.com.br> @@ -22,6 +22,9 @@ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - ghc --version - cabal --version+- haddock --version+- du -hd3 ~/.cabal ~/.ghc || true+- du -hd4 ~/.stack || true - rm -f ~/.cabal/config && cabal update # Download and unpack the stack executable # "Once Travis whitelists the stack.dev files," simply include stack in the@@ -31,34 +34,39 @@ - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' - stack config set system-ghc --global true - stack --version-- cabal install leancheck cmdargs+- cabal install leancheck cmdargs || cabal install leancheck cmdargs --lib script:-- make && make test-without-extra-deps+- make && make test - make haddock - make test-sdist-- make test-via-cabal-- stack $STACKR --no-terminal --skip-ghc-check test+- cabal test --ghc-option=-O0+- stack --resolver $STACKVER --no-terminal --skip-ghc-check test --ghc-options=-O0 matrix: allow_failures: - ghc: 'head'- - ghc: '7.10' # Failing due to a bug in cabal? Deactivating for now... include: - ghc: 'head'- env: GHCVER=head CABALVER=head+ env: GHCVER=head CABALVER=head STACKVER=nightly-2020-03-28 addons: {apt: {packages: [ghc-head, cabal-install-head], sources: hvr-ghc}}+ - ghc: '8.8'+ env: GHCVER=8.8.3 CABALVER=3.0 STACKVER=lts-15.5+ addons: {apt: {packages: [ghc-8.8.3, cabal-install-3.0], sources: hvr-ghc}}+ - ghc: '8.6'+ env: GHCVER=8.6.5 CABALVER=2.4 STACKVER=lts-14.27+ addons: {apt: {packages: [ghc-8.6.5, 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}}+ env: GHCVER=8.4.4 CABALVER=2.2 STACKVER=lts-12.26+ addons: {apt: {packages: [ghc-8.4.4, cabal-install-2.2], sources: hvr-ghc}} - ghc: '8.2'- env: GHCVER=8.2.1 CABALVER=2.0- addons: {apt: {packages: [ghc-8.2.1, cabal-install-2.0], sources: hvr-ghc}}+ env: GHCVER=8.2.2 CABALVER=2.0 STACKVER=lts-11.22+ addons: {apt: {packages: [ghc-8.2.2, cabal-install-2.0], sources: hvr-ghc}} - ghc: '8.0'- env: GHCVER=8.0.2 CABALVER=1.24+ env: GHCVER=8.0.2 CABALVER=1.24 STACKVER=lts-9.21 addons: {apt: {packages: [ghc-8.0.2, cabal-install-1.24], sources: hvr-ghc}} - ghc: '7.10'- env: GHCVER=7.10.3 CABALVER=1.22+ env: GHCVER=7.10.3 CABALVER=1.22 STACKVER=lts-6.35 addons: {apt: {packages: [ghc-7.10.3, cabal-install-1.22], sources: hvr-ghc}} # we only support stack with GHC >= 7.10 - ghc: '7.8'@@ -68,11 +76,12 @@ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - ghc --version - cabal --version+ - haddock --version - rm -f ~/.cabal/config && cabal update - cabal install Cabal==1.18.* - cabal install leancheck cmdargs script:- - make && make test-without-extra-deps+ - make && make test - make haddock HADDOCKFLAGS= - make test-sdist - cabal test@@ -83,11 +92,12 @@ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - ghc --version - cabal --version+ - haddock --version - rm -f ~/.cabal/config && cabal update - cabal install Cabal==1.18.* - cabal install leancheck cmdargs script:- - make && make test-without-extra-deps+ - make GHCFLAGS= && make test GHCFLAGS= - make haddock HADDOCKFLAGS= - make test-sdist - cabal test@@ -98,11 +108,12 @@ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - ghc --version - cabal --version+ - haddock --version - rm -f ~/.cabal/config && cabal update - cabal install Cabal==1.18.* - cabal install leancheck cmdargs script:- - make && make test-without-extra-deps+ - make GHCFLAGS= && make test GHCFLAGS= - make haddock HADDOCKFLAGS= - make test-sdist - cabal test
Makefile view
@@ -1,6 +1,6 @@ # Makefile for FitSpec #-# Copyright: (c) 2015-2018 Rudy Matela+# Copyright: (c) 2015-2020 Rudy Matela # License: 3-Clause BSD (see the file LICENSE) # Maintainer: Rudy Matela <rudy@matela.com.br> #@@ -16,8 +16,9 @@ # Misc variables GHCIMPORTDIRS = src:bench GHCFLAGS = -O2 $(shell grep -q "Arch Linux" /etc/lsb-release && echo -dynamic)+CABALOPTS= HADDOCKFLAGS = --no-print-missing-docs-MOSTBENCHS = \+BENCHS = \ bench/avltrees \ bench/bools \ bench/digraphs \@@ -31,19 +32,21 @@ bench/sieve \ bench/sorting \ bench/spring-BENCHS = $(MOSTBENCHS) \+EXTRA_BENCHS = $(BENCHS) \ bench/haskell-src \ bench/haskell-src-exts-MOSTEGS = \+EGS = \ eg/sorting \ eg/negation-EGS = $(MOSTEGS) \+EXTRA_EGS = $(EGS) \ eg/alga TESTS = \- tests/test-derive \- tests/test-mutate \- tests/test-showmutable \- tests/test-utils+ test/derive \+ test/mutate \+ test/showmutable \+ test/utils+HADDOCKFLAGS = $(shell grep -q "Arch Linux" /etc/lsb-release && echo --optghc=-dynamic)+LIB_DEPS = base template-haskell leancheck cmdargs all: mk/toplibs @@ -54,29 +57,29 @@ ghci: Test/FitSpec.ghci test: all benchs egs $(TESTS)- ./tests/test-mutate- ./tests/test-showmutable- ./tests/test-derive- ./tests/test-utils+ ./test/mutate+ ./test/showmutable+ ./test/derive+ ./test/utils -test-without-extra-deps: all $(MOSTBENCHS) $(MOSTEGS) $(TESTS)- ./tests/test-mutate- ./tests/test-showmutable- ./tests/test-derive- ./tests/test-utils+test-with-extra-deps: all $(EXTRA_BENCHS) $(EXTRA_EGS) $(TESTS)+ ./test/mutate+ ./test/showmutable+ ./test/derive+ ./test/utils legacy-test:- make clean && make test-without-extra-deps -j8 GHC=ghc-8.2 GHCFLAGS="-Werror -dynamic"- make clean && make test-without-extra-deps -j8 GHC=ghc-8.0 GHCFLAGS="-Werror -dynamic"- make clean && make test-without-extra-deps -j8 GHC=ghc-7.10 GHCFLAGS="-Werror -dynamic"- make clean && make test-without-extra-deps -j8 GHC=ghc-7.8 GHCFLAGS="-Werror -dynamic"+ make clean && make test -j8 GHC=ghc-8.2 GHCFLAGS="-Werror -dynamic"+ make clean && make test -j8 GHC=ghc-8.0 GHCFLAGS="-Werror -dynamic"+ make clean && make test -j8 GHC=ghc-7.10 GHCFLAGS="-Werror -dynamic"+ make clean && make test -j8 GHC=ghc-7.8 GHCFLAGS="-Werror -dynamic" make clean && make test -j8 test-via-cabal:- cabal configure --enable-tests --enable-benchmarks --ghc-options="-dynamic -Werror" && cabal build && cabal test+ cabal configure --enable-tests --enable-benchmarks --ghc-options="-dynamic -Werror" $(CABALOPTS) && cabal build && cabal test test-sdist:- tests/test-sdist+ ./test/sdist prepare-test-via-cabal: rm -rf .cabal-sandbox cabal.sandbox.config@@ -128,3 +131,8 @@ bench/digraphs: bench/Digraph.o include mk/haskell.mk+# NOTE:+#+# To run make depend, you may need to pass -package now to expose a package:+#+# make depend GHCFLAGS="-package haskell-src-exts"
README.md view
@@ -6,6 +6,8 @@ [![FitSpec on Stackage LTS][stackage-lts-badge]][fitspec-on-stackage-lts] [![FitSpec on Stackage Nightly][stackage-nightly-badge]][fitspec-on-stackage-nightly] +![FitSpec logo][fitspec-logo]+ FitSpec provides automated assistance in the task of refining test properties for [Haskell] functions. FitSpec tests mutant variations of functions under test against a given property set, recording any surviving mutants that pass@@ -28,7 +30,12 @@ Pre-requisites are [cmdargs] and [leancheck]. They should be automatically resolved and installed by [Cabal]. +Starting from Cabal v3.0, you need to pass `--lib` as an argument to+`cabal install`: + $ cabal install fitspec --lib++ Using FitSpec ------------- @@ -158,13 +165,15 @@ [Haskell]: https://www.haskell.org/ [PhD Thesis (2017)]: https://matela.com.br/paper/rudy-phd-thesis-2017.pdf +[fitspec-logo]: https://github.com/rudymatela/fitspec/raw/master/doc/fitspec.svg?sanitize=true+ [build-status]: https://travis-ci.org/rudymatela/fitspec.svg?branch=master [build-log]: https://travis-ci.org/rudymatela/fitspec [hackage-version]: https://img.shields.io/hackage/v/fitspec.svg [fitspec-on-hackage]: https://hackage.haskell.org/package/fitspec [latest FitSpec version from Hackage]: https://hackage.haskell.org/package/fitspec-[stackage-lts-badge]: http://stackage.org/package/fitspec/badge/lts-[stackage-nightly-badge]: http://stackage.org/package/fitspec/badge/nightly-[fitspec-on-stackage]: http://stackage.org/package/fitspec-[fitspec-on-stackage-lts]: http://stackage.org/lts/package/fitspec-[fitspec-on-stackage-nightly]: http://stackage.org/nightly/package/fitspec+[stackage-lts-badge]: https://stackage.org/package/fitspec/badge/lts+[stackage-nightly-badge]: https://stackage.org/package/fitspec/badge/nightly+[fitspec-on-stackage]: https://stackage.org/package/fitspec+[fitspec-on-stackage-lts]: https://stackage.org/lts/package/fitspec+[fitspec-on-stackage-nightly]: https://stackage.org/nightly/package/fitspec
bench/haskell-src-exts.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} import Test.FitSpec import Language.Haskell.Exts-import Language.Haskell.Exts.Pretty instance Eq a => Eq (ParseResult a) where ParseOk x == ParseOk y = x == y
+ doc/fitspec.svg view
@@ -0,0 +1,128 @@+<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!-- Created with Inkscape (http://www.inkscape.org/) -->++<svg+ xmlns:dc="http://purl.org/dc/elements/1.1/"+ xmlns:cc="http://creativecommons.org/ns#"+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"+ xmlns:svg="http://www.w3.org/2000/svg"+ xmlns="http://www.w3.org/2000/svg"+ xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"+ width="75mm"+ height="60mm"+ viewBox="0 0 74.999998 60.000001"+ version="1.1"+ id="svg857"+ inkscape:version="0.92.2 2405546, 2018-03-11"+ sodipodi:docname="fitspec.svg">+ <title+ id="title836">FitSpec</title>+ <defs+ id="defs851" />+ <sodipodi:namedview+ id="base"+ pagecolor="#ffffff"+ bordercolor="#666666"+ borderopacity="1.0"+ inkscape:pageopacity="0"+ inkscape:pageshadow="2"+ inkscape:zoom="0.7071068"+ inkscape:cx="307.62155"+ inkscape:cy="162.29559"+ inkscape:document-units="mm"+ inkscape:current-layer="layer1"+ showgrid="false"+ fit-margin-top="0"+ fit-margin-left="0"+ fit-margin-right="0"+ fit-margin-bottom="0"+ inkscape:window-width="1918"+ inkscape:window-height="1063"+ inkscape:window-x="1366"+ inkscape:window-y="15"+ inkscape:window-maximized="0"+ inkscape:snap-bbox="true"+ inkscape:bbox-paths="false"+ inkscape:snap-bbox-edge-midpoints="false"+ inkscape:snap-midpoints="true"+ inkscape:snap-page="true" />+ <metadata+ id="metadata854">+ <rdf:RDF>+ <cc:Work+ rdf:about="">+ <dc:format>image/svg+xml</dc:format>+ <dc:type+ rdf:resource="http://purl.org/dc/dcmitype/StillImage" />+ <dc:title>FitSpec</dc:title>+ <dc:date>2018-11-24</dc:date>+ <dc:creator>+ <cc:Agent>+ <dc:title>Rudy Matela</dc:title>+ </cc:Agent>+ </dc:creator>+ <dc:source>https://github.com/rudymatela/fitspec</dc:source>+ <dc:subject>+ <rdf:Bag>+ <rdf:li>FitSpec</rdf:li>+ <rdf:li>logo</rdf:li>+ <rdf:li>testing</rdf:li>+ <rdf:li>test</rdf:li>+ <rdf:li>property-based testing</rdf:li>+ <rdf:li>mutation testing</rdf:li>+ </rdf:Bag>+ </dc:subject>+ <dc:description>FitSpec's logo. A check or tick is seen in blue intersected with a lambda.</dc:description>+ <cc:license+ rdf:resource="http://creativecommons.org/licenses/by-sa/4.0/" />+ </cc:Work>+ <cc:License+ rdf:about="http://creativecommons.org/licenses/by-sa/4.0/">+ <cc:permits+ rdf:resource="http://creativecommons.org/ns#Reproduction" />+ <cc:permits+ rdf:resource="http://creativecommons.org/ns#Distribution" />+ <cc:requires+ rdf:resource="http://creativecommons.org/ns#Notice" />+ <cc:requires+ rdf:resource="http://creativecommons.org/ns#Attribution" />+ <cc:permits+ rdf:resource="http://creativecommons.org/ns#DerivativeWorks" />+ <cc:requires+ rdf:resource="http://creativecommons.org/ns#ShareAlike" />+ </cc:License>+ </rdf:RDF>+ </metadata>+ <g+ inkscape:label="Layer 1"+ inkscape:groupmode="layer"+ id="layer1"+ transform="translate(297.11803,-172.26764)">+ <path+ style="clip-rule:nonzero;fill:#7f99b3;fill-opacity:1;fill-rule:nonzero;stroke:none;stroke-width:0.17638953"+ d="m -237.11837,172.26764 -32.49994,48.74992 -12.4998,-18.74983 h -14.99992 l 19.99989,29.99983 h 14.99992 l 39.99977,-59.99992 z"+ id="path9-3"+ inkscape:connector-curvature="0" />+ <path+ inkscape:connector-curvature="0"+ id="path9"+ d="m -277.11814,232.26764 20.00023,-30 -20.00023,-30 h 15 l 39.99977,60 h -15 l -12.49954,-18.74965 -12.50023,18.74965 z m 0,0"+ style="clip-rule:nonzero;fill:#808080;fill-opacity:1;fill-rule:nonzero;stroke:none;stroke-width:0.17638952" />+ <path+ style="clip-rule:nonzero;fill:#4c6680;fill-opacity:1;fill-rule:nonzero;stroke:none;stroke-width:0.17638952"+ d="m -249.61834,191.01782 -7.49983,11.24974 2.6e-4,2.6e-4 -19.99988,29.99982 h 14.99965 l 19.99989,-29.99982 z"+ id="path9-3-3"+ inkscape:connector-curvature="0" />+ <path+ style="clip-rule:nonzero;fill:#808080;fill-opacity:1;fill-rule:nonzero;stroke:none;stroke-width:0.17638953"+ d="m -233.78419,197.2675 -3.33341,4.99997 v 0.001 l 3.33289,4.99946 h 8.33363 l 3.3334,-5.00023 -3.3334,-4.99997 z"+ id="path9-36"+ inkscape:connector-curvature="0" />+ <path+ inkscape:connector-curvature="0"+ style="clip-rule:nonzero;fill:#808080;fill-opacity:1;fill-rule:nonzero;stroke:none;stroke-width:0.17638952"+ d="m -273.78461,197.26742 -3.3334,4.99997 v 0.001 l 3.33288,4.99945 h 8.33363 l 3.33341,-5.00023 -3.33341,-4.99997 z"+ id="path9-36-5" />+ </g>+</svg>
fitspec.cabal view
@@ -1,5 +1,5 @@ name: fitspec-version: 0.4.7+version: 0.4.8 synopsis: refining property sets for testing Haskell programs description: FitSpec provides automated assistance in the task of refining test properties@@ -29,6 +29,7 @@ , TODO.md , doc/modules.md , doc/tutorial-property-creation.md+ , doc/fitspec.svg extra-source-files: .gitignore , .travis.yml , Makefile@@ -42,9 +43,18 @@ , mk/ghcdeps , mk/haddock-i , mk/haskell.mk+ , mk/install-on , stack.yaml- , tests/test-sdist-tested-with: GHC==8.2, GHC==8.0, GHC==7.10, GHC==7.8, GHC==7.6, GHC==7.4+ , test/sdist+tested-with: GHC==8.8+ , GHC==8.6+ , GHC==8.4+ , GHC==8.2+ , GHC==8.0+ , GHC==7.10+ , GHC==7.8+ , GHC==7.6+ , GHC==7.4 source-repository head type: git@@ -53,7 +63,7 @@ source-repository this type: git location: https://github.com/rudymatela/fitspec- tag: v0.4.7+ tag: v0.4.8 library@@ -70,36 +80,36 @@ , Test.FitSpec.Utils , Test.FitSpec.PrettyPrint other-modules: Test.FitSpec.Dot- build-depends: base >= 4 && < 5, leancheck >= 0.7.2, cmdargs, template-haskell+ build-depends: base >= 4 && < 5, leancheck >= 0.9.3, cmdargs, template-haskell hs-source-dirs: src default-language: Haskell2010 test-suite mutate type: exitcode-stdio-1.0- main-is: test-mutate.hs- hs-source-dirs: tests+ main-is: mutate.hs+ hs-source-dirs: test build-depends: base >= 4 && < 5, leancheck, fitspec default-language: Haskell2010 test-suite showmutable type: exitcode-stdio-1.0- main-is: test-showmutable.hs- hs-source-dirs: tests+ main-is: showmutable.hs+ hs-source-dirs: test build-depends: base >= 4 && < 5, leancheck, fitspec default-language: Haskell2010 test-suite derive type: exitcode-stdio-1.0- main-is: test-derive.hs- hs-source-dirs: tests+ main-is: derive.hs+ hs-source-dirs: test build-depends: base >= 4 && < 5, leancheck, fitspec default-language: Haskell2010 test-suite utils type: exitcode-stdio-1.0- main-is: test-utils.hs- hs-source-dirs: tests+ main-is: utils.hs+ hs-source-dirs: test build-depends: base >= 4 && < 5, leancheck, fitspec default-language: Haskell2010
mk/depend.mk view
@@ -402,8 +402,8 @@ src/Test/FitSpec/Mutable.hs src/Test/FitSpec/Utils.o: \ src/Test/FitSpec/Utils.hs-tests/test-derive.o: \- tests/test-derive.hs \+test/derive.o: \+ test/derive.hs \ src/Test/FitSpec/Utils.hs \ src/Test/FitSpec/TestTypes.hs \ src/Test/FitSpec/ShowMutable/Tuples.hs \@@ -416,11 +416,11 @@ src/Test/FitSpec/Main.hs \ src/Test/FitSpec/Engine.hs \ src/Test/FitSpec/Derive.hs-tests/test-derive: \- tests/test-derive.hs \+test/derive: \+ test/derive.hs \ mk/toplibs-tests/test-mutate.o: \- tests/test-mutate.hs \+test/mutate.o: \+ test/mutate.hs \ src/Test/FitSpec/Utils.hs \ src/Test/FitSpec/TestTypes.hs \ src/Test/FitSpec/ShowMutable/Tuples.hs \@@ -433,11 +433,11 @@ src/Test/FitSpec/Main.hs \ src/Test/FitSpec/Engine.hs \ src/Test/FitSpec/Derive.hs-tests/test-mutate: \- tests/test-mutate.hs \+test/mutate: \+ test/mutate.hs \ mk/toplibs-tests/test-showmutable.o: \- tests/test-showmutable.hs \+test/showmutable.o: \+ test/showmutable.hs \ src/Test/FitSpec/Utils.hs \ src/Test/FitSpec/TestTypes.hs \ src/Test/FitSpec/ShowMutable/Tuples.hs \@@ -450,12 +450,12 @@ src/Test/FitSpec/Main.hs \ src/Test/FitSpec/Engine.hs \ src/Test/FitSpec/Derive.hs-tests/test-showmutable: \- tests/test-showmutable.hs \+test/showmutable: \+ test/showmutable.hs \ mk/toplibs-tests/test-utils.o: \- tests/test-utils.hs \+test/utils.o: \+ test/utils.hs \ src/Test/FitSpec/Utils.hs-tests/test-utils: \- tests/test-utils.hs \+test/utils: \+ test/utils.hs \ mk/toplibs
mk/ghcdeps view
@@ -2,7 +2,7 @@ # # ghcdeps: generate Haskell make dependencies for compiling with GHC. #-# Copyright (c) 2015-2018 Rudy Matela.+# Copyright (c) 2015-2020 Rudy Matela. # Distributed under the 3-Clause BSD licence. # # From a list of files provided on standard input,
mk/haddock-i view
@@ -2,7 +2,7 @@ # # haddock-i: list haddock's -i parameters. #-# Copyright (c) 2015-2018 Rudy Matela.+# Copyright (c) 2015-2020 Rudy Matela. # Distributed under the 3-Clause BSD licence. # # $ haddock-i <package1> <package2> ... <packageN>@@ -11,14 +11,26 @@ # documentation installed on your system, so you can: # # $ haddock-i base template-haskell | xargs haddock <files>-errxit() {+err() { echo "$@" > /dev/stderr+}++errxit() {+ err "$@" exit 1 } -for pkg in "$@"; do- ghc-pkg field $pkg haddock-html,haddock-interfaces ||- errxit "error: haddock-i: cannot find package $pkg (ghc-pkg)"-done |-sed "s/.*: //" |-sed "N;s/\n/,/;s/^/-i/"+iface-for() {+ ghc-pkg field $1 haddock-interfaces | sort -rV | head -1 | sed "s/.*: //"+}++html-for() {+ ghc-pkg field $1 haddock-html | sort -rV | head -1 | sed "s/.*: //"+}++for pkg in "$@"+do+ iface=$(iface-for $pkg)+ html=$(html-for $pkg)+ [ -d "$html" -a -f "$iface" ] && echo "-i$html,$iface" || err "haddock-i: warning: could not find interface file for $pkg"+done
mk/haskell.mk view
@@ -1,6 +1,6 @@ # Implicit rules for compiling Haskell code. #-# Copyright (c) 2015-2018 Rudy Matela.+# Copyright (c) 2015-2020 Rudy Matela. # Distributed under the 3-Clause BSD licence. # # You can optionally configure the "Configuration variables" below in your main@@ -20,6 +20,7 @@ GHCFLAGS ?= GHC ?= ghc GHCCMD = $(GHC) -i$(GHCIMPORTDIRS) $(GHCFLAGS)+HADDOCK ?= haddock # Hugs Parameters HUGSIMPORTDIRS ?= "/usr/lib/hugs/packages/*"@@ -38,12 +39,24 @@ # ALL_HSS: all Haskell files # You can override ALL/LIB_HSS in your main Makefile LIST_LIB_HSS ?= find src -name "*.hs"-LIST_ALL_HSS ?= find \( -path "./dist" -o -path "./.stack-work" \) -prune \+LIST_ALL_HSS ?= find \( -path "./dist*" -o -path "./.stack-work" -o -path "./Setup.hs" \) -prune \ -o -name "*.*hs" -print LIB_HSS ?= $(shell $(LIST_LIB_HSS)) ALL_HSS ?= $(shell $(LIST_ALL_HSS)) +LIB_DEPS ?= base+ALL_DEPS ?= $(LIB_DEPS)+ PKGNAME = $(shell cat *.cabal | grep "^name:" | sed -e "s/name: *//")+HADDOCK_VERSION = $(shell $(HADDOCK) --version | grep version | sed -e 's/.*version //;s/,.*//')+HADDOCK_MAJOR = $(shell echo $(HADDOCK_VERSION) | sed -e 's/\..*//')+HADDOCK_MINOR = $(shell echo $(HADDOCK_VERSION) | sed -e 's/[0-9]*\.\([0-9]*\).[0-9]*/\1/')+HADDOCK_PKG_NAME = $(shell [ $(HADDOCK_MAJOR) -gt 2 ] \+ || [ $(HADDOCK_MAJOR) -eq 2 -a $(HADDOCK_MINOR) -ge 20 ] \+ && echo "--package-name=$(PKGNAME)")+HADDOCK_HLNK_SRC = $(shell [ $(HADDOCK_MAJOR) -gt 2 ] \+ || [ $(HADDOCK_MAJOR) -eq 2 -a $(HADDOCK_MINOR) -ge 17 ] \+ && echo "--hyperlinked-source") # Implicit rules@@ -84,7 +97,7 @@ haddock: doc/index.html clean-haddock:- rm -f doc/*.{html,css,js,png,gif,json} README.html+ rm -f doc/*.{html,css,js,png,gif,json} doc/src/* README.html upload-haddock: @echo "use \`cabal upload -d' instead"@@ -93,9 +106,14 @@ @echo "(on Arch Linux, use: cabal haddock --for-hackage --haddock-options=--optghc=-dynamic)" doc/index.html: $(LIB_HSS)- ./mk/haddock-i base template-haskell | xargs \- haddock --html -odoc $(LIB_HSS) $(HADDOCKFLAGS) --title=$(PKGNAME)+ ./mk/haddock-i $(LIB_DEPS) | xargs \+ $(HADDOCK) --html -odoc $(LIB_HSS) \+ --title=$(PKGNAME) \+ $(HADDOCK_PKG_NAME) \+ $(HADDOCK_HLNK_SRC) \+ $(HADDOCKFLAGS) + # lists all Haskell source files list-all-hss: @find $(ALL_HSS)@@ -103,6 +121,12 @@ # lists library Haskell source files list-lib-hss: @find $(LIB_HSS)++bootstrap-haskell-mk:+ @[ -d "$(DEST)" ] || (echo -e "error: no destination found\nusage: \`make bootstrap-haskell-mk DEST=path/to/prj'"; exit 1)+ mkdir -p mk+ cp mk/{haskell.mk,ghcdeps,haddock-i} $(DEST)/mk+ touch $(DEST)/mk/depend.mk show-pkgname: @echo $(PKGNAME)
+ mk/install-on view
@@ -0,0 +1,30 @@+#!/bin/bash+#+# mk/install-on: install or updates the mk folder on a Haskell project+#+# usage: ./mk/install-on path/to/project+#+# This assumes a few things:+#+# * tests are stored in a "test/" folder+# * sources are stored in a "src/" folder+set -e++errxit() {+ echo "$@" > /dev/stderr+ exit 1+}++src=`dirname $0`/..+dst="$1"++[ -n "$dst" ] || errxit "destination folder not provided"++mkdir -p $dst/mk+mkdir -p $dst/test++cp $src/mk/ghcdeps $dst/mk/ghcdeps+cp $src/mk/haddock-i $dst/mk/haddock-i+cp $src/mk/haskell.mk $dst/mk/haskell.mk+cp $src/mk/install-on $dst/mk/install-on+cp $src/test/sdist $dst/test/sdist
stack.yaml view
@@ -1,16 +1,7 @@-# stack.yaml docs:-# https://docs.haskellstack.org/en/stable/yaml_configuration/--# resolver: nightly-2015-09-21-# resolver: ghc-7.10.2-resolver: lts-12.7+resolver: lts-15.5 # or ghc-8.8.3 packages: - . extra-deps:-- leancheck-0.7.2--flags: {}--extra-package-dbs: []+- leancheck-0.9.3
+ test/derive.hs view
@@ -0,0 +1,71 @@+-- Copyright (c) 2015-2017 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+{-# LANGUAGE TemplateHaskell #-}+import System.Exit (exitFailure)+import Data.List (elemIndices,sort)++import Test.FitSpec hiding (Set)++data D0 = D0 deriving (Show,Eq,Ord)+data D1 a = D1 a deriving (Show,Eq,Ord)+data D2 a b = D2 a b deriving (Show,Eq,Ord)+data D3 a b c = D3 a b c deriving (Show,Eq,Ord)+data C1 a = C11 a | C10 deriving (Show,Eq,Ord)+data C2 a b = C22 a b | C21 a | C20 deriving (Show,Eq,Ord)+data I a b = a :+ b deriving (Show,Eq,Ord)+deriveMutable ''D0+deriveMutable ''D1+deriveMutable ''D2+deriveMutable ''D3+deriveMutable ''C1+deriveMutable ''C2+deriveMutable ''I++-- Those should have no effect (instance already exists):+{- uncommenting those should generate warnings+deriveMutable ''Bool+deriveMutable ''Maybe+deriveMutable ''Either+-}++data Set a = Set [a] deriving (Show,Eq,Ord)++instance (Ord a, Listable a) => Listable (Set a) where+ tiers = setCons Set++deriveMutableE [''Ord] ''Set++main :: IO ()+main =+ case elemIndices False (tests 100) of+ [] -> putStrLn "Tests passed!"+ is -> do putStrLn ("Failed tests:" ++ show is)+ exitFailure++type Id a = a -> a++tests n =+ [ True+ , allUnique $ concat $ showNewMutants1 (id :: Id D0) 7+ , allUnique $ concat $ showNewMutants1 (id :: Id (D1 UInt2)) 7+ , allUnique $ concat $ showNewMutants1 (id :: Id (D2 UInt2 UInt2)) 7+ , allUnique $ concat $ showNewMutants1 (id :: Id (D3 UInt2 UInt2 UInt2)) 7+ , allUnique $ concat $ showNewMutants1 (id :: Id (C1 UInt2)) 7+ , allUnique $ concat $ showNewMutants1 (id :: Id (C2 UInt2 UInt2)) 7+ , allUnique $ concat $ showNewMutants1 (id :: Id (I UInt2 UInt2)) 7+ , allUnique $ concat $ showNewMutants1 (id :: Id (Set UInt2)) 7+ ]++showNewMutants1 :: (ShowMutable a, Mutable a)+ => a -> Int -> [[String]]+showNewMutants1 f n = mapT (showMutantAsTuple [] f)+ $ take n+ $ mutiers f++allUnique :: Ord a => [a] -> Bool+allUnique [] = True+allUnique (x:xs) = x `notElem` xs+ && allUnique lesser+ && allUnique greater+ where lesser = filter (< x) xs+ greater = filter (> x) xs
+ test/mutate.hs view
@@ -0,0 +1,130 @@+-- Copyright (c) 2015-2017 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+import System.Exit (exitFailure)+import Data.List (elemIndices, sort)+import Data.Tuple (swap)++import Test.FitSpec+import Test.FitSpec.Utils (contained)+import Test.LeanCheck.Error (errorToNothing, errorToFalse)++import Data.Monoid ((<>))+import Data.Word (Word) -- for GHC <= 7.10++polyAppend :: [a] -> [b] -> [Either a b]+polyAppend xs ys = map Left xs ++ map Right ys++main :: IO ()+main =+ case elemIndices False tests of+ [] -> putStrLn "Tests passed!"+ is -> do putStrLn ("Failed tests:" ++ show is)+ exitFailure++tests = map errorToFalse+ [ True++ , allUnique $ concat $ showNewMutants1 (sort :: [Int] -> [Int]) 7+ , allUnique $ concat $ showNewMutants2 ((++) :: [Int] -> [Int] -> [Int]) 7++ , allUnique $ concat $ showNewMutants1 (swap :: (Int,Int) -> (Int,Int)) 7+ , allUnique $ concat $ showNewMutants1 (swap :: (Bool,Bool) -> (Bool,Bool)) 7++ , allUnique $ concat $ showNewMutants2 ((,) :: Int -> Bool -> (Int,Bool)) 7+ , allUnique $ concat $ showNewMutants2 ((,) :: Bool -> Int -> (Bool,Int)) 7++ , allUnique $ concat $ showNewMutants2 (polyAppend :: [String] -> [Int] -> [Either String Int]) 7+ , allUnique $ concat $ showNewMutants2 ((+) :: Float -> Float -> Float) 7+ , allUnique $ concat $ showNewMutants2 ((+) :: Double -> Double -> Double) 7+ , allUnique $ concat $ showNewMutants2 ((<>) :: Ordering -> Ordering -> Ordering) 7+ , allUnique $ concat $ showNewMutants2 ((+) :: Word -> Word -> Word) 7++ {-+ , checkBindingsOfLength 7 2 ((,) :: Bool -> Bool -> (Bool,Bool))+ , checkBindingsOfLength 7 2 ((,) :: Int -> Int -> (Int,Int))+ , checkBindingsOfLength 7 1 (swap :: (Bool,Bool) -> (Bool,Bool))+ , checkBindingsOfLength 4 1 (swap :: (Bool,Bool) -> (Bool,Bool),sort :: [Int] -> [Int])+ -}++ , holds 25 (uniqueMutants 100 :: [Bool] -> Bool)+ , holds 25 (mutantsInListing 100 :: [Bool] -> Bool)+ , holds 25 (listingInMutants 100 :: [Bool] -> Bool)+ , holds 25 (uniqueMutants 100 :: [Int] -> Bool)+ , holds 25 (mutantsInListing 100 :: [Int] -> Bool)+ , holds 25 (listingInMutants 100 :: [Int] -> Bool)+ , holds 25 (uniqueMutants 100 :: [()] -> Bool)+ , holds 25 (mutantsInListing 100 :: [()] -> Bool)+ , holds 25 (listingInMutants 100 :: [()] -> Bool)+ , holds 25 (uniqueMutants 100 :: Bool -> Bool)+ , holds 25 (mutantsInListing 100 :: Bool -> Bool)+ , holds 25 (listingInMutants 100 :: Bool -> Bool)+ , holds 25 (uniqueMutants 100 :: Int -> Bool)+ , holds 25 (mutantsInListing 100 :: Int -> Bool)+ , holds 25 (listingInMutants 100 :: Int -> Bool)+ , holds 25 (uniqueMutants 100 :: () -> Bool)+ , holds 25 (mutantsInListing 100 :: () -> Bool)+ , holds 25 (listingInMutants 100 :: () -> Bool)+ ]+++uniqueMutants :: (Ord a, Listable a, Mutable a) => Int -> a -> Bool+uniqueMutants n = allUnique . take n . mutants++mutantsInListing :: (Eq a, Listable a, Mutable a) => Int -> a -> Bool+mutantsInListing n x = take n (mutants x) `contained` list++listingInMutants :: (Eq a, Listable a, Mutable a) => Int -> a -> Bool+listingInMutants n x = take n list `contained` mutants x+++{- does not work as for the new interface for mutantS+checkBindingsOfLength :: (Mutable a, ShowMutable a)+ => Int -> Int -> a -> Bool+checkBindingsOfLength n len f = (all . all) (bindingsOfLength len)+ . concat+ . take n+ . mapT (mutantS f)+ $ mutiers f+-}+++bindingsOfLength :: Int -> [([String],String)] -> Bool+bindingsOfLength n = all ((== n) . length . fst)+++showNewMutants1 :: (ShowMutable a, Mutable a)+ => a -> Int -> [[String]]+showNewMutants1 f n = mapT (showMutantAsTuple [] f)+ $ take n+ $ mutiers f++showNewMutants2 :: ( Eq a, Eq b, Eq c+ , Show a, Show b, Show c+ , Listable a, Listable b, Mutable c+ , ShowMutable c )+ => (a -> b -> c) -> Int -> [[String]]+showNewMutants2 f n = mapT (showMutantAsTuple [] uf . uncurry)+ $ take n+ $ mutiers f+ where uf = uncurry f++canonicalMutation :: Eq b => (a -> b) -> [(a, b)] -> Bool+-- This simple version on the line below+-- is one that does not deal with partially undefined functions.+-- canonicalMutation f = all (\(a,r) -> f a /= r)+canonicalMutation f = all different+ where+ -- the errorToNothing here deals partial functions (error/undefined)+ -- We define that mutating undefined values is noncanonical+ different (a,r) = case errorToNothing $ f a of+ Just r' -> r' /= r+ Nothing -> False -- for our purposes,+ -- undefined is equal to anything++allUnique :: Ord a => [a] -> Bool+allUnique [] = True+allUnique (x:xs) = x `notElem` xs+ && allUnique lesser+ && allUnique greater+ where lesser = filter (< x) xs+ greater = filter (> x) xs
+ test/sdist view
@@ -0,0 +1,40 @@+#!/bin/bash+#+# test/sdist: tests the package generated by "cabal sdist".+#+# Copyright (c) 2015-2020 Rudy Matela.+# Distributed under the 3-Clause BSD licence.++set -xe++export LC_ALL=C # consistent sort++pkgver=` cat *.cabal | grep "^version:" | sed -e "s/version: *//"`+pkgname=`cat *.cabal | grep "^name:" | sed -e "s/name: *//"`+pkgbase=$pkgname-$pkgver++cabal sdist++# Try to find the package generated by cabal.+pkg=`find dist* -name $pkgbase.tar.gz`+[ -f "$pkg" ]+# If the script fails here, either:+# * no package was generated+# * there are packages in both dist and dist-newstyle folders.++tmp=`mktemp -d /tmp/test-sdist-XXXXXXXXXX`++# Test if our file is compatible with case-insensitive filesystems.+tar -tf $pkg | sort --ignore-case > $tmp/ls-cabal-i+tar -tf $pkg | sort --ignore-case --unique > $tmp/ls-cabal-iu+diff -rud $tmp/ls-cabal-i $tmp/ls-cabal-iu++if [ -d .git ]+then+ # Test if files included by cabal are the same as files tracked in git.+ git ls-files | sort > $tmp/ls-git+ tar -tf $pkg | grep -v "/$" | sed -e "s,$pkgbase/,," | sort > $tmp/ls-cabal+ diff -rud $tmp/ls-git $tmp/ls-cabal+fi++rm -r $tmp
+ test/showmutable.hs view
@@ -0,0 +1,253 @@+-- Copyright (c) 2015-2017 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+{-# LANGUAGE NoMonomorphismRestriction #-}+import System.Exit (exitFailure)+import System.Environment (getArgs)+import Data.List (elemIndices, sort)+import Data.Tuple (swap)++import Test.FitSpec+import Test.FitSpec.ShowMutable+import Test.FitSpec.PrettyPrint+import Test.LeanCheck.Error (errorToNothing)+import Test.LeanCheck.Utils.TypeBinding++main :: IO ()+main = do+ as <- System.Environment.getArgs+ let n = case as of [] -> 10+ (s:_) -> read s+ -- n == 10 -- 1s on zero+ -- n == 32 -- 4s on zero+ -- n == 100 -- 15s on zero+ -- n == 200 -- 30s on zero+ case elemIndices False (tests n) of+ [] -> putStrLn "Tests passed!"+ is -> do putStrLn ("Failed tests:" ++ show is)+ exitFailure++-- Below, some of the tests are marked as failing:+-- They simply fail because there are too many values+-- being tested (the showMutant function only approximates+-- the printing of a mutant)+-- There is a TODO in the other file related to this+-- to allow configuration of how many values should be+-- tried when enumerating the mutants.+tests n =+ [ True++ , holds n $ prop_0 -:> int+ , holds n $ prop_0 -:> bool+ , holds n $ prop_0 -:> char+ , holds n $ prop_0 -:> string+ , fails n $ prop_0 -:> (int,int)++ , holds n $ prop_00 -:> (int,int)+ , holds n $ prop_00 -:> (bool,int)+ , holds n $ prop_00 -:> (int,bool)+ , holds n $ prop_00 -:> (string,char)+ , holds n $ prop_00 -:> (char,string)++ , h1 $ id -:> int+ , h1 $ id -:> bool+ , h1 $ id -:> (int,int)+ , h1 $ id -:> (bool,int)+ , h1 $ id -:> (int,bool)+ , h1 $ id -:> (bool,bool)+ , h1 $ id -:> (int,int,int)+ , h1 $ id -:> (int,(int,int))+ , h1 $ id -:> ((int,int),int)+ , h1 $ const True -:> int -- fails (500 tests)!+ , h1 $ const (0::Int) -:> bool+ , h1 $ swap -:> (int,bool)+ , h1 $ swap -:> (bool,int)+ , h1 $ swap -:> (int,(int,int))+ , h1 $ swap -:> ((int,int),int)++ , h2 $ const -: int >- int >- und+ , h2 $ const -: int >- bool >- und+ , h2 $ const -: bool >- int >- und -- fails (1000 tests)!+ , h2 $ (+) -:> int+ , hI $ (+) -:> int+ , h2 $ (*) -:> int+ , h2 $ (&&)+ , h2 $ (||)+ , h2 $ (:) -:> int -- fails (2000 tests)!+ , h2 $ (++) -:> [int] -- fails (3000 tests)!++ , h11 (id -:> int) (id ->: bool)+ , h11 (id -:> bool) (id ->: int)+ , h11 (swap -:> ((int,int),int)) (swap ->: (int,(int,int)))++ , h111 (id -:> int) (id ->: bool) (id ->: char)+ , h111 (id -:> bool) (id ->: char) (id ->: int)+ , h111 (swap -:> ((int,int),(int,int)))+ (swap -:> ((int,int),int))+ (swap -:> (int,(int,int)))++ , h11' (id -:> int) (id ->: bool) (id ->: char)+ , h11' (id -:> bool) (id ->: char) (id ->: int)+ , h11' (swap -:> ((int,int),(int,int)))+ (swap -:> ((int,int),int))+ (swap -:> (int,(int,int)))+ ]+ where h1 = holds n . prop_1+ h2 = holds n . prop_2+ hI = holds n . prop_I+ h11 f = holds n . prop_11 f+ h111 f g = holds n . prop_111 f g+ h11' f g = holds n . prop_11' f g++-- prop_N, asserts the format of a mutation of a value of N arguments+-- prop_MN, asserts the format of a pair of values of M and N arguments+-- prop_MNO, asserts the format of a triple of values++prop_0 :: (Eq a, Show a, Listable a, ShowMutable a)+ => a -> a -> Bool+prop_0 x x' | x == x' = s == "x"+ | otherwise = s == show x'+ where s = showMutantAsTuple ["x"] x x'++prop_00 :: ( Eq a, Show a, Listable a, ShowMutable a+ , Eq b, Show b, Listable b, ShowMutable b )+ => (a,b) -> (a,b) -> Bool+prop_00 (x,y) (x',y') | x == x' && y == y' = s == "(x,y)"+ | x == x' = s == "(x," ++ show y' ++ ")"+ | y == y' = s == "(" ++ show x' ++ ",y)"+ | otherwise = s == "(" ++ show x'+ ++ "," ++ show y' ++ ")"+ where s = showMutantAsTuple ["x","y"] (x,y) (x',y')++prop_1 :: ( Eq a, Show a, Listable a, ShowMutable a+ , Eq b, Show b, Listable b, ShowMutable b )+ => (a->b) -> a -> b -> Bool+prop_1 f x fx = fx /= f x+ ==> showMutantAsTuple ["f x"] f (mutate f x fx) == showMutantF "f" x fx+ && showMutantDefinition ["f x"] f (mutate f x fx) == showMutantB "f" x fx++prop_11 :: ( Eq a, Show a, Listable a, ShowMutable a+ , Eq b, Show b, Listable b, ShowMutable b+ , Eq c, Show c, Listable c, ShowMutable c+ , Eq d, Show d, Listable d, ShowMutable d )+ => (a->b) -> (c->d) -> a -> b -> c -> d -> Bool+prop_11 f g x fx y gy = fx /= f x && gy /= g y+ ==> showMutantAsTuple ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)+ == showTuple [showMutantF "f" x fx, showMutantF "g" y gy]+ && showMutantDefinition ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)+ == concat [showMutantB "f" x fx, showMutantB "g" y gy]++prop_111 :: ( Eq a, Show a, Listable a, ShowMutable a+ , Eq b, Show b, Listable b, ShowMutable b+ , Eq c, Show c, Listable c, ShowMutable c+ , Eq d, Show d, Listable d, ShowMutable d+ , Eq e, Show e, Listable e, ShowMutable e+ , Eq f, Show f, Listable f, ShowMutable f )+ => (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool+prop_111 f g h x fx y gy z hz = fx /= f x+ && gy /= g y+ && hz /= h z+ ==> showMutantAsTuple ["f x","g x","h x"] (f,g,h)+ ( mutate f x fx+ , mutate g y gy+ , mutate h z hz )+ == showTuple [ showMutantF "f" x fx+ , showMutantF "g" y gy+ , showMutantF "h" z hz ]+ && showMutantDefinition ["f x","g x","h x"] (f,g,h)+ ( mutate f x fx+ , mutate g y gy+ , mutate h z hz )+ == concat [ showMutantB "f" x fx+ , showMutantB "g" y gy+ , showMutantB "h" z hz ]++prop_11' :: ( Eq a, Show a, Listable a, ShowMutable a+ , Eq b, Show b, Listable b, ShowMutable b+ , Eq c, Show c, Listable c, ShowMutable c+ , Eq d, Show d, Listable d, ShowMutable d+ , Eq e, Show e, Listable e, ShowMutable e+ , Eq f, Show f, Listable f, ShowMutable f )+ => (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool+prop_11' f g h x fx y gy z hz = fx /= f x+ && gy /= g y+ && hz /= h z+ ==> showMutantAsTuple ["f x","g x","h x"] (f,(g,h))+ ( mutate f x fx+ , ( mutate g y gy+ , mutate h z hz ) )+ == showTuple [ showMutantF "f" x fx+ , showTuple [ showMutantF "(??)" y gy+ , showMutantF "(??)" z hz ] ]+ && showMutantDefinition ["f x","g x","h x"] (f,(g,h))+ ( mutate f x fx+ , ( mutate g y gy+ , mutate h z hz ) )+ == concat [ showMutantB "f" x fx+ , "g' = "+ `beside` showTuple [ showMutantF "(??)" y gy+ , showMutantF "(??)" z hz ] ]++prop_2 :: ( Eq a, Show a, Listable a, ShowMutable a+ , Eq b, Show b, Listable b, ShowMutable b+ , Eq c, Show c, Listable c, ShowMutable c )+ => (a->b->c) -> a -> b -> c -> Bool+prop_2 f x y fxy = fxy /= f x y ==>+ showMutantAsTuple ["f x y"] f (mutate2 f x y fxy) == showMutantF2 "f" x y fxy &&+ showMutantDefinition ["f x y"] f (mutate2 f x y fxy) == showMutantB2 "f" x y fxy+++prop_I :: ( Eq a, Show a, Listable a, ShowMutable a+ , Eq b, Show b, Listable b, ShowMutable b+ , Eq c, Show c, Listable c, ShowMutable c )+ => (a->b->c) -> a -> b -> c -> Bool+prop_I f x y fxy = fxy /= f x y ==>+ showMutantAsTuple ["x + y"] f (mutate2 f x y fxy) == showMutantI "+" x y fxy &&+ showMutantDefinition ["x + y"] f (mutate2 f x y fxy) == showMutantBI "+" x y fxy++mutate :: Eq a => (a -> b) -> a -> b -> (a -> b)+mutate f x y x' | x' == x = y+ | otherwise = f x'++mutate2 :: (Eq a, Eq b) => (a -> b -> c) -> a -> b -> c -> (a -> b -> c)+mutate2 f x y z = curry (mutate (uncurry f) (x,y) z)++-- | Show a mutant of a function of one argument+showMutantF :: (Show a, Show b)+ => String -> a -> b -> String+showMutantF f x y = "\\x -> case x of\n"+ ++ " " ++ show x ++ " -> " ++ show y ++ "\n"+ ++ " _ -> " ++ f ++ " x\n"++-- | Show a mutant of a function of two arguments+showMutantF2 :: (Show a, Show b, Show c)+ => String -> a -> b -> c -> String+showMutantF2 f x y z = "\\x y -> case (x,y) of\n"+ ++ " (" ++ show x ++ "," ++ show y ++ ") -> "+ ++ show z ++ "\n"+ ++ " _ -> " ++ f ++ " x y\n"++showMutantB :: (Show a, Show b)+ => String -> a -> b -> String+showMutantB f x fx = table " "+ [ [f ++ "'", show x, "=", show fx]+ , [f ++ "'", "x", "=", f ++ " x"] ]++showMutantB2 :: (Show a, Show b, Show c)+ => String -> a -> b -> c -> String+showMutantB2 f x y fxy = table " "+ [ [f ++ "'", show x, show y, "=", show fxy]+ , [f ++ "'", "x", "y", "=", f ++ " x y"] ]++-- | Show a mutant of an infix+showMutantI :: (Show a, Show b, Show c)+ => String -> a -> b -> c -> String+showMutantI o x y z = "\\x y -> case (x,y) of\n"+ ++ " (" ++ show x ++ "," ++ show y ++ ") -> "+ ++ show z ++ "\n"+ ++ " _ -> x " ++ o ++ " y\n"++showMutantBI :: (Show a, Show b, Show c)+ => String -> a -> b -> c -> String+showMutantBI o x y fxy = table " "+ [ [show x, o ++ "-", show y, "=", show fxy]+ , ["x", o ++ "-", "y", "=", "x " ++ o ++ " y"] ]
+ test/utils.hs view
@@ -0,0 +1,29 @@+-- Copyright (c) 2015-2017 Rudy Matela.+-- Distributed under the 3-Clause BSD licence (see the file LICENSE).+import System.Exit (exitFailure)+import Data.List (elemIndices,sortBy)++import Data.Function++import Test.LeanCheck+import Test.FitSpec.Utils++main :: IO ()+main =+ case elemIndices False (tests 500) of+ [] -> putStrLn "Tests passed!"+ is -> do putStrLn ("Failed tests:" ++ show is)+ exitFailure++tests :: Int -> [Bool]+tests n =+ [ True++ , sortOn snd [(1,3),(2,2),(3,1)] == [(3,1),(2,2),(1,3)]+ , holds n $ (propSortOn fst :: [(Int,Int)] -> Bool)+ , holds n $ (propSortOn snd :: [(Int,Int)] -> Bool)+ , holds n $ (propSortOn abs :: [Int] -> Bool)+ ]++propSortOn :: (Eq a, Ord b) => (a -> b) -> [a] -> Bool+propSortOn f xs = sortOn f xs == sortBy (compare `on` f) xs
− tests/test-derive.hs
@@ -1,71 +0,0 @@--- Copyright (c) 2015-2017 Rudy Matela.--- Distributed under the 3-Clause BSD licence (see the file LICENSE).-{-# LANGUAGE TemplateHaskell #-}-import System.Exit (exitFailure)-import Data.List (elemIndices,sort)--import Test.FitSpec hiding (Set)--data D0 = D0 deriving (Show,Eq,Ord)-data D1 a = D1 a deriving (Show,Eq,Ord)-data D2 a b = D2 a b deriving (Show,Eq,Ord)-data D3 a b c = D3 a b c deriving (Show,Eq,Ord)-data C1 a = C11 a | C10 deriving (Show,Eq,Ord)-data C2 a b = C22 a b | C21 a | C20 deriving (Show,Eq,Ord)-data I a b = a :+ b deriving (Show,Eq,Ord)-deriveMutable ''D0-deriveMutable ''D1-deriveMutable ''D2-deriveMutable ''D3-deriveMutable ''C1-deriveMutable ''C2-deriveMutable ''I---- Those should have no effect (instance already exists):-{- uncommenting those should generate warnings-deriveMutable ''Bool-deriveMutable ''Maybe-deriveMutable ''Either--}--data Set a = Set [a] deriving (Show,Eq,Ord)--instance (Ord a, Listable a) => Listable (Set a) where- tiers = setCons Set--deriveMutableE [''Ord] ''Set--main :: IO ()-main =- case elemIndices False (tests 100) of- [] -> putStrLn "Tests passed!"- is -> do putStrLn ("Failed tests:" ++ show is)- exitFailure--type Id a = a -> a--tests n =- [ True- , allUnique $ concat $ showNewMutants1 (id :: Id D0) 7- , allUnique $ concat $ showNewMutants1 (id :: Id (D1 UInt2)) 7- , allUnique $ concat $ showNewMutants1 (id :: Id (D2 UInt2 UInt2)) 7- , allUnique $ concat $ showNewMutants1 (id :: Id (D3 UInt2 UInt2 UInt2)) 7- , allUnique $ concat $ showNewMutants1 (id :: Id (C1 UInt2)) 7- , allUnique $ concat $ showNewMutants1 (id :: Id (C2 UInt2 UInt2)) 7- , allUnique $ concat $ showNewMutants1 (id :: Id (I UInt2 UInt2)) 7- , allUnique $ concat $ showNewMutants1 (id :: Id (Set UInt2)) 7- ]--showNewMutants1 :: (ShowMutable a, Mutable a)- => a -> Int -> [[String]]-showNewMutants1 f n = mapT (showMutantAsTuple [] f)- $ take n- $ mutiers f--allUnique :: Ord a => [a] -> Bool-allUnique [] = True-allUnique (x:xs) = x `notElem` xs- && allUnique lesser- && allUnique greater- where lesser = filter (< x) xs- greater = filter (> x) xs
− tests/test-mutate.hs
@@ -1,130 +0,0 @@--- Copyright (c) 2015-2017 Rudy Matela.--- Distributed under the 3-Clause BSD licence (see the file LICENSE).-import System.Exit (exitFailure)-import Data.List (elemIndices, sort)-import Data.Tuple (swap)--import Test.FitSpec-import Test.FitSpec.Utils (contained)-import Test.LeanCheck.Error (errorToNothing, errorToFalse)--import Data.Monoid ((<>))-import Data.Word (Word) -- for GHC <= 7.10--polyAppend :: [a] -> [b] -> [Either a b]-polyAppend xs ys = map Left xs ++ map Right ys--main :: IO ()-main =- case elemIndices False tests of- [] -> putStrLn "Tests passed!"- is -> do putStrLn ("Failed tests:" ++ show is)- exitFailure--tests = map errorToFalse- [ True-- , allUnique $ concat $ showNewMutants1 (sort :: [Int] -> [Int]) 7- , allUnique $ concat $ showNewMutants2 ((++) :: [Int] -> [Int] -> [Int]) 7-- , allUnique $ concat $ showNewMutants1 (swap :: (Int,Int) -> (Int,Int)) 7- , allUnique $ concat $ showNewMutants1 (swap :: (Bool,Bool) -> (Bool,Bool)) 7-- , allUnique $ concat $ showNewMutants2 ((,) :: Int -> Bool -> (Int,Bool)) 7- , allUnique $ concat $ showNewMutants2 ((,) :: Bool -> Int -> (Bool,Int)) 7-- , allUnique $ concat $ showNewMutants2 (polyAppend :: [String] -> [Int] -> [Either String Int]) 7- , allUnique $ concat $ showNewMutants2 ((+) :: Float -> Float -> Float) 7- , allUnique $ concat $ showNewMutants2 ((+) :: Double -> Double -> Double) 7- , allUnique $ concat $ showNewMutants2 ((<>) :: Ordering -> Ordering -> Ordering) 7- , allUnique $ concat $ showNewMutants2 ((+) :: Word -> Word -> Word) 7-- {-- , checkBindingsOfLength 7 2 ((,) :: Bool -> Bool -> (Bool,Bool))- , checkBindingsOfLength 7 2 ((,) :: Int -> Int -> (Int,Int))- , checkBindingsOfLength 7 1 (swap :: (Bool,Bool) -> (Bool,Bool))- , checkBindingsOfLength 4 1 (swap :: (Bool,Bool) -> (Bool,Bool),sort :: [Int] -> [Int])- -}-- , holds 25 (uniqueMutants 100 :: [Bool] -> Bool)- , holds 25 (mutantsInListing 100 :: [Bool] -> Bool)- , holds 25 (listingInMutants 100 :: [Bool] -> Bool)- , holds 25 (uniqueMutants 100 :: [Int] -> Bool)- , holds 25 (mutantsInListing 100 :: [Int] -> Bool)- , holds 25 (listingInMutants 100 :: [Int] -> Bool)- , holds 25 (uniqueMutants 100 :: [()] -> Bool)- , holds 25 (mutantsInListing 100 :: [()] -> Bool)- , holds 25 (listingInMutants 100 :: [()] -> Bool)- , holds 25 (uniqueMutants 100 :: Bool -> Bool)- , holds 25 (mutantsInListing 100 :: Bool -> Bool)- , holds 25 (listingInMutants 100 :: Bool -> Bool)- , holds 25 (uniqueMutants 100 :: Int -> Bool)- , holds 25 (mutantsInListing 100 :: Int -> Bool)- , holds 25 (listingInMutants 100 :: Int -> Bool)- , holds 25 (uniqueMutants 100 :: () -> Bool)- , holds 25 (mutantsInListing 100 :: () -> Bool)- , holds 25 (listingInMutants 100 :: () -> Bool)- ]---uniqueMutants :: (Ord a, Listable a, Mutable a) => Int -> a -> Bool-uniqueMutants n = allUnique . take n . mutants--mutantsInListing :: (Eq a, Listable a, Mutable a) => Int -> a -> Bool-mutantsInListing n x = take n (mutants x) `contained` list--listingInMutants :: (Eq a, Listable a, Mutable a) => Int -> a -> Bool-listingInMutants n x = take n list `contained` mutants x---{- does not work as for the new interface for mutantS-checkBindingsOfLength :: (Mutable a, ShowMutable a)- => Int -> Int -> a -> Bool-checkBindingsOfLength n len f = (all . all) (bindingsOfLength len)- . concat- . take n- . mapT (mutantS f)- $ mutiers f--}---bindingsOfLength :: Int -> [([String],String)] -> Bool-bindingsOfLength n = all ((== n) . length . fst)---showNewMutants1 :: (ShowMutable a, Mutable a)- => a -> Int -> [[String]]-showNewMutants1 f n = mapT (showMutantAsTuple [] f)- $ take n- $ mutiers f--showNewMutants2 :: ( Eq a, Eq b, Eq c- , Show a, Show b, Show c- , Listable a, Listable b, Mutable c- , ShowMutable c )- => (a -> b -> c) -> Int -> [[String]]-showNewMutants2 f n = mapT (showMutantAsTuple [] uf . uncurry)- $ take n- $ mutiers f- where uf = uncurry f--canonicalMutation :: Eq b => (a -> b) -> [(a, b)] -> Bool--- This simple version on the line below--- is one that does not deal with partially undefined functions.--- canonicalMutation f = all (\(a,r) -> f a /= r)-canonicalMutation f = all different- where- -- the errorToNothing here deals partial functions (error/undefined)- -- We define that mutating undefined values is noncanonical- different (a,r) = case errorToNothing $ f a of- Just r' -> r' /= r- Nothing -> False -- for our purposes,- -- undefined is equal to anything--allUnique :: Ord a => [a] -> Bool-allUnique [] = True-allUnique (x:xs) = x `notElem` xs- && allUnique lesser- && allUnique greater- where lesser = filter (< x) xs- greater = filter (> x) xs
− tests/test-sdist
@@ -1,28 +0,0 @@-#!/bin/bash-#-# test-sdist: tests the package generated by "cabal sdist".-#-# Copyright (c) 2015-2018 Rudy Matela.-# Distributed under the 3-Clause BSD licence.-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 &&-if [ -d ../.git ]-then- # on git repo, test if files are the same- git -C .. ls-files | sort > ls-git &&- tar -tf $pkg.tar.gz | grep -v "/$" | sed -e "s,$pkg/,," | sort > ls-cabal &&- diff -rud ls-git ls-cabal &&- rm -f ls-git ls-cabal-else- # outside of git repo, test build- rm -rf $pkg/ &&- tar -xzf $pkg.tar.gz &&- cd $pkg/ &&- cabal configure --enable-tests --enable-benchmarks &&- cabal build &&- cabal test-fi
− tests/test-showmutable.hs
@@ -1,253 +0,0 @@--- Copyright (c) 2015-2017 Rudy Matela.--- Distributed under the 3-Clause BSD licence (see the file LICENSE).-{-# LANGUAGE NoMonomorphismRestriction #-}-import System.Exit (exitFailure)-import System.Environment (getArgs)-import Data.List (elemIndices, sort)-import Data.Tuple (swap)--import Test.FitSpec-import Test.FitSpec.ShowMutable-import Test.FitSpec.PrettyPrint-import Test.LeanCheck.Error (errorToNothing)-import Test.LeanCheck.Utils.TypeBinding--main :: IO ()-main = do- as <- System.Environment.getArgs- let n = case as of [] -> 10- (s:_) -> read s- -- n == 10 -- 1s on zero- -- n == 32 -- 4s on zero- -- n == 100 -- 15s on zero- -- n == 200 -- 30s on zero- case elemIndices False (tests n) of- [] -> putStrLn "Tests passed!"- is -> do putStrLn ("Failed tests:" ++ show is)- exitFailure---- Below, some of the tests are marked as failing:--- They simply fail because there are too many values--- being tested (the showMutant function only approximates--- the printing of a mutant)--- There is a TODO in the other file related to this--- to allow configuration of how many values should be--- tried when enumerating the mutants.-tests n =- [ True-- , holds n $ prop_0 -:> int- , holds n $ prop_0 -:> bool- , holds n $ prop_0 -:> char- , holds n $ prop_0 -:> string- , fails n $ prop_0 -:> (int,int)-- , holds n $ prop_00 -:> (int,int)- , holds n $ prop_00 -:> (bool,int)- , holds n $ prop_00 -:> (int,bool)- , holds n $ prop_00 -:> (string,char)- , holds n $ prop_00 -:> (char,string)-- , h1 $ id -:> int- , h1 $ id -:> bool- , h1 $ id -:> (int,int)- , h1 $ id -:> (bool,int)- , h1 $ id -:> (int,bool)- , h1 $ id -:> (bool,bool)- , h1 $ id -:> (int,int,int)- , h1 $ id -:> (int,(int,int))- , h1 $ id -:> ((int,int),int)- , h1 $ const True -:> int -- fails (500 tests)!- , h1 $ const (0::Int) -:> bool- , h1 $ swap -:> (int,bool)- , h1 $ swap -:> (bool,int)- , h1 $ swap -:> (int,(int,int))- , h1 $ swap -:> ((int,int),int)-- , h2 $ const -: int >- int >- und- , h2 $ const -: int >- bool >- und- , h2 $ const -: bool >- int >- und -- fails (1000 tests)!- , h2 $ (+) -:> int- , hI $ (+) -:> int- , h2 $ (*) -:> int- , h2 $ (&&)- , h2 $ (||)- , h2 $ (:) -:> int -- fails (2000 tests)!- , h2 $ (++) -:> [int] -- fails (3000 tests)!-- , h11 (id -:> int) (id ->: bool)- , h11 (id -:> bool) (id ->: int)- , h11 (swap -:> ((int,int),int)) (swap ->: (int,(int,int)))-- , h111 (id -:> int) (id ->: bool) (id ->: char)- , h111 (id -:> bool) (id ->: char) (id ->: int)- , h111 (swap -:> ((int,int),(int,int)))- (swap -:> ((int,int),int))- (swap -:> (int,(int,int)))-- , h11' (id -:> int) (id ->: bool) (id ->: char)- , h11' (id -:> bool) (id ->: char) (id ->: int)- , h11' (swap -:> ((int,int),(int,int)))- (swap -:> ((int,int),int))- (swap -:> (int,(int,int)))- ]- where h1 = holds n . prop_1- h2 = holds n . prop_2- hI = holds n . prop_I- h11 f = holds n . prop_11 f- h111 f g = holds n . prop_111 f g- h11' f g = holds n . prop_11' f g---- prop_N, asserts the format of a mutation of a value of N arguments--- prop_MN, asserts the format of a pair of values of M and N arguments--- prop_MNO, asserts the format of a triple of values--prop_0 :: (Eq a, Show a, Listable a, ShowMutable a)- => a -> a -> Bool-prop_0 x x' | x == x' = s == "x"- | otherwise = s == show x'- where s = showMutantAsTuple ["x"] x x'--prop_00 :: ( Eq a, Show a, Listable a, ShowMutable a- , Eq b, Show b, Listable b, ShowMutable b )- => (a,b) -> (a,b) -> Bool-prop_00 (x,y) (x',y') | x == x' && y == y' = s == "(x,y)"- | x == x' = s == "(x," ++ show y' ++ ")"- | y == y' = s == "(" ++ show x' ++ ",y)"- | otherwise = s == "(" ++ show x'- ++ "," ++ show y' ++ ")"- where s = showMutantAsTuple ["x","y"] (x,y) (x',y')--prop_1 :: ( Eq a, Show a, Listable a, ShowMutable a- , Eq b, Show b, Listable b, ShowMutable b )- => (a->b) -> a -> b -> Bool-prop_1 f x fx = fx /= f x- ==> showMutantAsTuple ["f x"] f (mutate f x fx) == showMutantF "f" x fx- && showMutantDefinition ["f x"] f (mutate f x fx) == showMutantB "f" x fx--prop_11 :: ( Eq a, Show a, Listable a, ShowMutable a- , Eq b, Show b, Listable b, ShowMutable b- , Eq c, Show c, Listable c, ShowMutable c- , Eq d, Show d, Listable d, ShowMutable d )- => (a->b) -> (c->d) -> a -> b -> c -> d -> Bool-prop_11 f g x fx y gy = fx /= f x && gy /= g y- ==> showMutantAsTuple ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)- == showTuple [showMutantF "f" x fx, showMutantF "g" y gy]- && showMutantDefinition ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)- == concat [showMutantB "f" x fx, showMutantB "g" y gy]--prop_111 :: ( Eq a, Show a, Listable a, ShowMutable a- , Eq b, Show b, Listable b, ShowMutable b- , Eq c, Show c, Listable c, ShowMutable c- , Eq d, Show d, Listable d, ShowMutable d- , Eq e, Show e, Listable e, ShowMutable e- , Eq f, Show f, Listable f, ShowMutable f )- => (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool-prop_111 f g h x fx y gy z hz = fx /= f x- && gy /= g y- && hz /= h z- ==> showMutantAsTuple ["f x","g x","h x"] (f,g,h)- ( mutate f x fx- , mutate g y gy- , mutate h z hz )- == showTuple [ showMutantF "f" x fx- , showMutantF "g" y gy- , showMutantF "h" z hz ]- && showMutantDefinition ["f x","g x","h x"] (f,g,h)- ( mutate f x fx- , mutate g y gy- , mutate h z hz )- == concat [ showMutantB "f" x fx- , showMutantB "g" y gy- , showMutantB "h" z hz ]--prop_11' :: ( Eq a, Show a, Listable a, ShowMutable a- , Eq b, Show b, Listable b, ShowMutable b- , Eq c, Show c, Listable c, ShowMutable c- , Eq d, Show d, Listable d, ShowMutable d- , Eq e, Show e, Listable e, ShowMutable e- , Eq f, Show f, Listable f, ShowMutable f )- => (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool-prop_11' f g h x fx y gy z hz = fx /= f x- && gy /= g y- && hz /= h z- ==> showMutantAsTuple ["f x","g x","h x"] (f,(g,h))- ( mutate f x fx- , ( mutate g y gy- , mutate h z hz ) )- == showTuple [ showMutantF "f" x fx- , showTuple [ showMutantF "(??)" y gy- , showMutantF "(??)" z hz ] ]- && showMutantDefinition ["f x","g x","h x"] (f,(g,h))- ( mutate f x fx- , ( mutate g y gy- , mutate h z hz ) )- == concat [ showMutantB "f" x fx- , "g' = "- `beside` showTuple [ showMutantF "(??)" y gy- , showMutantF "(??)" z hz ] ]--prop_2 :: ( Eq a, Show a, Listable a, ShowMutable a- , Eq b, Show b, Listable b, ShowMutable b- , Eq c, Show c, Listable c, ShowMutable c )- => (a->b->c) -> a -> b -> c -> Bool-prop_2 f x y fxy = fxy /= f x y ==>- showMutantAsTuple ["f x y"] f (mutate2 f x y fxy) == showMutantF2 "f" x y fxy &&- showMutantDefinition ["f x y"] f (mutate2 f x y fxy) == showMutantB2 "f" x y fxy---prop_I :: ( Eq a, Show a, Listable a, ShowMutable a- , Eq b, Show b, Listable b, ShowMutable b- , Eq c, Show c, Listable c, ShowMutable c )- => (a->b->c) -> a -> b -> c -> Bool-prop_I f x y fxy = fxy /= f x y ==>- showMutantAsTuple ["x + y"] f (mutate2 f x y fxy) == showMutantI "+" x y fxy &&- showMutantDefinition ["x + y"] f (mutate2 f x y fxy) == showMutantBI "+" x y fxy--mutate :: Eq a => (a -> b) -> a -> b -> (a -> b)-mutate f x y x' | x' == x = y- | otherwise = f x'--mutate2 :: (Eq a, Eq b) => (a -> b -> c) -> a -> b -> c -> (a -> b -> c)-mutate2 f x y z = curry (mutate (uncurry f) (x,y) z)---- | Show a mutant of a function of one argument-showMutantF :: (Show a, Show b)- => String -> a -> b -> String-showMutantF f x y = "\\x -> case x of\n"- ++ " " ++ show x ++ " -> " ++ show y ++ "\n"- ++ " _ -> " ++ f ++ " x\n"---- | Show a mutant of a function of two arguments-showMutantF2 :: (Show a, Show b, Show c)- => String -> a -> b -> c -> String-showMutantF2 f x y z = "\\x y -> case (x,y) of\n"- ++ " (" ++ show x ++ "," ++ show y ++ ") -> "- ++ show z ++ "\n"- ++ " _ -> " ++ f ++ " x y\n"--showMutantB :: (Show a, Show b)- => String -> a -> b -> String-showMutantB f x fx = table " "- [ [f ++ "'", show x, "=", show fx]- , [f ++ "'", "x", "=", f ++ " x"] ]--showMutantB2 :: (Show a, Show b, Show c)- => String -> a -> b -> c -> String-showMutantB2 f x y fxy = table " "- [ [f ++ "'", show x, show y, "=", show fxy]- , [f ++ "'", "x", "y", "=", f ++ " x y"] ]---- | Show a mutant of an infix-showMutantI :: (Show a, Show b, Show c)- => String -> a -> b -> c -> String-showMutantI o x y z = "\\x y -> case (x,y) of\n"- ++ " (" ++ show x ++ "," ++ show y ++ ") -> "- ++ show z ++ "\n"- ++ " _ -> x " ++ o ++ " y\n"--showMutantBI :: (Show a, Show b, Show c)- => String -> a -> b -> c -> String-showMutantBI o x y fxy = table " "- [ [show x, o ++ "-", show y, "=", show fxy]- , ["x", o ++ "-", "y", "=", "x " ++ o ++ " y"] ]
− tests/test-utils.hs
@@ -1,29 +0,0 @@--- Copyright (c) 2015-2017 Rudy Matela.--- Distributed under the 3-Clause BSD licence (see the file LICENSE).-import System.Exit (exitFailure)-import Data.List (elemIndices,sortBy)--import Data.Function--import Test.LeanCheck-import Test.FitSpec.Utils--main :: IO ()-main =- case elemIndices False (tests 500) of- [] -> putStrLn "Tests passed!"- is -> do putStrLn ("Failed tests:" ++ show is)- exitFailure--tests :: Int -> [Bool]-tests n =- [ True-- , sortOn snd [(1,3),(2,2),(3,1)] == [(3,1),(2,2),(1,3)]- , holds n $ (propSortOn fst :: [(Int,Int)] -> Bool)- , holds n $ (propSortOn snd :: [(Int,Int)] -> Bool)- , holds n $ (propSortOn abs :: [Int] -> Bool)- ]--propSortOn :: (Eq a, Ord b) => (a -> b) -> [a] -> Bool-propSortOn f xs = sortOn f xs == sortBy (compare `on` f) xs