git.iko.soy/text
on master help sign in
Silly unit tests for stdio actions - top-level hpc coverage up to 91%

--HG-- extra : convert_revision : 61dd744ac0a4c74b3b2949bb04871c0be0556bf9

commit3dc8449045cc624727d6abb2cff316c8d8f299d5 authorBryan O'Sullivan <bos@serpentine.com> dateSun 29 Aug 2010, 17:51 (16 years ago) parentbbdc907
4 files changed+103−9
compare with master
unifiedsplit
tests/Makefile+20−9 tests/Properties.hs+1 tests/StdioCoverage.hs+25 tests/cover-stdio.sh+57
tests/Makefile+20−9
@@ -49,19 +49,30 @@ qc-hpc: Properties.hs QuickCheckUtils.hs SlowFunctions.hs TestUtils.hs $(lib-src
4949 $(ghc) $(ghc-hpc-flags) $(ghc-test-flags) $(ghc-opt-flags) -ihpcdir \
5050 --make -threaded -o $@ $<
5151
52−Regressions.o: TestUtils.o
53−
54−regressions: Regressions.o TestUtils.o
55− $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
52+stdio-hpc: StdioCoverage.hs $(lib-srcs:%=../%)
53+ -mkdir -p hpcdir
54+ @rm -f $@.tix
55+ $(ghc) $(ghc-hpc-flags) $(ghc-test-flags) $(ghc-opt-flags) -ihpcdir \
56+ --make -threaded -o $@ $<
5657
57−coverage: qc-hpc-html/hpc_index.html
58+coverage: coverage-html/hpc_index.html
5859
59−qc-hpc-html/hpc_index.html: qc-hpc
60+coverage-html/hpc_index.html: qc-hpc
61+ @rm -f qc-hpc.tix stdio-hpc.tix coverage.tix
6062 ./qc-hpc -a 100 +RTS -N
61− hpc markup qc-hpc --exclude=Main --exclude=Properties \
62− --exclude=Data.Text.Fusion.CaseMapping \
63+ bash ./cover-stdio.sh
64+ hpc combine --output=coverage.tix --exclude=Main \
65+ qc-hpc.tix stdio-hpc.tix
66+ hpc markup coverage --exclude=Main --exclude=Properties --exclude=Main \
67+ --exclude=Data.Text.Fusion.CaseMapping --exclude StdioCoverage \
6368 --exclude=SlowFunctions --exclude=TestUtils \
6469 --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)
70+ @echo xdg-open $@
71+
72+Regressions.o: TestUtils.o
73+
74+regressions: Regressions.o TestUtils.o
75+ $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)
6576
6677Benchmarks.o: ghc-opt-flags = -O
6778bm Benchmarks.o: ghc-flags += -package utf8-string
@@ -83,4 +94,4 @@ text-testdata.tar.bz2:
8394 curl -O http://projects.haskell.org/text/text-testdata.tar.bz2
8495
8596clean:
86− -rm -rf *.o *.hi *.tix bm qc qc-hpc hpcdir .hpc qc-hpc-html
97+ -rm -rf *.o *.hi *.tix bm qc qc-hpc stdio-hpc hpcdir .hpc coverage-html
tests/Properties.hs+1
@@ -18,6 +18,7 @@ import qualified Data.Text as T
1818import qualified Data.Text.IO as T
1919import qualified Data.Text.Lazy as TL
2020import qualified Data.Text.Lazy.IO as TL
21+import qualified Data.Text.Lazy.Internal as TL
2122import qualified Data.Text.Lazy.Builder as TB
2223import qualified Data.Text.Encoding as E
2324import Data.Text.Encoding.Error
tests/StdioCoverage.hsnew file+25
@@ -0,0 +1,25 @@
1+import qualified Data.Text as T
2+import qualified Data.Text.IO as T
3+import qualified Data.Text.Lazy as TL
4+import qualified Data.Text.Lazy.IO as TL
5+import System.Environment (getArgs)
6+import System.Exit (exitFailure)
7+import System.IO (hPutStrLn, stderr)
8+
9+main = do
10+ args <- getArgs
11+ case args of
12+ ["T.readFile", name] -> T.putStr =<< T.readFile name
13+ ["T.writeFile", name, t] -> T.writeFile name (T.pack t)
14+ ["T.appendFile", name, t] -> T.appendFile name (T.pack t)
15+ ["T.interact"] -> T.interact id
16+ ["T.getContents"] -> T.putStr =<< T.getContents
17+ ["T.getLine"] -> T.putStrLn =<< T.getLine
18+
19+ ["TL.readFile", name] -> TL.putStr =<< TL.readFile name
20+ ["TL.writeFile", name, t] -> TL.writeFile name (TL.pack t)
21+ ["TL.appendFile", name, t] -> TL.appendFile name (TL.pack t)
22+ ["TL.interact"] -> TL.interact id
23+ ["TL.getContents"] -> TL.putStr =<< TL.getContents
24+ ["TL.getLine"] -> TL.putStrLn =<< TL.getLine
25+ _ -> hPutStrLn stderr "invalid directive!" >> exitFailure
tests/cover-stdio.shnew file+57
@@ -0,0 +1,57 @@
1+#!/bin/bash
2+
3+exe=./stdio-hpc
4+
5+rm -f $exe.tix
6+
7+f=$(mktemp stdio-f.XXXXXX)
8+g=$(mktemp stdio-g.XXXXXX)
9+
10+for t in T TL; do
11+ echo $t.readFile > $f
12+ $exe $t.readFile $f > $g
13+ if ! diff -u $f $g; then
14+ errs=$((errs+1))
15+ echo FAIL: $t.readFile 1>&2
16+ fi
17+
18+ $exe $t.writeFile $f $t.writeFile
19+ echo -n $t.writeFile > $g
20+ if ! diff -u $f $g; then
21+ errs=$((errs+1))
22+ echo FAIL: $t.writeFile 1>&2
23+ fi
24+
25+ echo -n quux > $f
26+ $exe $t.appendFile $f $t.appendFile
27+ echo -n quux$t.appendFile > $g
28+ if ! diff -u $f $g; then
29+ errs=$((errs+1))
30+ echo FAIL: $t.appendFile 1>&2
31+ fi
32+
33+ echo $t.interact | $exe $t.interact > $f
34+ echo $t.interact > $g
35+ if ! diff -u $f $g; then
36+ errs=$((errs+1))
37+ echo FAIL: $t.interact 1>&2
38+ fi
39+
40+ echo $t.getContents | $exe $t.getContents > $f
41+ echo $t.getContents > $g
42+ if ! diff -u $f $g; then
43+ errs=$((errs+1))
44+ echo FAIL: $t.getContents 1>&2
45+ fi
46+
47+ echo $t.getLine | $exe $t.getLine > $f
48+ echo $t.getLine > $g
49+ if ! diff -u $f $g; then
50+ errs=$((errs+1))
51+ echo FAIL: $t.getLine 1>&2
52+ fi
53+done
54+
55+rm -f $f $g
56+
57+exit $errs