diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -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 @@ -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 diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -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 # @@ -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" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/bench/haskell-src-exts.hs b/bench/haskell-src-exts.hs --- a/bench/haskell-src-exts.hs +++ b/bench/haskell-src-exts.hs @@ -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 diff --git a/doc/fitspec.svg b/doc/fitspec.svg new file mode 100644 --- /dev/null +++ b/doc/fitspec.svg @@ -0,0 +1,128 @@ + + + + + FitSpec + + + + + + image/svg+xml + + FitSpec + 2018-11-24 + + + Rudy Matela + + + https://github.com/rudymatela/fitspec + + + FitSpec + logo + testing + test + property-based testing + mutation testing + + + FitSpec's logo. A check or tick is seen in blue intersected with a lambda. + + + + + + + + + + + + + + + + + + + + diff --git a/fitspec.cabal b/fitspec.cabal --- a/fitspec.cabal +++ b/fitspec.cabal @@ -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 diff --git a/mk/depend.mk b/mk/depend.mk --- a/mk/depend.mk +++ b/mk/depend.mk @@ -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 diff --git a/mk/ghcdeps b/mk/ghcdeps --- a/mk/ghcdeps +++ b/mk/ghcdeps @@ -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, diff --git a/mk/haddock-i b/mk/haddock-i --- a/mk/haddock-i +++ b/mk/haddock-i @@ -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 ... @@ -11,14 +11,26 @@ # documentation installed on your system, so you can: # # $ haddock-i base template-haskell | xargs haddock -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 diff --git a/mk/haskell.mk b/mk/haskell.mk --- a/mk/haskell.mk +++ b/mk/haskell.mk @@ -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) diff --git a/mk/install-on b/mk/install-on new file mode 100644 --- /dev/null +++ b/mk/install-on @@ -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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -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 diff --git a/test/derive.hs b/test/derive.hs new file mode 100644 --- /dev/null +++ b/test/derive.hs @@ -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 diff --git a/test/mutate.hs b/test/mutate.hs new file mode 100644 --- /dev/null +++ b/test/mutate.hs @@ -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 diff --git a/test/sdist b/test/sdist new file mode 100644 --- /dev/null +++ b/test/sdist @@ -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 diff --git a/test/showmutable.hs b/test/showmutable.hs new file mode 100644 --- /dev/null +++ b/test/showmutable.hs @@ -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"] ] diff --git a/test/utils.hs b/test/utils.hs new file mode 100644 --- /dev/null +++ b/test/utils.hs @@ -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 diff --git a/tests/test-derive.hs b/tests/test-derive.hs deleted file mode 100644 --- a/tests/test-derive.hs +++ /dev/null @@ -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 diff --git a/tests/test-mutate.hs b/tests/test-mutate.hs deleted file mode 100644 --- a/tests/test-mutate.hs +++ /dev/null @@ -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 diff --git a/tests/test-sdist b/tests/test-sdist deleted file mode 100644 --- a/tests/test-sdist +++ /dev/null @@ -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 diff --git a/tests/test-showmutable.hs b/tests/test-showmutable.hs deleted file mode 100644 --- a/tests/test-showmutable.hs +++ /dev/null @@ -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"] ] diff --git a/tests/test-utils.hs b/tests/test-utils.hs deleted file mode 100644 --- a/tests/test-utils.hs +++ /dev/null @@ -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