summaryrefslogtreecommitdiff
path: root/testsuite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests')
-rw-r--r--testsuite/tests/arrows/should_fail/T5380.stderr4
-rw-r--r--testsuite/tests/concurrent/should_run/5866.hs10
-rw-r--r--testsuite/tests/concurrent/should_run/5866.stderr1
-rw-r--r--testsuite/tests/concurrent/should_run/all.T1
-rw-r--r--testsuite/tests/dph/diophantine/dph-diophantine.T1
-rw-r--r--testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout100
-rw-r--r--testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout100
-rw-r--r--testsuite/tests/dph/nbody/dph-nbody.T43
-rw-r--r--testsuite/tests/driver/437/437.stdout8
-rw-r--r--testsuite/tests/driver/437/Makefile8
-rw-r--r--testsuite/tests/driver/recomp005/recomp005.stdout4
-rw-r--r--testsuite/tests/driver/recomp006/recomp006.stdout2
-rw-r--r--testsuite/tests/driver/recomp007/recomp007.stdout4
-rw-r--r--testsuite/tests/driver/recomp011/recomp011.stdout4
-rw-r--r--testsuite/tests/ffi/should_fail/all.T2
-rw-r--r--testsuite/tests/ffi/should_fail/capi_value_function.hs9
-rw-r--r--testsuite/tests/ffi/should_fail/capi_value_function.stderr6
-rw-r--r--testsuite/tests/ffi/should_fail/ccall_value.hs12
-rw-r--r--testsuite/tests/ffi/should_fail/ccall_value.stderr2
-rw-r--r--testsuite/tests/ffi/should_fail/ccall_value_c.h3
-rw-r--r--testsuite/tests/ffi/should_fail/ccfail004.stderr11
-rw-r--r--testsuite/tests/ffi/should_run/Capi_Ctype_001.hsc46
-rw-r--r--testsuite/tests/ffi/should_run/Capi_Ctype_001.stdout2
-rw-r--r--testsuite/tests/ffi/should_run/Capi_Ctype_002.hs19
-rw-r--r--testsuite/tests/ffi/should_run/Capi_Ctype_002.stdout1
-rw-r--r--testsuite/tests/ffi/should_run/Capi_Ctype_A_001.hsc27
-rw-r--r--testsuite/tests/ffi/should_run/Capi_Ctype_A_002.hsc28
-rw-r--r--testsuite/tests/ffi/should_run/Makefile18
-rw-r--r--testsuite/tests/ffi/should_run/all.T24
-rw-r--r--testsuite/tests/ffi/should_run/capi_ctype_001.h16
-rw-r--r--testsuite/tests/ffi/should_run/capi_ctype_001_c.c7
-rw-r--r--testsuite/tests/ffi/should_run/capi_ctype_002_A.h12
-rw-r--r--testsuite/tests/ffi/should_run/capi_ctype_002_B.h8
-rw-r--r--testsuite/tests/ffi/should_run/capi_value.hs14
-rw-r--r--testsuite/tests/ffi/should_run/capi_value.stdout2
-rw-r--r--testsuite/tests/ffi/should_run/capi_value_c.c4
-rw-r--r--testsuite/tests/ffi/should_run/capi_value_c.h3
-rw-r--r--testsuite/tests/ffi/should_run/ffi_parsing_001.hs8
-rw-r--r--testsuite/tests/ffi/should_run/ffi_parsing_001.stdout1
-rw-r--r--testsuite/tests/ffi/should_run/ffi_parsing_001_c.c8
-rw-r--r--testsuite/tests/gadt/rw.stderr4
-rw-r--r--testsuite/tests/ghc-api/apirecomp001/myghc.hs2
-rw-r--r--testsuite/tests/ghci.debugger/scripts/break007.stdout2
-rw-r--r--testsuite/tests/ghci/scripts/Defer02.stderr4
-rw-r--r--testsuite/tests/ghci/scripts/Defer02.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/Makefile9
-rw-r--r--testsuite/tests/ghci/scripts/T5820.hs3
-rw-r--r--testsuite/tests/ghci/scripts/T5820.script4
-rw-r--r--testsuite/tests/ghci/scripts/T5820.stdout4
-rw-r--r--testsuite/tests/ghci/scripts/T5836.script1
-rw-r--r--testsuite/tests/ghci/scripts/T5836.stderr4
-rwxr-xr-xtestsuite/tests/ghci/scripts/all.T6
-rw-r--r--testsuite/tests/ghci/scripts/ghci024.stdout25
-rw-r--r--testsuite/tests/ghci/scripts/ghci057.hs4
-rw-r--r--testsuite/tests/ghci/scripts/ghci057.script27
-rw-r--r--testsuite/tests/ghci/scripts/ghci057.stderr17
-rw-r--r--testsuite/tests/ghci/scripts/ghci057.stdout53
-rw-r--r--testsuite/tests/indexed-types/should_compile/Simple14.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_compile/T3017.stderr1
-rw-r--r--testsuite/tests/indexed-types/should_compile/T3208b.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_compile/all.T2
-rw-r--r--testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr8
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr8
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr12
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr5
-rw-r--r--testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs2
-rw-r--r--testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr11
-rw-r--r--testsuite/tests/indexed-types/should_fail/T1900.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_fail/T2334.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T2677.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T3330a.stderr44
-rw-r--r--testsuite/tests/indexed-types/should_fail/T3330c.stderr18
-rw-r--r--testsuite/tests/indexed-types/should_fail/T3440.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4093a.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4093b.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4179.stderr2
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4246.stderr4
-rw-r--r--testsuite/tests/indexed-types/should_fail/T4272.stderr4
-rw-r--r--testsuite/tests/lib/Data.ByteString/Makefile3
-rw-r--r--testsuite/tests/lib/Data.ByteString/all.T18
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring001.hs948
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring001.stdout185
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring002.hs6
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring002.stdin1000
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring002.stdout1
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring003.hs36
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring003.stdin1000
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring003.stdout1
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring004.hs564
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring004.stdout45
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring005.hs1138
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring005.stdout226
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring006.hs10
-rw-r--r--testsuite/tests/lib/Data.ByteString/bytestring006.stdout2
-rw-r--r--testsuite/tests/lib/OldException/OldException001.hs22
-rw-r--r--testsuite/tests/lib/OldException/OldException001.stdout2
-rw-r--r--testsuite/tests/lib/OldException/all.T3
-rw-r--r--testsuite/tests/lib/PrettyPrint/Makefile3
-rw-r--r--testsuite/tests/lib/PrettyPrint/T3911.hs23
-rw-r--r--testsuite/tests/lib/PrettyPrint/T3911.stdout4
-rw-r--r--testsuite/tests/lib/PrettyPrint/all.T2
-rw-r--r--testsuite/tests/lib/PrettyPrint/pp1.hs18
-rw-r--r--testsuite/tests/lib/PrettyPrint/pp1.stdout4
-rw-r--r--testsuite/tests/lib/Regex/Makefile3
-rw-r--r--testsuite/tests/lib/Regex/all.T3
-rw-r--r--testsuite/tests/lib/Regex/regex001.hs11
-rw-r--r--testsuite/tests/lib/Regex/regex002.hs13
-rw-r--r--testsuite/tests/lib/Regex/regex002.stdout3
-rw-r--r--testsuite/tests/lib/Regex/regex003.hs43
-rw-r--r--testsuite/tests/lib/Regex/regex003.stdout8
-rw-r--r--testsuite/tests/lib/Text.Printf/1548.hs11
-rw-r--r--testsuite/tests/lib/Text.Printf/1548.stdout3
-rw-r--r--testsuite/tests/lib/Text.Printf/Makefile3
-rw-r--r--testsuite/tests/lib/Text.Printf/all.T1
-rw-r--r--testsuite/tests/lib/Time/Makefile3
-rw-r--r--testsuite/tests/lib/Time/T5430.hs14
-rw-r--r--testsuite/tests/lib/Time/T5430.stdout1
-rw-r--r--testsuite/tests/lib/Time/all.T4
-rw-r--r--testsuite/tests/lib/Time/time002.hs16
-rw-r--r--testsuite/tests/lib/Time/time002.stdout1
-rw-r--r--testsuite/tests/lib/Time/time003.hs24
-rw-r--r--testsuite/tests/lib/Time/time003.stdout2
-rw-r--r--testsuite/tests/lib/Time/time004.hs10
-rw-r--r--testsuite/tests/lib/Time/time004.stdout1
-rw-r--r--testsuite/tests/lib/exceptions/Makefile3
-rw-r--r--testsuite/tests/lib/exceptions/all.T1
-rw-r--r--testsuite/tests/lib/exceptions/exceptions001.hs7
-rw-r--r--testsuite/tests/lib/libposix/posix003.hs2
-rw-r--r--testsuite/tests/lib/libposix/posix003.stdout2
-rw-r--r--testsuite/tests/lib/should_run/all.T1
-rw-r--r--testsuite/tests/lib/should_run/array001.hs34
-rw-r--r--testsuite/tests/lib/should_run/array001.stdout2
-rw-r--r--testsuite/tests/lib/should_run/exceptionsrun001.hs47
-rw-r--r--testsuite/tests/lib/should_run/exceptionsrun001.stdout5
-rw-r--r--testsuite/tests/lib/should_run/exceptionsrun002.hs145
-rw-r--r--testsuite/tests/module/T1074.stderr8
-rw-r--r--testsuite/tests/module/mod45.stderr12
-rw-r--r--testsuite/tests/numeric/should_run/add2.hs26
-rw-r--r--testsuite/tests/numeric/should_run/add2.stdout15
-rw-r--r--testsuite/tests/numeric/should_run/add2.stdout-ws-3215
-rw-r--r--testsuite/tests/numeric/should_run/all.T4
-rw-r--r--testsuite/tests/numeric/should_run/mul2.hs26
-rw-r--r--testsuite/tests/numeric/should_run/mul2.stdout15
-rw-r--r--testsuite/tests/numeric/should_run/mul2.stdout-ws-3215
-rw-r--r--testsuite/tests/parser/should_fail/readFail036.stderr5
-rw-r--r--testsuite/tests/perf/compiler/all.T100
-rw-r--r--testsuite/tests/polykinds/Freeman.hs259
-rw-r--r--testsuite/tests/polykinds/Freeman.stdout1
-rw-r--r--testsuite/tests/polykinds/MonoidsFD.hs106
-rw-r--r--testsuite/tests/polykinds/MonoidsFD.stdout8
-rw-r--r--testsuite/tests/polykinds/MonoidsTF.hs116
-rw-r--r--testsuite/tests/polykinds/MonoidsTF.stdout8
-rw-r--r--testsuite/tests/polykinds/PolyKinds02.stderr2
-rw-r--r--testsuite/tests/polykinds/PolyKinds06.stderr8
-rw-r--r--testsuite/tests/polykinds/PolyKinds07.stderr2
-rw-r--r--testsuite/tests/polykinds/PolyKinds12.hs16
-rw-r--r--testsuite/tests/polykinds/PolyKinds13.hs3
-rw-r--r--testsuite/tests/polykinds/T5717.hs20
-rw-r--r--testsuite/tests/polykinds/T5770.hs21
-rw-r--r--testsuite/tests/polykinds/T5771.hs29
-rw-r--r--testsuite/tests/polykinds/T5798.hs8
-rw-r--r--testsuite/tests/polykinds/all.T11
-rw-r--r--testsuite/tests/rename/should_fail/T5211.stderr10
-rw-r--r--testsuite/tests/rename/should_fail/rnfail055.stderr10
-rw-r--r--testsuite/tests/rts/Makefile2
-rw-r--r--testsuite/tests/safeHaskell/check/Check09.hs8
-rw-r--r--testsuite/tests/safeHaskell/check/Check09.stderr3
-rw-r--r--testsuite/tests/safeHaskell/check/Check10.hs8
-rw-r--r--testsuite/tests/safeHaskell/check/all.T7
-rw-r--r--testsuite/tests/safeHaskell/flags/SafeFlags28.hs9
-rw-r--r--testsuite/tests/safeHaskell/flags/SafeFlags28.stderr12
-rw-r--r--testsuite/tests/safeHaskell/flags/SafeFlags29.hs10
-rw-r--r--testsuite/tests/safeHaskell/flags/SafeFlags29.stderr12
-rw-r--r--testsuite/tests/safeHaskell/flags/all.T4
-rw-r--r--testsuite/tests/safeHaskell/ghci/A.hs10
-rw-r--r--testsuite/tests/safeHaskell/ghci/B.hs8
-rw-r--r--testsuite/tests/safeHaskell/ghci/C.hs13
-rw-r--r--testsuite/tests/safeHaskell/ghci/D.hs8
-rw-r--r--testsuite/tests/safeHaskell/ghci/E.hs7
-rw-r--r--testsuite/tests/safeHaskell/ghci/Makefile (renamed from testsuite/tests/lib/OldException/Makefile)0
-rw-r--r--testsuite/tests/safeHaskell/ghci/P13_A.hs9
-rw-r--r--testsuite/tests/safeHaskell/ghci/all.T20
-rw-r--r--testsuite/tests/safeHaskell/ghci/p1.script8
-rw-r--r--testsuite/tests/safeHaskell/ghci/p1.stderr6
-rw-r--r--testsuite/tests/safeHaskell/ghci/p10.script10
-rw-r--r--testsuite/tests/safeHaskell/ghci/p10.stderr2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p10.stdout1
-rw-r--r--testsuite/tests/safeHaskell/ghci/p11.script6
-rw-r--r--testsuite/tests/safeHaskell/ghci/p11.stderr3
-rw-r--r--testsuite/tests/safeHaskell/ghci/p12.script10
-rw-r--r--testsuite/tests/safeHaskell/ghci/p12.stderr3
-rw-r--r--testsuite/tests/safeHaskell/ghci/p12.stdout2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p13.script14
-rw-r--r--testsuite/tests/safeHaskell/ghci/p13.stderr13
-rw-r--r--testsuite/tests/safeHaskell/ghci/p13.stdout0
-rw-r--r--testsuite/tests/safeHaskell/ghci/p14.script10
-rw-r--r--testsuite/tests/safeHaskell/ghci/p14.stderr2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p15.script23
-rw-r--r--testsuite/tests/safeHaskell/ghci/p15.stderr12
-rw-r--r--testsuite/tests/safeHaskell/ghci/p15.stdout2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p16.script22
-rw-r--r--testsuite/tests/safeHaskell/ghci/p16.stderr15
-rw-r--r--testsuite/tests/safeHaskell/ghci/p16.stdout1
-rw-r--r--testsuite/tests/safeHaskell/ghci/p17.script10
-rw-r--r--testsuite/tests/safeHaskell/ghci/p17.stderr3
-rw-r--r--testsuite/tests/safeHaskell/ghci/p2.script10
-rw-r--r--testsuite/tests/safeHaskell/ghci/p2.stderr2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p2.stdout2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p3.script12
-rw-r--r--testsuite/tests/safeHaskell/ghci/p3.stderr6
-rw-r--r--testsuite/tests/safeHaskell/ghci/p3.stdout1
-rw-r--r--testsuite/tests/safeHaskell/ghci/p4.script8
-rw-r--r--testsuite/tests/safeHaskell/ghci/p4.stderr6
-rw-r--r--testsuite/tests/safeHaskell/ghci/p5.script13
-rw-r--r--testsuite/tests/safeHaskell/ghci/p5.stdout7
-rw-r--r--testsuite/tests/safeHaskell/ghci/p6.script13
-rw-r--r--testsuite/tests/safeHaskell/ghci/p6.stderr10
-rw-r--r--testsuite/tests/safeHaskell/ghci/p6.stdout1
-rw-r--r--testsuite/tests/safeHaskell/ghci/p7.script6
-rw-r--r--testsuite/tests/safeHaskell/ghci/p7.stdout2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p8.script6
-rw-r--r--testsuite/tests/safeHaskell/ghci/p8.stdout2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p9.script10
-rw-r--r--testsuite/tests/safeHaskell/ghci/p9.stderr2
-rw-r--r--testsuite/tests/safeHaskell/ghci/p9.stdout1
-rw-r--r--testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs1
-rw-r--r--testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.stderr4
-rw-r--r--testsuite/tests/simplCore/should_compile/rule2.stderr4
-rw-r--r--testsuite/tests/th/Makefile7
-rw-r--r--testsuite/tests/th/T3177a.stderr3
-rw-r--r--testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc9
-rw-r--r--testsuite/tests/typecheck/should_compile/FD1.stderr4
-rw-r--r--testsuite/tests/typecheck/should_compile/FD2.stderr8
-rw-r--r--testsuite/tests/typecheck/should_compile/FD3.stderr2
-rw-r--r--testsuite/tests/typecheck/should_compile/Makefile6
-rw-r--r--testsuite/tests/typecheck/should_compile/T5792.hs10
-rw-r--r--testsuite/tests/typecheck/should_compile/all.T2
-rw-r--r--testsuite/tests/typecheck/should_compile/tc141.stderr43
-rw-r--r--testsuite/tests/typecheck/should_compile/tc231.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/IPFail.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T1899.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T2538.stderr28
-rw-r--r--testsuite/tests/typecheck/should_fail/T2714.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T3468.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/T5300.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail034.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail067.stderr8
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail068.stderr16
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail072.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail097.stderr12
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail101.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail102.stderr36
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail103.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail107.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail127.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail129.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail131.stderr22
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail153.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail162.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail174.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail175.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail179.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail196.stderr10
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail197.stderr5
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail201.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail206.stderr4
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail208.stderr2
-rw-r--r--testsuite/tests/typecheck/should_fail/tcfail209.stderr4
-rw-r--r--testsuite/tests/typecheck/should_run/tcrun041.hs1
276 files changed, 2306 insertions, 5936 deletions
diff --git a/testsuite/tests/arrows/should_fail/T5380.stderr b/testsuite/tests/arrows/should_fail/T5380.stderr
index c9df47cf6f..7249be8f13 100644
--- a/testsuite/tests/arrows/should_fail/T5380.stderr
+++ b/testsuite/tests/arrows/should_fail/T5380.stderr
@@ -4,7 +4,7 @@ T5380.hs:7:27:
`not_bool' is a rigid type variable bound by
the type signature for
testB :: not_bool -> (() -> ()) -> () -> not_unit
- at T5380.hs:7:1
+ at T5380.hs:6:10
In the expression: b
In the expression: proc () -> if b then f -< () else f -< ()
In an equation for `testB':
@@ -15,7 +15,7 @@ T5380.hs:7:34:
`not_unit' is a rigid type variable bound by
the type signature for
testB :: not_bool -> (() -> ()) -> () -> not_unit
- at T5380.hs:7:1
+ at T5380.hs:6:42
Expected type: () -> not_unit
Actual type: () -> ()
In the expression: f
diff --git a/testsuite/tests/concurrent/should_run/5866.hs b/testsuite/tests/concurrent/should_run/5866.hs
new file mode 100644
index 0000000000..4650ea66e9
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/5866.hs
@@ -0,0 +1,10 @@
+import GHC.Conc
+import Control.Exception
+import System.IO.Unsafe
+import System.Timeout
+
+main :: IO ()
+main = do
+ x <- unsafeInterleaveIO $ atomically retry
+ _ <- timeout 500000 $ evaluate x
+ evaluate x
diff --git a/testsuite/tests/concurrent/should_run/5866.stderr b/testsuite/tests/concurrent/should_run/5866.stderr
new file mode 100644
index 0000000000..a4774f25ab
--- /dev/null
+++ b/testsuite/tests/concurrent/should_run/5866.stderr
@@ -0,0 +1 @@
+5866: thread blocked indefinitely in an STM transaction
diff --git a/testsuite/tests/concurrent/should_run/all.T b/testsuite/tests/concurrent/should_run/all.T
index 5c5a914022..375dc6ff1e 100644
--- a/testsuite/tests/concurrent/should_run/all.T
+++ b/testsuite/tests/concurrent/should_run/all.T
@@ -68,6 +68,7 @@ test('5558',
test('5421', normal, compile_and_run, [''])
test('5611', normal, compile_and_run, [''])
test('5238', normal, compile_and_run, [''])
+test('5866', exit_code(1), compile_and_run, [''])
# -----------------------------------------------------------------------------
# These tests we only do for a full run
diff --git a/testsuite/tests/dph/diophantine/dph-diophantine.T b/testsuite/tests/dph/diophantine/dph-diophantine.T
index 34bf0e9ddb..036c594e72 100644
--- a/testsuite/tests/dph/diophantine/dph-diophantine.T
+++ b/testsuite/tests/dph/diophantine/dph-diophantine.T
@@ -1,7 +1,6 @@
test ('dph-diophantine-copy-opt'
, [ alone
- , expect_broken(5817)
, skip_if_fast
, reqlib('dph-lifted-copy')
, reqlib('dph-prim-par')
diff --git a/testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout b/testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout
new file mode 100644
index 0000000000..69fdd8b303
--- /dev/null
+++ b/testsuite/tests/dph/nbody/dph-nbody-copy-fast.stdout
@@ -0,0 +1,100 @@
+ 10.0 -7.88876745 14.40403609 0.07781862 1.41725313 0.00728077 -0.00615418
+ 10.0 -20.39602554 -5.40256368 -1.56824530 0.67893475 0.01493099 0.00782011
+ 10.0 -0.05794753 10.34183386 0.35651327 0.89460951 0.00188899 -0.00356931
+ 10.0 -4.75609397 34.74782948 1.61195437 1.87077953 0.00587195 -0.01975082
+ 10.0 36.25896362 10.82337782 2.14170846 -1.41319743 -0.02163268 -0.00507727
+ 10.0 4.02674361 -9.00872919 0.03617254 -0.88316283 -0.00122400 0.00926493
+ 10.0 42.00406508 -40.85785845 -0.76014767 -3.29738763 -0.02191949 0.02332737
+ 10.0 -22.63186030 5.80994447 -1.07420146 1.51160117 0.01670201 0.00006355
+ 10.0 16.53870540 16.94639077 1.84926442 0.20378411 -0.00879785 -0.00880553
+ 10.0 39.92854878 29.06425991 2.88523318 -1.01552251 -0.02189971 -0.01632925
+ 10.0 -17.45501954 11.39301477 -0.56641470 1.60906365 0.01371008 -0.00396360
+ 10.0 26.25934753 8.00486951 1.85024443 -0.89918952 -0.01562756 -0.00309898
+ 10.0 -9.33900099 9.24549389 -0.36060159 1.12461927 0.00801307 -0.00255620
+ 10.0 -46.47873679 -28.36980232 -2.92763912 1.44708065 0.02528654 0.01949016
+ 10.0 -12.54370842 34.21722863 1.24120256 2.21072951 0.01080973 -0.01869097
+ 10.0 -7.14048930 7.10420057 -0.36081624 0.86670872 0.00647863 -0.00118788
+ 10.0 -49.88492485 -23.33817148 -2.76602163 1.78294227 0.02720067 0.01682362
+ 10.0 -19.81399282 53.52954568 2.07232227 2.65936299 0.01424146 -0.02727658
+ 10.0 23.77418551 14.68227128 2.04725863 -0.41772276 -0.01379116 -0.00752371
+ 10.0 -5.73673778 8.93192786 -0.16259409 0.97138466 0.00562305 -0.00245174
+ 10.0 10.54277542 -1.02674862 0.84834041 -0.44100517 -0.00531874 0.00383461
+ 10.0 23.01197723 21.12299112 2.25990543 -0.12607295 -0.01291140 -0.01176114
+ 10.0 -44.78532667 12.05197921 -1.02696812 2.77848076 0.02808850 -0.00298275
+ 10.0 31.46388060 -49.75461307 -1.52046945 -3.03579919 -0.01637469 0.02786471
+ 10.0 24.84943257 -25.92687211 -0.24060772 -2.45045466 -0.01484349 0.01860299
+ 10.0 25.91948874 -30.60444211 -0.52684367 -2.60005186 -0.01516185 0.02084074
+ 10.0 -10.85946929 20.87407647 0.39902427 1.82589346 0.00972306 -0.01062660
+ 10.0 -38.51435867 1.59076858 -1.56374573 2.10935343 0.02533138 0.00325720
+ 10.0 48.51766969 -21.77175738 0.49039776 -3.14884736 -0.02642908 0.01352300
+ 10.0 5.74566172 46.44110258 2.61301762 1.41963745 -0.00049448 -0.02602402
+ 10.0 -22.88917903 -27.97906439 -2.49898486 -0.03157484 0.01438842 0.02110301
+ 10.0 31.73261776 -6.28614087 1.21728705 -1.94829313 -0.01955786 0.00624200
+ 10.0 4.24232124 19.44671943 1.21964188 1.10199242 -0.00052277 -0.01009959
+ 10.0 0.91334970 48.66777413 2.53737735 1.69247032 0.00244742 -0.02680742
+ 10.0 10.67139892 31.69558668 2.17625638 0.97201541 -0.00424894 -0.01856619
+ 10.0 12.94163719 58.29627746 3.27732262 1.10311871 -0.00411829 -0.03016643
+ 10.0 39.19514702 34.09017661 3.04651632 -0.83806079 -0.02092181 -0.01899392
+ 10.0 -24.13067759 -32.16302812 -2.68262548 -0.04506858 0.01454248 0.02301772
+ 10.0 51.78333979 -13.45956325 1.00920828 -3.03719366 -0.02816357 0.00875884
+ 10.0 -18.73188233 -17.30379387 -1.95701398 -0.00677590 0.01307052 0.01538889
+ 10.0 24.70514705 -49.06503148 -1.67808526 -2.78661149 -0.01337746 0.02867654
+ 10.0 -51.06940692 -15.61458174 -2.46357376 2.08982818 0.02835174 0.01252356
+ 10.0 -4.29154911 -29.69366786 -1.77081329 -1.27717018 0.00330457 0.02241695
+ 10.0 2.11752441 33.61609431 1.87012243 1.50451828 0.00141129 -0.01940596
+ 10.0 37.73902003 -20.32722331 0.42253535 -2.74138534 -0.02210996 0.01412198
+ 10.0 18.24940441 16.13909492 1.89723284 0.04723628 -0.00993771 -0.00831431
+ 10.0 -0.86685880 -26.00179392 -1.38458807 -1.39913472 0.00136531 0.02041813
+ 10.0 -14.99514725 -9.73327401 -1.49412678 0.04580994 0.01096177 0.01022804
+ 10.0 7.00887790 1.98168034 0.68812772 0.00896544 -0.00293511 0.00198547
+ 10.0 14.82165676 -26.61468332 -0.63832974 -2.10322539 -0.00891726 0.01991691
+ 10.0 36.97393038 41.34508248 3.24972457 -0.53759403 -0.01886630 -0.02264741
+ 10.0 13.20164819 -5.94173158 0.74976608 -0.99205532 -0.00725503 0.00697320
+ 10.0 -27.55525109 11.38230453 -0.82867230 2.04896832 0.02021279 -0.00334846
+ 10.0 44.22611452 7.91205992 2.08170876 -1.97441862 -0.02553919 -0.00334242
+ 10.0 -30.78228408 -9.00330845 -1.98277752 1.19492292 0.02083894 0.00999898
+ 10.0 21.23162596 1.68817791 1.43493089 -0.91572699 -0.01244008 0.00145281
+ 10.0 43.83049777 17.41111171 2.48943804 -1.60943360 -0.02478736 -0.00913389
+ 10.0 18.27076095 14.11054567 1.82221570 -0.03605102 -0.01008131 -0.00688670
+ 10.0 -23.16386718 14.98115804 -0.48627528 2.03701218 0.01725857 -0.00604352
+ 10.0 17.66869644 37.69009924 2.68456831 0.61313519 -0.00829888 -0.02182563
+ 10.0 -13.13453980 43.06229834 1.74152194 2.32880687 0.01088136 -0.02345547
+ 10.0 17.04551969 -8.51968300 0.74199110 -1.36393081 -0.00992090 0.00843742
+ 10.0 -12.74957582 2.86610039 -0.88706993 0.76014301 0.01004519 0.00183585
+ 10.0 -11.57352997 -3.93218467 -1.08155095 0.15539312 0.00900597 0.00634724
+ 10.0 -0.43691930 11.99128730 0.42464351 1.00896428 0.00223775 -0.00474195
+ 10.0 -18.84718297 2.59155114 -1.14765946 1.09328119 0.01395275 0.00224813
+ 10.0 26.50822037 34.91831202 2.84251996 -0.01459342 -0.01374681 -0.02010543
+ 10.0 -1.83862732 -27.40591387 -1.51844281 -1.37417813 0.00190638 0.02119551
+ 10.0 -29.61534814 -11.34773579 -2.05992588 1.01365241 0.02001716 0.01147311
+ 10.0 -1.58282077 2.69811157 -0.11418406 0.29617314 0.00265977 0.00167764
+ 10.0 2.81028701 8.79669118 0.52804717 0.69094215 -0.00005422 -0.00258329
+ 10.0 -46.98701557 11.56383052 -1.07690408 2.84555950 0.02883999 -0.00259972
+ 10.0 -3.40737443 -56.06838909 -2.91291405 -1.56839602 0.00150420 0.03217266
+ 10.0 -19.98158539 39.46428514 1.28835283 2.57214878 0.01493065 -0.02105105
+ 10.0 -44.66881930 12.46139603 -1.00158524 2.78765137 0.02804667 -0.00323063
+ 10.0 -16.39650937 23.16371517 0.32747014 2.11248239 0.01323682 -0.01177621
+ 10.0 21.95611509 7.76064067 1.72075828 -0.61228724 -0.01269236 -0.00269100
+ 10.0 -10.50904475 12.60669705 -0.19243723 1.40501570 0.00897813 -0.00484325
+ 10.0 -14.30586541 -0.91198946 -1.12740574 0.55739977 0.01090470 0.00440092
+ 10.0 -46.00705467 -6.85206507 -2.04591400 2.14319881 0.02767905 0.00814089
+ 10.0 30.41289215 -6.97966533 1.15654150 -1.91885498 -0.01852614 0.00680537
+ 10.0 -48.27660341 27.60241976 -0.13762372 3.31622222 0.02879885 -0.01161224
+ 10.0 -17.74747450 10.50189167 -0.63686673 1.56720699 0.01384037 -0.00328594
+ 10.0 54.39641806 -0.37738366 1.72976962 -2.73607215 -0.02940059 0.00129876
+ 10.0 6.47050061 -29.43922970 -1.20659479 -1.82090480 -0.00359394 0.02244751
+ 10.0 0.58954963 -13.25292294 -0.49482500 -1.03808365 0.00082873 0.01218738
+ 10.0 -12.31468078 -40.73604077 -2.60912850 -0.94516629 0.00720515 0.02765879
+ 10.0 38.13312568 24.34484548 2.69648135 -1.04260079 -0.02152543 -0.01341969
+ 10.0 -13.70564154 27.92937950 0.77625108 2.14221048 0.01158560 -0.01492998
+ 10.0 40.53583366 -0.14911602 1.65704468 -2.10583120 -0.02408788 0.00179315
+ 10.0 8.39984292 -15.41302717 -0.12676090 -1.44483730 -0.00437128 0.01330585
+ 10.0 22.44930397 -38.06973908 -1.11496697 -2.59958621 -0.01287940 0.02515562
+ 10.0 47.41809427 3.44198464 1.88610439 -2.29818650 -0.02696432 -0.00068958
+ 10.0 27.36675414 46.97814868 3.25532655 0.14568231 -0.01291442 -0.02560627
+ 10.0 -10.16897115 -22.40458265 -1.73420047 -0.76737649 0.00741932 0.01846132
+ 10.0 40.36029012 -18.88517950 0.55513182 -2.79063722 -0.02344201 0.01302615
+ 10.0 -14.39025584 20.54575351 0.21589623 1.94610689 0.01196694 -0.01021320
+ 10.0 19.64156343 34.26658662 2.62377284 0.42861126 -0.00976569 -0.01997954
+ 10.0 -33.50298072 43.14541702 1.10503992 3.09224158 0.02172220 -0.02121984
+ 10.0 -20.79202850 -24.09713162 -2.28882549 -0.07479119 0.01364036 0.01919977
diff --git a/testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout b/testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout
new file mode 100644
index 0000000000..69fdd8b303
--- /dev/null
+++ b/testsuite/tests/dph/nbody/dph-nbody-copy-opt.stdout
@@ -0,0 +1,100 @@
+ 10.0 -7.88876745 14.40403609 0.07781862 1.41725313 0.00728077 -0.00615418
+ 10.0 -20.39602554 -5.40256368 -1.56824530 0.67893475 0.01493099 0.00782011
+ 10.0 -0.05794753 10.34183386 0.35651327 0.89460951 0.00188899 -0.00356931
+ 10.0 -4.75609397 34.74782948 1.61195437 1.87077953 0.00587195 -0.01975082
+ 10.0 36.25896362 10.82337782 2.14170846 -1.41319743 -0.02163268 -0.00507727
+ 10.0 4.02674361 -9.00872919 0.03617254 -0.88316283 -0.00122400 0.00926493
+ 10.0 42.00406508 -40.85785845 -0.76014767 -3.29738763 -0.02191949 0.02332737
+ 10.0 -22.63186030 5.80994447 -1.07420146 1.51160117 0.01670201 0.00006355
+ 10.0 16.53870540 16.94639077 1.84926442 0.20378411 -0.00879785 -0.00880553
+ 10.0 39.92854878 29.06425991 2.88523318 -1.01552251 -0.02189971 -0.01632925
+ 10.0 -17.45501954 11.39301477 -0.56641470 1.60906365 0.01371008 -0.00396360
+ 10.0 26.25934753 8.00486951 1.85024443 -0.89918952 -0.01562756 -0.00309898
+ 10.0 -9.33900099 9.24549389 -0.36060159 1.12461927 0.00801307 -0.00255620
+ 10.0 -46.47873679 -28.36980232 -2.92763912 1.44708065 0.02528654 0.01949016
+ 10.0 -12.54370842 34.21722863 1.24120256 2.21072951 0.01080973 -0.01869097
+ 10.0 -7.14048930 7.10420057 -0.36081624 0.86670872 0.00647863 -0.00118788
+ 10.0 -49.88492485 -23.33817148 -2.76602163 1.78294227 0.02720067 0.01682362
+ 10.0 -19.81399282 53.52954568 2.07232227 2.65936299 0.01424146 -0.02727658
+ 10.0 23.77418551 14.68227128 2.04725863 -0.41772276 -0.01379116 -0.00752371
+ 10.0 -5.73673778 8.93192786 -0.16259409 0.97138466 0.00562305 -0.00245174
+ 10.0 10.54277542 -1.02674862 0.84834041 -0.44100517 -0.00531874 0.00383461
+ 10.0 23.01197723 21.12299112 2.25990543 -0.12607295 -0.01291140 -0.01176114
+ 10.0 -44.78532667 12.05197921 -1.02696812 2.77848076 0.02808850 -0.00298275
+ 10.0 31.46388060 -49.75461307 -1.52046945 -3.03579919 -0.01637469 0.02786471
+ 10.0 24.84943257 -25.92687211 -0.24060772 -2.45045466 -0.01484349 0.01860299
+ 10.0 25.91948874 -30.60444211 -0.52684367 -2.60005186 -0.01516185 0.02084074
+ 10.0 -10.85946929 20.87407647 0.39902427 1.82589346 0.00972306 -0.01062660
+ 10.0 -38.51435867 1.59076858 -1.56374573 2.10935343 0.02533138 0.00325720
+ 10.0 48.51766969 -21.77175738 0.49039776 -3.14884736 -0.02642908 0.01352300
+ 10.0 5.74566172 46.44110258 2.61301762 1.41963745 -0.00049448 -0.02602402
+ 10.0 -22.88917903 -27.97906439 -2.49898486 -0.03157484 0.01438842 0.02110301
+ 10.0 31.73261776 -6.28614087 1.21728705 -1.94829313 -0.01955786 0.00624200
+ 10.0 4.24232124 19.44671943 1.21964188 1.10199242 -0.00052277 -0.01009959
+ 10.0 0.91334970 48.66777413 2.53737735 1.69247032 0.00244742 -0.02680742
+ 10.0 10.67139892 31.69558668 2.17625638 0.97201541 -0.00424894 -0.01856619
+ 10.0 12.94163719 58.29627746 3.27732262 1.10311871 -0.00411829 -0.03016643
+ 10.0 39.19514702 34.09017661 3.04651632 -0.83806079 -0.02092181 -0.01899392
+ 10.0 -24.13067759 -32.16302812 -2.68262548 -0.04506858 0.01454248 0.02301772
+ 10.0 51.78333979 -13.45956325 1.00920828 -3.03719366 -0.02816357 0.00875884
+ 10.0 -18.73188233 -17.30379387 -1.95701398 -0.00677590 0.01307052 0.01538889
+ 10.0 24.70514705 -49.06503148 -1.67808526 -2.78661149 -0.01337746 0.02867654
+ 10.0 -51.06940692 -15.61458174 -2.46357376 2.08982818 0.02835174 0.01252356
+ 10.0 -4.29154911 -29.69366786 -1.77081329 -1.27717018 0.00330457 0.02241695
+ 10.0 2.11752441 33.61609431 1.87012243 1.50451828 0.00141129 -0.01940596
+ 10.0 37.73902003 -20.32722331 0.42253535 -2.74138534 -0.02210996 0.01412198
+ 10.0 18.24940441 16.13909492 1.89723284 0.04723628 -0.00993771 -0.00831431
+ 10.0 -0.86685880 -26.00179392 -1.38458807 -1.39913472 0.00136531 0.02041813
+ 10.0 -14.99514725 -9.73327401 -1.49412678 0.04580994 0.01096177 0.01022804
+ 10.0 7.00887790 1.98168034 0.68812772 0.00896544 -0.00293511 0.00198547
+ 10.0 14.82165676 -26.61468332 -0.63832974 -2.10322539 -0.00891726 0.01991691
+ 10.0 36.97393038 41.34508248 3.24972457 -0.53759403 -0.01886630 -0.02264741
+ 10.0 13.20164819 -5.94173158 0.74976608 -0.99205532 -0.00725503 0.00697320
+ 10.0 -27.55525109 11.38230453 -0.82867230 2.04896832 0.02021279 -0.00334846
+ 10.0 44.22611452 7.91205992 2.08170876 -1.97441862 -0.02553919 -0.00334242
+ 10.0 -30.78228408 -9.00330845 -1.98277752 1.19492292 0.02083894 0.00999898
+ 10.0 21.23162596 1.68817791 1.43493089 -0.91572699 -0.01244008 0.00145281
+ 10.0 43.83049777 17.41111171 2.48943804 -1.60943360 -0.02478736 -0.00913389
+ 10.0 18.27076095 14.11054567 1.82221570 -0.03605102 -0.01008131 -0.00688670
+ 10.0 -23.16386718 14.98115804 -0.48627528 2.03701218 0.01725857 -0.00604352
+ 10.0 17.66869644 37.69009924 2.68456831 0.61313519 -0.00829888 -0.02182563
+ 10.0 -13.13453980 43.06229834 1.74152194 2.32880687 0.01088136 -0.02345547
+ 10.0 17.04551969 -8.51968300 0.74199110 -1.36393081 -0.00992090 0.00843742
+ 10.0 -12.74957582 2.86610039 -0.88706993 0.76014301 0.01004519 0.00183585
+ 10.0 -11.57352997 -3.93218467 -1.08155095 0.15539312 0.00900597 0.00634724
+ 10.0 -0.43691930 11.99128730 0.42464351 1.00896428 0.00223775 -0.00474195
+ 10.0 -18.84718297 2.59155114 -1.14765946 1.09328119 0.01395275 0.00224813
+ 10.0 26.50822037 34.91831202 2.84251996 -0.01459342 -0.01374681 -0.02010543
+ 10.0 -1.83862732 -27.40591387 -1.51844281 -1.37417813 0.00190638 0.02119551
+ 10.0 -29.61534814 -11.34773579 -2.05992588 1.01365241 0.02001716 0.01147311
+ 10.0 -1.58282077 2.69811157 -0.11418406 0.29617314 0.00265977 0.00167764
+ 10.0 2.81028701 8.79669118 0.52804717 0.69094215 -0.00005422 -0.00258329
+ 10.0 -46.98701557 11.56383052 -1.07690408 2.84555950 0.02883999 -0.00259972
+ 10.0 -3.40737443 -56.06838909 -2.91291405 -1.56839602 0.00150420 0.03217266
+ 10.0 -19.98158539 39.46428514 1.28835283 2.57214878 0.01493065 -0.02105105
+ 10.0 -44.66881930 12.46139603 -1.00158524 2.78765137 0.02804667 -0.00323063
+ 10.0 -16.39650937 23.16371517 0.32747014 2.11248239 0.01323682 -0.01177621
+ 10.0 21.95611509 7.76064067 1.72075828 -0.61228724 -0.01269236 -0.00269100
+ 10.0 -10.50904475 12.60669705 -0.19243723 1.40501570 0.00897813 -0.00484325
+ 10.0 -14.30586541 -0.91198946 -1.12740574 0.55739977 0.01090470 0.00440092
+ 10.0 -46.00705467 -6.85206507 -2.04591400 2.14319881 0.02767905 0.00814089
+ 10.0 30.41289215 -6.97966533 1.15654150 -1.91885498 -0.01852614 0.00680537
+ 10.0 -48.27660341 27.60241976 -0.13762372 3.31622222 0.02879885 -0.01161224
+ 10.0 -17.74747450 10.50189167 -0.63686673 1.56720699 0.01384037 -0.00328594
+ 10.0 54.39641806 -0.37738366 1.72976962 -2.73607215 -0.02940059 0.00129876
+ 10.0 6.47050061 -29.43922970 -1.20659479 -1.82090480 -0.00359394 0.02244751
+ 10.0 0.58954963 -13.25292294 -0.49482500 -1.03808365 0.00082873 0.01218738
+ 10.0 -12.31468078 -40.73604077 -2.60912850 -0.94516629 0.00720515 0.02765879
+ 10.0 38.13312568 24.34484548 2.69648135 -1.04260079 -0.02152543 -0.01341969
+ 10.0 -13.70564154 27.92937950 0.77625108 2.14221048 0.01158560 -0.01492998
+ 10.0 40.53583366 -0.14911602 1.65704468 -2.10583120 -0.02408788 0.00179315
+ 10.0 8.39984292 -15.41302717 -0.12676090 -1.44483730 -0.00437128 0.01330585
+ 10.0 22.44930397 -38.06973908 -1.11496697 -2.59958621 -0.01287940 0.02515562
+ 10.0 47.41809427 3.44198464 1.88610439 -2.29818650 -0.02696432 -0.00068958
+ 10.0 27.36675414 46.97814868 3.25532655 0.14568231 -0.01291442 -0.02560627
+ 10.0 -10.16897115 -22.40458265 -1.73420047 -0.76737649 0.00741932 0.01846132
+ 10.0 40.36029012 -18.88517950 0.55513182 -2.79063722 -0.02344201 0.01302615
+ 10.0 -14.39025584 20.54575351 0.21589623 1.94610689 0.01196694 -0.01021320
+ 10.0 19.64156343 34.26658662 2.62377284 0.42861126 -0.00976569 -0.01997954
+ 10.0 -33.50298072 43.14541702 1.10503992 3.09224158 0.02172220 -0.02121984
+ 10.0 -20.79202850 -24.09713162 -2.28882549 -0.07479119 0.01364036 0.01919977
diff --git a/testsuite/tests/dph/nbody/dph-nbody.T b/testsuite/tests/dph/nbody/dph-nbody.T
index 4edd3820bd..c250f2461f 100644
--- a/testsuite/tests/dph/nbody/dph-nbody.T
+++ b/testsuite/tests/dph/nbody/dph-nbody.T
@@ -17,7 +17,28 @@ test ('dph-nbody-vseg-opt'
, only_ways(['normal', 'threaded1', 'threaded2']) ]
, multimod_compile_and_run
, [ 'Main'
- , '-Odph -fno-spec-constr -fno-liberate-case -package dph-lifted-vseg -package dph-prim-par'])
+ , '-Odph -fno-liberate-case -package dph-lifted-vseg -package dph-prim-par'])
+
+
+test ('dph-nbody-copy-opt'
+ , [ alone
+ , skip_if_fast
+ , extra_clean(['Main.hi', 'Main.o',
+ 'Body.hi', 'Body.o',
+ 'Config.hi', 'Config.o',
+ 'Dump.hi', 'Dump.o',
+ 'Solver.hi', 'Solver.o',
+ 'Util.hi', 'Util.o',
+ 'World.hi', 'World.o',
+ 'Types.hi', 'Types.o',
+ 'Generate.hi', 'Generate.o',
+ 'Randomish.hi', 'Randomish.o'])
+ , reqlib('dph-lifted-copy')
+ , reqlib('dph-prim-par')
+ , only_ways(['normal', 'threaded1', 'threaded2']) ]
+ , multimod_compile_and_run
+ , [ 'Main'
+ , '-Odph -fno-liberate-case -package dph-lifted-copy -package dph-prim-par'])
test ('dph-nbody-vseg-fast'
@@ -38,3 +59,23 @@ test ('dph-nbody-vseg-fast'
, multimod_compile_and_run
, [ 'Main'
, '-O0 -package dph-lifted-vseg -package dph-prim-par'])
+
+
+test ('dph-nbody-copy-fast'
+ , [ alone
+ , extra_clean(['Main.hi', 'Main.o',
+ 'Body.hi', 'Body.o',
+ 'Config.hi', 'Config.o',
+ 'Dump.hi', 'Dump.o',
+ 'Solver.hi', 'Solver.o',
+ 'Util.hi', 'Util.o',
+ 'World.hi', 'World.o',
+ 'Types.hi', 'Types.o',
+ 'Generate.hi', 'Generate.o',
+ 'Randomish.hi', 'Randomish.o'])
+ , reqlib('dph-lifted-copy')
+ , reqlib('dph-prim-par')
+ , only_ways(['normal', 'threaded1', 'threaded2']) ]
+ , multimod_compile_and_run
+ , [ 'Main'
+ , '-O0 -package dph-lifted-copy -package dph-prim-par'])
diff --git a/testsuite/tests/driver/437/437.stdout b/testsuite/tests/driver/437/437.stdout
index 99bfbaffa5..7508a5f9e0 100644
--- a/testsuite/tests/driver/437/437.stdout
+++ b/testsuite/tests/driver/437/437.stdout
@@ -1,2 +1,10 @@
+[1 of 2] Compiling Test2 ( Test2.hs, Test2.o )
+[2 of 2] Compiling Test ( Test.hs, Test.o )
+Linking Test ...
+[1 of 1] Compiling Test2 ( Test2.hs, Test2.o ) [flags changed]
+Linking Test2 ...
"Test2.doit"
"Test2.main"
+[1 of 1] Compiling Test2 ( Test2.hs, Test2.o ) [flags changed]
+Linking Test2 ...
+"Test2.doit"
diff --git a/testsuite/tests/driver/437/Makefile b/testsuite/tests/driver/437/Makefile
index a83f1ad922..649d462b1e 100644
--- a/testsuite/tests/driver/437/Makefile
+++ b/testsuite/tests/driver/437/Makefile
@@ -16,8 +16,12 @@ clean:
# bug #437
437: clean
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -v0 --make -main-is Test.main Test.hs
- '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) -v0 --make -main-is Test2.main Test2.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --make -main-is Test.main Test.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --make -main-is Test2.main Test2.hs
./Test
./Test2
+ sleep 1
+ # Test that changing the main function name forces recomp of Test2
+ '$(TEST_HC)' $(TEST_HC_OPTS_NO_RECOMP) --make -main-is Test2.doit Test2.hs
+ ./Test2
diff --git a/testsuite/tests/driver/recomp005/recomp005.stdout b/testsuite/tests/driver/recomp005/recomp005.stdout
index 720a1ea74f..ad1ef6d170 100644
--- a/testsuite/tests/driver/recomp005/recomp005.stdout
+++ b/testsuite/tests/driver/recomp005/recomp005.stdout
@@ -4,5 +4,5 @@
[4 of 5] Compiling D ( D.hs, D.o )
[5 of 5] Compiling E ( E.hs, E.o )
[3 of 5] Compiling C ( C.hs, C.o )
-[4 of 5] Compiling D ( D.hs, D.o )
-[5 of 5] Compiling E ( E.hs, E.o )
+[4 of 5] Compiling D ( D.hs, D.o ) [C changed]
+[5 of 5] Compiling E ( E.hs, E.o ) [D changed]
diff --git a/testsuite/tests/driver/recomp006/recomp006.stdout b/testsuite/tests/driver/recomp006/recomp006.stdout
index f403e40d1a..499b06f08b 100644
--- a/testsuite/tests/driver/recomp006/recomp006.stdout
+++ b/testsuite/tests/driver/recomp006/recomp006.stdout
@@ -1,2 +1,2 @@
[1 of 2] Compiling B ( B.hs, B.o )
-[2 of 2] Compiling A ( A.hs, A.o )
+[2 of 2] Compiling A ( A.hs, A.o ) [B changed]
diff --git a/testsuite/tests/driver/recomp007/recomp007.stdout b/testsuite/tests/driver/recomp007/recomp007.stdout
index 9f0fe6a665..61095aa38b 100644
--- a/testsuite/tests/driver/recomp007/recomp007.stdout
+++ b/testsuite/tests/driver/recomp007/recomp007.stdout
@@ -1,5 +1,5 @@
Building b-1.0...
Preprocessing executable 'test' for b-1.0...
-[1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o )
-[2 of 2] Compiling Main ( Main.hs, dist/build/test/test-tmp/Main.o )
+[1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A changed]
+[2 of 2] Compiling Main ( Main.hs, dist/build/test/test-tmp/Main.o ) [B changed]
Linking dist/build/test/test ...
diff --git a/testsuite/tests/driver/recomp011/recomp011.stdout b/testsuite/tests/driver/recomp011/recomp011.stdout
index e0bfcdef3b..d3e0b92508 100644
--- a/testsuite/tests/driver/recomp011/recomp011.stdout
+++ b/testsuite/tests/driver/recomp011/recomp011.stdout
@@ -1,10 +1,10 @@
[1 of 1] Compiling Main ( Main.hs, Main.o )
Linking Main ...
42
-[1 of 1] Compiling Main ( Main.hs, Main.o )
+[1 of 1] Compiling Main ( Main.hs, Main.o ) [B.hsinc changed]
Linking Main ...
43
-[1 of 1] Compiling Main ( Main.hs, Main.o )
+[1 of 1] Compiling Main ( Main.hs, Main.o ) [A.hsinc changed]
Linking Main ...
4343
4343
diff --git a/testsuite/tests/ffi/should_fail/all.T b/testsuite/tests/ffi/should_fail/all.T
index abba1b5f6f..188ef99bfb 100644
--- a/testsuite/tests/ffi/should_fail/all.T
+++ b/testsuite/tests/ffi/should_fail/all.T
@@ -8,3 +8,5 @@ test('ccfail003', only_compiler_types(['ghc']), compile_fail, [''])
test('T3066', only_compiler_types(['ghc']), compile_fail, [''])
test('ccfail004', only_compiler_types(['ghc']), multimod_compile_fail, ['ccfail004', '-v0'])
test('ccfail005', only_compiler_types(['ghc']), compile_fail, [''])
+test('ccall_value', normal, compile_fail, [''])
+test('capi_value_function', normal, compile_fail, [''])
diff --git a/testsuite/tests/ffi/should_fail/capi_value_function.hs b/testsuite/tests/ffi/should_fail/capi_value_function.hs
new file mode 100644
index 0000000000..fdd59808f0
--- /dev/null
+++ b/testsuite/tests/ffi/should_fail/capi_value_function.hs
@@ -0,0 +1,9 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module M where
+
+import Foreign.C
+
+foreign import capi "math.h value sqrt" f :: CInt -> CInt
+
diff --git a/testsuite/tests/ffi/should_fail/capi_value_function.stderr b/testsuite/tests/ffi/should_fail/capi_value_function.stderr
new file mode 100644
index 0000000000..99ffad6ab8
--- /dev/null
+++ b/testsuite/tests/ffi/should_fail/capi_value_function.stderr
@@ -0,0 +1,6 @@
+
+capi_value_function.hs:8:1:
+ `value' imports cannot have function types
+ When checking declaration:
+ foreign import capi safe "static math.h value sqrt" f
+ :: CInt -> CInt
diff --git a/testsuite/tests/ffi/should_fail/ccall_value.hs b/testsuite/tests/ffi/should_fail/ccall_value.hs
new file mode 100644
index 0000000000..2f931f697b
--- /dev/null
+++ b/testsuite/tests/ffi/should_fail/ccall_value.hs
@@ -0,0 +1,12 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Main (main) where
+
+import Foreign.C
+
+main :: IO ()
+main = print i
+
+foreign import ccall "ccall_value_c.h value i" i :: CInt
+
diff --git a/testsuite/tests/ffi/should_fail/ccall_value.stderr b/testsuite/tests/ffi/should_fail/ccall_value.stderr
new file mode 100644
index 0000000000..b7e870f0ed
--- /dev/null
+++ b/testsuite/tests/ffi/should_fail/ccall_value.stderr
@@ -0,0 +1,2 @@
+
+ccall_value.hs:11:22: Malformed entity string
diff --git a/testsuite/tests/ffi/should_fail/ccall_value_c.h b/testsuite/tests/ffi/should_fail/ccall_value_c.h
new file mode 100644
index 0000000000..d8ef814216
--- /dev/null
+++ b/testsuite/tests/ffi/should_fail/ccall_value_c.h
@@ -0,0 +1,3 @@
+
+const int i;
+#define j 24
diff --git a/testsuite/tests/ffi/should_fail/ccfail004.stderr b/testsuite/tests/ffi/should_fail/ccfail004.stderr
index 4ae1b0a73f..cce4258911 100644
--- a/testsuite/tests/ffi/should_fail/ccfail004.stderr
+++ b/testsuite/tests/ffi/should_fail/ccfail004.stderr
@@ -1,4 +1,15 @@
+
+ccfail004.hs:9:1:
+ Unacceptable argument type in foreign declaration: NInt
+ When checking declaration:
+ foreign import ccall safe "static f1" f1 :: NInt -> IO Int
+
+ccfail004.hs:10:1:
+ Unacceptable result type in foreign declaration: IO NInt
+ When checking declaration:
+ foreign import ccall safe "static f2" f2 :: Int -> IO NInt
+
ccfail004.hs:11:1:
Unacceptable result type in foreign declaration: NIO Int
When checking declaration:
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_001.hsc b/testsuite/tests/ffi/should_run/Capi_Ctype_001.hsc
new file mode 100644
index 0000000000..5dd24c3183
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_001.hsc
@@ -0,0 +1,46 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Main (main) where
+
+#include "capi_ctype_001.h"
+
+import Capi_Ctype_A_001
+
+import Foreign
+import Foreign.C
+
+main :: IO ()
+main = do alloca $ \p ->
+ do poke p (Foo 5 6 7)
+ r1 <- f p
+ print r1
+ alloca $ \p ->
+ do poke p (Foo 15 16 17)
+ r2 <- g p
+ print r2
+
+data {-# CTYPE "Foo" #-}
+ Foo = Foo {
+ i :: CInt,
+ j :: CInt,
+ k :: CInt
+ }
+
+foreign import capi unsafe "capi_ctype_001.h f"
+ f :: Ptr Foo -> IO CInt
+
+foreign import capi unsafe "capi_ctype_001.h g"
+ g :: Ptr Foo -> IO CInt
+
+instance Storable Foo where
+ sizeOf _ = #size Foo
+ alignment = sizeOf
+ peek p = do i <- (# peek Foo, i) p
+ j <- (# peek Foo, j) p
+ k <- (# peek Foo, k) p
+ return $ Foo i j k
+ poke p foo = do (# poke Foo, i) p (i foo)
+ (# poke Foo, j) p (j foo)
+ (# poke Foo, k) p (k foo)
+
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_001.stdout b/testsuite/tests/ffi/should_run/Capi_Ctype_001.stdout
new file mode 100644
index 0000000000..dc3ed24fd6
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_001.stdout
@@ -0,0 +1,2 @@
+6
+16
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_002.hs b/testsuite/tests/ffi/should_run/Capi_Ctype_002.hs
new file mode 100644
index 0000000000..4868ee28b7
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_002.hs
@@ -0,0 +1,19 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Main (main) where
+
+import Capi_Ctype_A_002
+
+import Foreign
+import Foreign.C
+
+main :: IO ()
+main = alloca $ \p ->
+ do poke p (Foo 5 6 7)
+ r1 <- f p
+ print r1
+
+foreign import capi unsafe "capi_ctype_002_B.h f"
+ f :: Ptr Foo -> IO CInt
+
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_002.stdout b/testsuite/tests/ffi/should_run/Capi_Ctype_002.stdout
new file mode 100644
index 0000000000..1e8b314962
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_002.stdout
@@ -0,0 +1 @@
+6
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_A_001.hsc b/testsuite/tests/ffi/should_run/Capi_Ctype_A_001.hsc
new file mode 100644
index 0000000000..8b68942db1
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_A_001.hsc
@@ -0,0 +1,27 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Capi_Ctype_A_001 where
+
+#include "capi_ctype_001.h"
+
+import Foreign
+import Foreign.C
+
+data FooA = FooA {
+ ia :: CInt,
+ ja :: CInt,
+ ka :: CInt
+ }
+
+instance Storable FooA where
+ sizeOf _ = #size Foo
+ alignment = sizeOf
+ peek p = do i <- (# peek Foo, i) p
+ j <- (# peek Foo, j) p
+ k <- (# peek Foo, k) p
+ return $ FooA i j k
+ poke p foo = do (# poke Foo, i) p (ia foo)
+ (# poke Foo, j) p (ja foo)
+ (# poke Foo, k) p (ka foo)
+
diff --git a/testsuite/tests/ffi/should_run/Capi_Ctype_A_002.hsc b/testsuite/tests/ffi/should_run/Capi_Ctype_A_002.hsc
new file mode 100644
index 0000000000..14da1144b6
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/Capi_Ctype_A_002.hsc
@@ -0,0 +1,28 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Capi_Ctype_A_002 (Foo(..)) where
+
+#include "capi_ctype_002_A.h"
+
+import Foreign
+import Foreign.C
+
+data {-# CTYPE "capi_ctype_002_A.h" "Foo" #-}
+ Foo = Foo {
+ i :: CInt,
+ j :: CInt,
+ k :: CInt
+ }
+
+instance Storable Foo where
+ sizeOf _ = #size Foo
+ alignment = sizeOf
+ peek p = do i <- (# peek Foo, i) p
+ j <- (# peek Foo, j) p
+ k <- (# peek Foo, k) p
+ return $ Foo i j k
+ poke p foo = do (# poke Foo, i) p (i foo)
+ (# poke Foo, j) p (j foo)
+ (# poke Foo, k) p (k foo)
+
diff --git a/testsuite/tests/ffi/should_run/Makefile b/testsuite/tests/ffi/should_run/Makefile
index 3981cd2166..80ff28647e 100644
--- a/testsuite/tests/ffi/should_run/Makefile
+++ b/testsuite/tests/ffi/should_run/Makefile
@@ -20,3 +20,21 @@ ffi002_setup :
5594_setup :
'$(TEST_HC)' $(TEST_HC_OPTS) -c 5594.hs
+.PHONY: Capi_Ctype_001
+Capi_Ctype_001:
+ '$(HSC2HS)' Capi_Ctype_A_001.hsc
+ '$(HSC2HS)' Capi_Ctype_001.hsc
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c capi_ctype_001_c.c
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_A_001.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_001.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) capi_ctype_001_c.o Capi_Ctype_A_001.o Capi_Ctype_001.o -o Capi_Ctype_001
+ ./Capi_Ctype_001
+
+.PHONY: Capi_Ctype_002
+Capi_Ctype_002:
+ '$(HSC2HS)' Capi_Ctype_A_002.hsc
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_A_002.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c Capi_Ctype_002.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) Capi_Ctype_A_002.o Capi_Ctype_002.o -o Capi_Ctype_002
+ ./Capi_Ctype_002
+
diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T
index 118a26fb44..30eba8ee0e 100644
--- a/testsuite/tests/ffi/should_run/all.T
+++ b/testsuite/tests/ffi/should_run/all.T
@@ -187,3 +187,27 @@ test('5594', [ omit_ways(['ghci']),
# 5594_stub.h before compiling 5594_c.c, which
# needs it.
compile_and_run, ['5594_c.c -no-hs-main'])
+
+test('Capi_Ctype_001',
+ extra_clean(['Capi_Ctype_A_001.o', 'Capi_Ctype_A_001.hi',
+ 'capi_ctype_001_c.o',
+ 'Capi_Ctype_A_001.hs', 'Capi_Ctype_001.hs']),
+ run_command,
+ ['$MAKE -s --no-print-directory Capi_Ctype_001'])
+
+test('Capi_Ctype_002',
+ extra_clean(['Capi_Ctype_A_002.o', 'Capi_Ctype_A_002.hi',
+ 'Capi_Ctype_A_002.hs']),
+ run_command,
+ ['$MAKE -s --no-print-directory Capi_Ctype_002'])
+
+test('ffi_parsing_001',
+ extra_clean(['ffi_parsing_001_c.o']),
+ compile_and_run,
+ ['ffi_parsing_001_c.c'])
+
+test('capi_value',
+ extra_clean(['capi_value_c.o']),
+ compile_and_run,
+ ['capi_value_c.c'])
+
diff --git a/testsuite/tests/ffi/should_run/capi_ctype_001.h b/testsuite/tests/ffi/should_run/capi_ctype_001.h
new file mode 100644
index 0000000000..11add5bf3d
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_ctype_001.h
@@ -0,0 +1,16 @@
+
+#ifndef __capi_ctype_001_H__
+#define __capi_ctype_001_H__
+
+typedef struct {
+ int i;
+ int j;
+ int k;
+} Foo;
+
+int f(Foo *p);
+
+#define g(p) p->j
+
+#endif
+
diff --git a/testsuite/tests/ffi/should_run/capi_ctype_001_c.c b/testsuite/tests/ffi/should_run/capi_ctype_001_c.c
new file mode 100644
index 0000000000..970ea4be0f
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_ctype_001_c.c
@@ -0,0 +1,7 @@
+
+#include "capi_ctype_001.h"
+
+int f(Foo *p) {
+ return p->j;
+}
+
diff --git a/testsuite/tests/ffi/should_run/capi_ctype_002_A.h b/testsuite/tests/ffi/should_run/capi_ctype_002_A.h
new file mode 100644
index 0000000000..26928a3436
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_ctype_002_A.h
@@ -0,0 +1,12 @@
+
+#ifndef __capi_ctype_002_A_H__
+#define __capi_ctype_002_A_H__
+
+typedef struct {
+ int i;
+ int j;
+ int k;
+} Foo;
+
+#endif
+
diff --git a/testsuite/tests/ffi/should_run/capi_ctype_002_B.h b/testsuite/tests/ffi/should_run/capi_ctype_002_B.h
new file mode 100644
index 0000000000..6928290f47
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_ctype_002_B.h
@@ -0,0 +1,8 @@
+
+#ifndef __capi_ctype_002_B_H__
+#define __capi_ctype_002_B_H__
+
+#define f(p) p->j
+
+#endif
+
diff --git a/testsuite/tests/ffi/should_run/capi_value.hs b/testsuite/tests/ffi/should_run/capi_value.hs
new file mode 100644
index 0000000000..131e97ae26
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_value.hs
@@ -0,0 +1,14 @@
+
+{-# LANGUAGE CApiFFI #-}
+
+module Main (main) where
+
+import Foreign.C
+
+main :: IO ()
+main = do print i
+ print j
+
+foreign import capi "capi_value_c.h value i" i :: CInt
+foreign import capi "capi_value_c.h value j" j :: CInt
+
diff --git a/testsuite/tests/ffi/should_run/capi_value.stdout b/testsuite/tests/ffi/should_run/capi_value.stdout
new file mode 100644
index 0000000000..e120905029
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_value.stdout
@@ -0,0 +1,2 @@
+23
+24
diff --git a/testsuite/tests/ffi/should_run/capi_value_c.c b/testsuite/tests/ffi/should_run/capi_value_c.c
new file mode 100644
index 0000000000..45db07c6a0
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_value_c.c
@@ -0,0 +1,4 @@
+
+#include "capi_value_c.h"
+
+const int i = 23;
diff --git a/testsuite/tests/ffi/should_run/capi_value_c.h b/testsuite/tests/ffi/should_run/capi_value_c.h
new file mode 100644
index 0000000000..d8ef814216
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/capi_value_c.h
@@ -0,0 +1,3 @@
+
+const int i;
+#define j 24
diff --git a/testsuite/tests/ffi/should_run/ffi_parsing_001.hs b/testsuite/tests/ffi/should_run/ffi_parsing_001.hs
new file mode 100644
index 0000000000..a87a82c7d2
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/ffi_parsing_001.hs
@@ -0,0 +1,8 @@
+
+import Foreign.C
+
+-- This should not be parsed as "static foo", importing "foo"
+foreign import ccall "staticfoo" x :: CInt
+
+main :: IO ()
+main = print x
diff --git a/testsuite/tests/ffi/should_run/ffi_parsing_001.stdout b/testsuite/tests/ffi/should_run/ffi_parsing_001.stdout
new file mode 100644
index 0000000000..7ed6ff82de
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/ffi_parsing_001.stdout
@@ -0,0 +1 @@
+5
diff --git a/testsuite/tests/ffi/should_run/ffi_parsing_001_c.c b/testsuite/tests/ffi/should_run/ffi_parsing_001_c.c
new file mode 100644
index 0000000000..56d5048857
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/ffi_parsing_001_c.c
@@ -0,0 +1,8 @@
+
+int staticfoo(void) {
+ return 5;
+}
+
+int foo(void) {
+ return 8;
+}
diff --git a/testsuite/tests/gadt/rw.stderr b/testsuite/tests/gadt/rw.stderr
index 752d0fd8a3..c6e800b910 100644
--- a/testsuite/tests/gadt/rw.stderr
+++ b/testsuite/tests/gadt/rw.stderr
@@ -3,7 +3,7 @@ rw.hs:14:47:
Couldn't match expected type `a' with actual type `Int'
`a' is a rigid type variable bound by
the type signature for writeInt :: T a -> IORef a -> IO ()
- at rw.hs:13:1
+ at rw.hs:12:14
In the second argument of `writeIORef', namely `(1 :: Int)'
In the expression: writeIORef ref (1 :: Int)
In a case alternative: ~(Li x) -> writeIORef ref (1 :: Int)
@@ -12,7 +12,7 @@ rw.hs:19:51:
Couldn't match type `a' with `Bool'
`a' is a rigid type variable bound by
the type signature for readBool :: T a -> IORef a -> IO ()
- at rw.hs:17:1
+ at rw.hs:16:14
Expected type: a -> Bool
Actual type: Bool -> Bool
In the second argument of `(.)', namely `not'
diff --git a/testsuite/tests/ghc-api/apirecomp001/myghc.hs b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
index 79b02f8b86..39545c937d 100644
--- a/testsuite/tests/ghc-api/apirecomp001/myghc.hs
+++ b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
@@ -40,7 +40,7 @@ main = do
-- set context to module "A"
mg <- getModuleGraph
- let [mod] = [ ms_mod m | m <- mg, moduleNameString (ms_mod_name m) == "A" ]
+ let [mod] = [ ms_mod_name m | m <- mg, moduleNameString (ms_mod_name m) == "A" ]
setContext [IIModule mod]
liftIO $ hFlush stdout -- make sure things above are printed before
-- interactive output
diff --git a/testsuite/tests/ghci.debugger/scripts/break007.stdout b/testsuite/tests/ghci.debugger/scripts/break007.stdout
index e692d2048f..44088454d0 100644
--- a/testsuite/tests/ghci.debugger/scripts/break007.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break007.stdout
@@ -1 +1 @@
-No breakpoints found at that location.
+No modules are loaded with debugging support.
diff --git a/testsuite/tests/ghci/scripts/Defer02.stderr b/testsuite/tests/ghci/scripts/Defer02.stderr
index 4a17b34d19..cd146ddbff 100644
--- a/testsuite/tests/ghci/scripts/Defer02.stderr
+++ b/testsuite/tests/ghci/scripts/Defer02.stderr
@@ -37,7 +37,7 @@
Couldn't match expected type `a' with actual type `Char'
`a' is a rigid type variable bound by
the type signature for h :: a -> (Char, Char)
- at ../../typecheck/should_run/Defer01.hs:34:1
+ at ../../typecheck/should_run/Defer01.hs:33:6
In the expression: x
In the expression: (x, 'c')
In an equation for `h': h x = (x, 'c')
@@ -46,7 +46,7 @@
Couldn't match expected type `Bool' with actual type `T a'
In the return type of a call of `K'
In the first argument of `not', namely `(K a)'
- In the first argument of `seq', namely `(not (K a))'
+ In the expression: (not (K a))
../../typecheck/should_run/Defer01.hs:43:5: Warning:
No instance for (MyClass a1)
diff --git a/testsuite/tests/ghci/scripts/Defer02.stdout b/testsuite/tests/ghci/scripts/Defer02.stdout
index 85d447abc1..e845c09d4b 100644
--- a/testsuite/tests/ghci/scripts/Defer02.stdout
+++ b/testsuite/tests/ghci/scripts/Defer02.stdout
@@ -36,7 +36,7 @@ Hello World*** Exception: ../../typecheck/should_run/Defer01.hs:11:40:
Couldn't match expected type `a' with actual type `Char'
`a' is a rigid type variable bound by
the type signature for h :: a -> (Char, Char)
- at ../../typecheck/should_run/Defer01.hs:34:1
+ at ../../typecheck/should_run/Defer01.hs:33:6
In the expression: x
In the expression: (x, 'c')
In an equation for `h': h x = (x, 'c')
@@ -45,7 +45,7 @@ Hello World*** Exception: ../../typecheck/should_run/Defer01.hs:11:40:
Couldn't match expected type `Bool' with actual type `T a'
In the return type of a call of `K'
In the first argument of `not', namely `(K a)'
- In the first argument of `seq', namely `(not (K a))'
+ In the expression: (not (K a))
(deferred type error)
"*** Exception: ../../typecheck/should_run/Defer01.hs:43:5:
No instance for (MyClass a1)
diff --git a/testsuite/tests/ghci/scripts/Makefile b/testsuite/tests/ghci/scripts/Makefile
index 03d9fc4723..1fe702567f 100644
--- a/testsuite/tests/ghci/scripts/Makefile
+++ b/testsuite/tests/ghci/scripts/Makefile
@@ -5,16 +5,17 @@ include $(TOP)/mk/test.mk
ghci024:
@echo "~~~~~~~~~~ Testing :set"
printf ":set\n" \
+ | '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci
+ @echo "~~~~~~~~~~ Testing :set -a"
+ printf ":set -a\n" \
| '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci \
| grep -E "^([^ ]| -fno-print-explicit-foralls| -fno-warn-implicit-prelude)"
@echo "~~~~~~~~~~ Testing :show languages"
printf ":show languages\n" \
- | '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci \
- | grep -E "^([^ ]| -XImplicitPrelude| -XMagicHash)"
+ | '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci
@echo "~~~~~~~~~~ Testing :show languages, with -XMagicHash"
printf ":set -XMagicHash\n:show languages\n" \
- | '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci \
- | grep -E "^([^ ]| -XImplicitPrelude| -XMagicHash)"
+ | '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci
@echo "~~~~~~~~~~ Testing :show packages"
printf ":show packages\n" \
| '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -v0 -ignore-dot-ghci \
diff --git a/testsuite/tests/ghci/scripts/T5820.hs b/testsuite/tests/ghci/scripts/T5820.hs
new file mode 100644
index 0000000000..99d36e5fc2
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T5820.hs
@@ -0,0 +1,3 @@
+module T5820 where
+data Foo = Foo
+instance Eq Foo
diff --git a/testsuite/tests/ghci/scripts/T5820.script b/testsuite/tests/ghci/scripts/T5820.script
new file mode 100644
index 0000000000..e1a0bd10af
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T5820.script
@@ -0,0 +1,4 @@
+:l T5820
+:i Foo
+data T = T
+:i Foo
diff --git a/testsuite/tests/ghci/scripts/T5820.stdout b/testsuite/tests/ghci/scripts/T5820.stdout
new file mode 100644
index 0000000000..4102b1f987
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T5820.stdout
@@ -0,0 +1,4 @@
+data Foo = Foo -- Defined at T5820.hs:2:6
+instance Eq Foo -- Defined at T5820.hs:3:10
+data Foo = Foo -- Defined at T5820.hs:2:6
+instance Eq Foo -- Defined at T5820.hs:3:10
diff --git a/testsuite/tests/ghci/scripts/T5836.script b/testsuite/tests/ghci/scripts/T5836.script
new file mode 100644
index 0000000000..a3ef3ce6a1
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T5836.script
@@ -0,0 +1 @@
+import Does.Not.Exist
diff --git a/testsuite/tests/ghci/scripts/T5836.stderr b/testsuite/tests/ghci/scripts/T5836.stderr
new file mode 100644
index 0000000000..9b0cfc65eb
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T5836.stderr
@@ -0,0 +1,4 @@
+
+<no location info>:
+ Could not find module `Does.Not.Exist'
+ It is not a module in the current program, or in any known package.
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index b559dcf099..a2efb2ada3 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -81,6 +81,8 @@ test('ghci056',
],
ghci_script, ['ghci056.script'])
+test('ghci057', normal, ghci_script, ['ghci057.script'])
+
test('2452', normal, ghci_script, ['2452.script'])
test('T2766', normal, ghci_script, ['T2766.script'])
@@ -108,4 +110,6 @@ test('T5557', normal, ghci_script, ['T5557.script'])
test('T5566', normal, ghci_script, ['T5566.script'])
test('GhciKinds', normal, ghci_script, ['GhciKinds.script'])
test('T5564', normal, ghci_script, ['T5564.script'])
-test('Defer02', normal, ghci_script, ['Defer02.script']) \ No newline at end of file
+test('Defer02', normal, ghci_script, ['Defer02.script'])
+test('T5820', normal, ghci_script, ['T5820.script'])
+test('T5836', normal, ghci_script, ['T5836.script'])
diff --git a/testsuite/tests/ghci/scripts/ghci024.stdout b/testsuite/tests/ghci/scripts/ghci024.stdout
index 8073383b41..f6b8cb3a5a 100644
--- a/testsuite/tests/ghci/scripts/ghci024.stdout
+++ b/testsuite/tests/ghci/scripts/ghci024.stdout
@@ -1,17 +1,34 @@
~~~~~~~~~~ Testing :set
options currently set: none.
+base language is: Haskell2010
+with the following modifiers:
+ -XNoDatatypeContexts
+ -XNondecreasingIndentation
+GHCi-specific dynamic flag settings:
+other dynamic, non-language, flag settings:
+ -fforce-recomp
+ -fimplicit-import-qualified
+warning settings:
+~~~~~~~~~~ Testing :set -a
+options currently set: none.
+base language is: Haskell2010
+all active language options:
GHCi-specific dynamic flag settings:
-fno-print-explicit-foralls
other dynamic, non-language, flag settings:
warning settings:
-fno-warn-implicit-prelude
~~~~~~~~~~ Testing :show languages
-active language flags:
- -XImplicitPrelude
+base language is: Haskell2010
+with the following modifiers:
+ -XNoDatatypeContexts
+ -XNondecreasingIndentation
~~~~~~~~~~ Testing :show languages, with -XMagicHash
-active language flags:
+base language is: Haskell2010
+with the following modifiers:
-XMagicHash
- -XImplicitPrelude
+ -XNoDatatypeContexts
+ -XNondecreasingIndentation
~~~~~~~~~~ Testing :show packages
active package flags: none
~~~~~~~~~~ Testing :show packages, including the ghc package
diff --git a/testsuite/tests/ghci/scripts/ghci057.hs b/testsuite/tests/ghci/scripts/ghci057.hs
new file mode 100644
index 0000000000..2a6b836d80
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci057.hs
@@ -0,0 +1,4 @@
+module Test where
+data T a where
+ C :: T Int
+
diff --git a/testsuite/tests/ghci/scripts/ghci057.script b/testsuite/tests/ghci/scripts/ghci057.script
new file mode 100644
index 0000000000..547fce52d7
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci057.script
@@ -0,0 +1,27 @@
+:set
+
+putStrLn "Should fail, GADTs is not enabled"
+data T a where C :: T Int
+
+:set -XGADTs
+:set
+
+putStrLn "Should work, GADTs is in force from :set"
+:load ghci057.hs
+
+:set -XNoGADTs
+:set
+
+putStrLn "Should fail, GADTs is now disabled"
+:load ghci057.hs
+
+:seti -XGADTs
+:seti
+
+putStrLn "Should fail, GADTs is only enabled at the prompt"
+:load ghci057.hs
+
+-- Should work
+data T a where C :: T Int
+:t C
+
diff --git a/testsuite/tests/ghci/scripts/ghci057.stderr b/testsuite/tests/ghci/scripts/ghci057.stderr
new file mode 100644
index 0000000000..383d951e0c
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci057.stderr
@@ -0,0 +1,17 @@
+
+<interactive>:5:1:
+ Illegal generalised algebraic data declaration for `T'
+ (Use -XGADTs to allow GADTs)
+ In the data type declaration for `T'
+
+ghci057.hs:3:3:
+ Data constructor `C' has existential type variables, a context, or a specialised result type
+ (Use -XExistentialQuantification or -XGADTs to allow this)
+ In the definition of data constructor `C'
+ In the data type declaration for `T'
+
+ghci057.hs:3:3:
+ Data constructor `C' has existential type variables, a context, or a specialised result type
+ (Use -XExistentialQuantification or -XGADTs to allow this)
+ In the definition of data constructor `C'
+ In the data type declaration for `T'
diff --git a/testsuite/tests/ghci/scripts/ghci057.stdout b/testsuite/tests/ghci/scripts/ghci057.stdout
new file mode 100644
index 0000000000..f97ea30c3d
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/ghci057.stdout
@@ -0,0 +1,53 @@
+options currently set: none.
+base language is: Haskell2010
+with the following modifiers:
+ -XNoDatatypeContexts
+ -XNondecreasingIndentation
+GHCi-specific dynamic flag settings:
+other dynamic, non-language, flag settings:
+ -fno-ghci-history
+ -fimplicit-import-qualified
+warning settings:
+Should fail, GADTs is not enabled
+options currently set: none.
+base language is: Haskell2010
+with the following modifiers:
+ -XGADTs
+ -XGADTSyntax
+ -XNoDatatypeContexts
+ -XNondecreasingIndentation
+ -XMonoLocalBinds
+GHCi-specific dynamic flag settings:
+other dynamic, non-language, flag settings:
+ -fno-ghci-history
+ -fimplicit-import-qualified
+warning settings:
+Should work, GADTs is in force from :set
+options currently set: none.
+base language is: Haskell2010
+with the following modifiers:
+ -XGADTSyntax
+ -XNoDatatypeContexts
+ -XNondecreasingIndentation
+ -XMonoLocalBinds
+GHCi-specific dynamic flag settings:
+other dynamic, non-language, flag settings:
+ -fno-ghci-history
+ -fimplicit-import-qualified
+warning settings:
+Should fail, GADTs is now disabled
+base language is: Haskell2010
+with the following modifiers:
+ -XGADTs
+ -XGADTSyntax
+ -XNoDatatypeContexts
+ -XNondecreasingIndentation
+ -XMonoLocalBinds
+ -XExtendedDefaultRules
+GHCi-specific dynamic flag settings:
+other dynamic, non-language, flag settings:
+ -fno-ghci-history
+ -fimplicit-import-qualified
+warning settings:
+Should fail, GADTs is only enabled at the prompt
+C :: T Int
diff --git a/testsuite/tests/indexed-types/should_compile/Simple14.stderr b/testsuite/tests/indexed-types/should_compile/Simple14.stderr
index c86fffe2fe..18221db64e 100644
--- a/testsuite/tests/indexed-types/should_compile/Simple14.stderr
+++ b/testsuite/tests/indexed-types/should_compile/Simple14.stderr
@@ -7,7 +7,7 @@ Simple14.hs:17:12:
Maybe m ~ Maybe n => EQ_ z0 z0
`n' is a rigid type variable bound by
the type signature for foo :: EQ_ (Maybe m) (Maybe n)
- at Simple14.hs:17:1
+ at Simple14.hs:16:17
Expected type: EQ_ z0 z0
Actual type: EQ_ m n
In the second argument of `eqE', namely `(eqI :: EQ_ m n)'
diff --git a/testsuite/tests/indexed-types/should_compile/T3017.stderr b/testsuite/tests/indexed-types/should_compile/T3017.stderr
index d0eed54eb1..d92f29fbd8 100644
--- a/testsuite/tests/indexed-types/should_compile/T3017.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3017.stderr
@@ -9,6 +9,7 @@ TYPE CONSTRUCTORS
type family Elem c :: *
empty :: c insert :: Elem c -> c -> c
data ListColl a
+ No C type associated
RecFlag NonRecursive
= L :: forall a. [a] -> ListColl a Stricts: _
FamilyInstance: none
diff --git a/testsuite/tests/indexed-types/should_compile/T3208b.stderr b/testsuite/tests/indexed-types/should_compile/T3208b.stderr
index f8c8db4bcc..292a91a674 100644
--- a/testsuite/tests/indexed-types/should_compile/T3208b.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T3208b.stderr
@@ -4,7 +4,7 @@ T3208b.hs:15:10:
from the context (OTerm a ~ STerm a, OBJECT a, SUBST a)
bound by the type signature for
fce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c
- at T3208b.hs:15:1-22
+ at T3208b.hs:14:9-56
NB: `STerm' is a type function, and may not be injective
The type variable `a0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
@@ -18,7 +18,7 @@ T3208b.hs:15:15:
from the context (OTerm a ~ STerm a, OBJECT a, SUBST a)
bound by the type signature for
fce' :: (OTerm a ~ STerm a, OBJECT a, SUBST a) => a -> c
- at T3208b.hs:15:1-22
+ at T3208b.hs:14:9-56
The type variable `a0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
In the first argument of `fce', namely `(apply f)'
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index 9e37129f2c..fd39b363df 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -21,7 +21,7 @@ test('Simple16', normal, compile, [''])
test('Simple17', normal, compile, [''])
test('Simple18', normal, compile, [''])
test('Simple19', normal, compile, [''])
-test('Simple20', expect_broken(4296), compile, ['-fcontext-stack=50'])
+test('Simple20', expect_broken(4296), compile, ['-fcontext-stack=10'])
test('Simple21', normal, compile, [''])
test('Simple22', normal, compile, [''])
test('Simple23', normal, compile, [''])
diff --git a/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr b/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr
index 6ec39c3daf..a6010f6711 100644
--- a/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr
+++ b/testsuite/tests/indexed-types/should_fail/GADTwrong1.stderr
@@ -7,7 +7,7 @@ GADTwrong1.hs:12:19:
in a case alternative
at GADTwrong1.hs:12:12-14
`b' is a rigid type variable bound by
- the type signature for coerce :: a -> b at GADTwrong1.hs:11:1
+ the type signature for coerce :: a -> b at GADTwrong1.hs:10:20
`a1' is a rigid type variable bound by
a pattern with constructor
T :: forall a. a -> T (Const a),
diff --git a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
index 77d93e87ff..003c014470 100644
--- a/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
+++ b/testsuite/tests/indexed-types/should_fail/NoMatchErr.stderr
@@ -3,7 +3,7 @@ NoMatchErr.hs:20:5:
Could not deduce (Memo d ~ Memo d0)
from the context (Fun d)
bound by the type signature for f :: Fun d => Memo d a -> Memo d a
- at NoMatchErr.hs:20:1-15
+ at NoMatchErr.hs:19:7-37
NB: `Memo' is a type function, and may not be injective
The type variable `d0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr
index 9af6037bbe..e9615eddc3 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11a.stderr
@@ -1,10 +1,10 @@
-SimpleFail11a.hs:8:15:
+SimpleFail11a.hs:6:15:
Conflicting family instance declarations:
- data instance C9 Int Int -- Defined at SimpleFail11a.hs:8:15
data instance C9 Int Int -- Defined at SimpleFail11a.hs:6:15
+ data instance C9 Int Int -- Defined at SimpleFail11a.hs:8:15
-SimpleFail11a.hs:13:15:
+SimpleFail11a.hs:11:15:
Conflicting family instance declarations:
- type instance D9 Int Int -- Defined at SimpleFail11a.hs:13:15
type instance D9 Int Int -- Defined at SimpleFail11a.hs:11:15
+ type instance D9 Int Int -- Defined at SimpleFail11a.hs:13:15
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr
index 46eb582aeb..297a18c5d5 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11b.stderr
@@ -1,10 +1,10 @@
-SimpleFail11b.hs:9:15:
+SimpleFail11b.hs:7:15:
Conflicting family instance declarations:
- data instance C9 [a] Int -- Defined at SimpleFail11b.hs:9:15
data instance C9 [a] Int -- Defined at SimpleFail11b.hs:7:15
+ data instance C9 [a] Int -- Defined at SimpleFail11b.hs:9:15
-SimpleFail11b.hs:15:15:
+SimpleFail11b.hs:13:15:
Conflicting family instance declarations:
- type instance D9 [a] Int -- Defined at SimpleFail11b.hs:15:15
type instance D9 [a] Int -- Defined at SimpleFail11b.hs:13:15
+ type instance D9 [a] Int -- Defined at SimpleFail11b.hs:15:15
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr
index 61f1553fcf..39870055e5 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11c.stderr
@@ -4,7 +4,7 @@ SimpleFail11c.hs:7:15:
data instance C9 [a] Int -- Defined at SimpleFail11c.hs:7:15
data instance C9 [Int] Int -- Defined at SimpleFail11c.hs:9:15
-SimpleFail11c.hs:15:15:
+SimpleFail11c.hs:13:15:
Conflicting family instance declarations:
- type instance D9 [Int] Int -- Defined at SimpleFail11c.hs:15:15
type instance D9 [a] Int -- Defined at SimpleFail11c.hs:13:15
+ type instance D9 [Int] Int -- Defined at SimpleFail11c.hs:15:15
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr
index 0999d49fae..062d29d8f2 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail11d.stderr
@@ -1,5 +1,5 @@
-SimpleFail11d.hs:10:15:
+SimpleFail11d.hs:8:15:
Conflicting family instance declarations:
- data instance C9 [a] [Int] -- Defined at SimpleFail11d.hs:10:15
data instance C9 [Int] [a] -- Defined at SimpleFail11d.hs:8:15
+ data instance C9 [a] [Int] -- Defined at SimpleFail11d.hs:10:15
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr
index 8f97746510..e2b7bba314 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail15.stderr
@@ -1,6 +1,6 @@
-
-SimpleFail15.hs:5:1:
- Illegal polymorphic or qualified type: a ~ b => t
- Perhaps you intended to use -XRankNTypes or -XRank2Types
- In the type signature for `foo':
- foo :: (a, b) -> (a ~ b => t) -> (a, b)
+
+SimpleFail15.hs:5:8:
+ Illegal polymorphic or qualified type: a ~ b => t
+ Perhaps you intended to use -XRankNTypes or -XRank2Types
+ In the type signature for `foo':
+ foo :: (a, b) -> (a ~ b => t) -> (a, b)
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
index 861ef5c869..b35b3712ee 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail5a.stderr
@@ -3,7 +3,7 @@ SimpleFail5a.hs:31:11:
Couldn't match type `a' with `Int'
`a' is a rigid type variable bound by
the type signature for bar3wrong :: S3 a -> a
- at SimpleFail5a.hs:31:1
+ at SimpleFail5a.hs:30:17
Expected type: S3 a
Actual type: S3 Int
In the pattern: D3Int
diff --git a/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr
index c5c7e8a86a..679aaf8722 100644
--- a/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SimpleFail6.stderr
@@ -1,2 +1,5 @@
-SimpleFail6.hs:7:11: Illegal repeated type variable `a'
+SimpleFail6.hs:7:11:
+ Conflicting definitions for `a'
+ Bound at: SimpleFail6.hs:7:11
+ SimpleFail6.hs:7:13
diff --git a/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs
index 2d51ea42fc..1696a454dd 100644
--- a/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs
+++ b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fcontext-stack=10 #-}
+{-# OPTIONS_GHC -fcontext-stack=3 #-}
{-# LANGUAGE TypeFamilies, FlexibleContexts, EmptyDataDecls #-}
module SkolemOccursLoop where
diff --git a/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr
index 0900da8e33..d1eb0efcb5 100644
--- a/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr
+++ b/testsuite/tests/indexed-types/should_fail/SkolemOccursLoop.stderr
@@ -1,10 +1 @@
-
-SkolemOccursLoop.hs:18:0:
- Couldn't match expected type `F a'
- against inferred type `[T (F (T (F a)))]'
- When generalising the type(s) for `test1'
-
-SkolemOccursLoop.hs:31:0:
- Couldn't match expected type `S (G (a, a))'
- against inferred type `G [S (G (a, a))]'
- When generalising the type(s) for `test2'
+Skolem occurs loop
diff --git a/testsuite/tests/indexed-types/should_fail/T1900.stderr b/testsuite/tests/indexed-types/should_fail/T1900.stderr
index 2044c6cab8..8ea8471d71 100644
--- a/testsuite/tests/indexed-types/should_fail/T1900.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T1900.stderr
@@ -11,7 +11,7 @@ T1900.hs:14:22:
Could not deduce (Depend s0 ~ Depend s)
from the context (Bug s)
bound by the type signature for check :: Bug s => Depend s -> Bool
- at T1900.hs:14:1-22
+ at T1900.hs:13:10-36
NB: `Depend' is a type function, and may not be injective
The type variable `s0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
diff --git a/testsuite/tests/indexed-types/should_fail/T2334.stderr b/testsuite/tests/indexed-types/should_fail/T2334.stderr
index 5bb3e24c22..deceb48755 100644
--- a/testsuite/tests/indexed-types/should_fail/T2334.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2334.stderr
@@ -11,7 +11,7 @@ T2334.hs:10:27:
In the definition of data constructor `H'
In the newtype instance declaration for `F'
-T2334.hs:13:15:
+T2334.hs:12:15:
Conflicting family instance declarations:
- data instance F Bool -- Defined at T2334.hs:13:15
data instance F Bool -- Defined at T2334.hs:12:15
+ data instance F Bool -- Defined at T2334.hs:13:15
diff --git a/testsuite/tests/indexed-types/should_fail/T2677.stderr b/testsuite/tests/indexed-types/should_fail/T2677.stderr
index e1c08e3b15..d160b2a89c 100644
--- a/testsuite/tests/indexed-types/should_fail/T2677.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T2677.stderr
@@ -1,5 +1,5 @@
-T2677.hs:7:15:
+T2677.hs:6:15:
Conflicting family instance declarations:
- type instance A Int -- Defined at T2677.hs:7:15
type instance A a -- Defined at T2677.hs:6:15
+ type instance A Int -- Defined at T2677.hs:7:15
diff --git a/testsuite/tests/indexed-types/should_fail/T3330a.stderr b/testsuite/tests/indexed-types/should_fail/T3330a.stderr
index d8b5d2606d..9cd0995a05 100644
--- a/testsuite/tests/indexed-types/should_fail/T3330a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3330a.stderr
@@ -1,22 +1,22 @@
-
-T3330a.hs:19:34:
- Couldn't match type `s' with `(->) (s0 ix1 -> ix1)'
- `s' is a rigid type variable bound by
- the type signature for children :: s ix -> PF s r ix -> [AnyF s]
- at T3330a.hs:19:1
- Expected type: (s0 ix0 -> ix1) -> r ix1 -> Writer [AnyF s] (r ix1)
- Actual type: s ix
- In the first argument of `hmapM', namely `p'
- In the first argument of `execWriter', namely `(hmapM p collect x)'
- In the expression: execWriter (hmapM p collect x)
-
-T3330a.hs:19:36:
- Couldn't match type `ix' with `r ix0 -> Writer [AnyF s0] (r ix0)'
- `ix' is a rigid type variable bound by
- the type signature for children :: s ix -> PF s r ix -> [AnyF s]
- at T3330a.hs:19:1
- Expected type: s0 ix0 -> ix
- Actual type: s0 ix0 -> r ix0 -> Writer [AnyF s0] (r ix0)
- In the second argument of `hmapM', namely `collect'
- In the first argument of `execWriter', namely `(hmapM p collect x)'
- In the expression: execWriter (hmapM p collect x)
+
+T3330a.hs:19:34:
+ Couldn't match type `s' with `(->) (s0 ix1 -> ix1)'
+ `s' is a rigid type variable bound by
+ the type signature for children :: s ix -> PF s r ix -> [AnyF s]
+ at T3330a.hs:18:13
+ Expected type: (s0 ix0 -> ix1) -> r ix1 -> Writer [AnyF s] (r ix1)
+ Actual type: s ix
+ In the first argument of `hmapM', namely `p'
+ In the first argument of `execWriter', namely `(hmapM p collect x)'
+ In the expression: execWriter (hmapM p collect x)
+
+T3330a.hs:19:36:
+ Couldn't match type `ix' with `r ix0 -> Writer [AnyF s0] (r ix0)'
+ `ix' is a rigid type variable bound by
+ the type signature for children :: s ix -> PF s r ix -> [AnyF s]
+ at T3330a.hs:18:15
+ Expected type: s0 ix0 -> ix
+ Actual type: s0 ix0 -> r ix0 -> Writer [AnyF s0] (r ix0)
+ In the second argument of `hmapM', namely `collect'
+ In the first argument of `execWriter', namely `(hmapM p collect x)'
+ In the expression: execWriter (hmapM p collect x)
diff --git a/testsuite/tests/indexed-types/should_fail/T3330c.stderr b/testsuite/tests/indexed-types/should_fail/T3330c.stderr
index b9db62a887..b7341bbd1e 100644
--- a/testsuite/tests/indexed-types/should_fail/T3330c.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3330c.stderr
@@ -1,20 +1,10 @@
T3330c.hs:23:43:
- Could not deduce (f1 ~ t0 x)
- from the context (f ~ (f1 :+: g))
- bound by a pattern with constructor
- RSum :: forall (f :: * -> *) (g :: * -> *).
- R f -> R g -> R (f :+: g),
- in an equation for plug'
- at T3330c.hs:23:8-17
- `f1' is a rigid type variable bound by
- a pattern with constructor
- RSum :: forall (f :: * -> *) (g :: * -> *).
- R f -> R g -> R (f :+: g),
- in an equation for plug'
- at T3330c.hs:23:8
+ Couldn't match kind `* -> *' with `*'
Expected type: Der ((->) x) (t0 x)
Actual type: R f1
+ Kind incompatibility when matching types:
+ f1 :: * -> *
+ t0 x :: *
In the first argument of `plug', namely `rf'
In the first argument of `Inl', namely `(plug rf df x)'
- In the expression: Inl (plug rf df x)
diff --git a/testsuite/tests/indexed-types/should_fail/T3440.stderr b/testsuite/tests/indexed-types/should_fail/T3440.stderr
index 4e77eef70e..772d26c1be 100644
--- a/testsuite/tests/indexed-types/should_fail/T3440.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T3440.stderr
@@ -8,7 +8,7 @@ T3440.hs:11:22:
at T3440.hs:11:9-16
`a' is a rigid type variable bound by
the type signature for unwrap :: GADT (Fam a) -> (a, Fam a)
- at T3440.hs:11:1
+ at T3440.hs:10:21
`a1' is a rigid type variable bound by
a pattern with constructor
GADT :: forall a. a -> Fam a -> GADT (Fam a),
diff --git a/testsuite/tests/indexed-types/should_fail/T4093a.stderr b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
index 0b36936be9..bb6d5b915f 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093a.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093a.stderr
@@ -3,10 +3,10 @@ T4093a.hs:8:8:
Could not deduce (e ~ ())
from the context (Foo e ~ Maybe e)
bound by the type signature for hang :: Foo e ~ Maybe e => Foo e
- at T4093a.hs:8:1-14
+ at T4093a.hs:7:9-34
`e' is a rigid type variable bound by
the type signature for hang :: Foo e ~ Maybe e => Foo e
- at T4093a.hs:8:1
+ at T4093a.hs:7:14
Expected type: Foo e
Actual type: Maybe ()
In the return type of a call of `Just'
diff --git a/testsuite/tests/indexed-types/should_fail/T4093b.stderr b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
index 6818e006ef..948ba565df 100644
--- a/testsuite/tests/indexed-types/should_fail/T4093b.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4093b.stderr
@@ -7,13 +7,13 @@ T4093b.hs:31:13:
blockToNodeList :: (EitherCO e (A C O n) (A O O n) ~ A e O n,
EitherCO x (A C C n) (A C O n) ~ A C x n) =>
Block n e x -> A e x n
- at T4093b.hs:(25,1)-(34,19)
+ at T4093b.hs:(20,3)-(22,26)
`e' is a rigid type variable bound by
the type signature for
blockToNodeList :: (EitherCO e (A C O n) (A O O n) ~ A e O n,
EitherCO x (A C C n) (A C O n) ~ A C x n) =>
Block n e x -> A e x n
- at T4093b.hs:25:1
+ at T4093b.hs:20:12
Expected type: EitherCO e (A C O n) (A O O n)
Actual type: (MaybeC C (n C O), MaybeC O (n O C))
In the expression: (JustC n, NothingC)
diff --git a/testsuite/tests/indexed-types/should_fail/T4179.stderr b/testsuite/tests/indexed-types/should_fail/T4179.stderr
index 021e73e413..35209c591f 100644
--- a/testsuite/tests/indexed-types/should_fail/T4179.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4179.stderr
@@ -6,7 +6,7 @@ T4179.hs:26:16:
bound by the type signature for
fCon :: (Functor x, DoC (FCon x)) =>
Con x -> A2 (FCon x) -> A3 (FCon x)
- at T4179.hs:26:1-17
+ at T4179.hs:25:9-72
NB: `A3' is a type function, and may not be injective
Expected type: x (A2 (x (Con x)) -> A3 (x (Con x)))
-> A2 (x (Con x)) -> A3 (x (Con x))
diff --git a/testsuite/tests/indexed-types/should_fail/T4246.stderr b/testsuite/tests/indexed-types/should_fail/T4246.stderr
index fe1cfce250..14bd8ba407 100644
--- a/testsuite/tests/indexed-types/should_fail/T4246.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4246.stderr
@@ -4,7 +4,7 @@ T4246.hs:8:9:
type F a -- Defined at T4246.hs:8:9
type F Int -- Defined at T4246.hs:11:9
-T4246.hs:15:15:
+T4246.hs:14:15:
Conflicting family instance declarations:
- type instance G Int -- Defined at T4246.hs:15:15
type instance G Int -- Defined at T4246.hs:14:15
+ type instance G Int -- Defined at T4246.hs:15:15
diff --git a/testsuite/tests/indexed-types/should_fail/T4272.stderr b/testsuite/tests/indexed-types/should_fail/T4272.stderr
index 0a6b3be8ff..24f0cbdff4 100644
--- a/testsuite/tests/indexed-types/should_fail/T4272.stderr
+++ b/testsuite/tests/indexed-types/should_fail/T4272.stderr
@@ -27,10 +27,10 @@ T4272.hs:11:19:
from the context (TermLike a)
bound by the type signature for
laws :: TermLike a => TermFamily a a -> b
- at T4272.hs:11:1-54
+ at T4272.hs:10:9-53
`a' is a rigid type variable bound by
the type signature for laws :: TermLike a => TermFamily a a -> b
- at T4272.hs:11:1
+ at T4272.hs:10:16
In the return type of a call of `terms'
In the second argument of `prune', namely
`(terms (undefined :: TermFamily a a))'
diff --git a/testsuite/tests/lib/Data.ByteString/Makefile b/testsuite/tests/lib/Data.ByteString/Makefile
deleted file mode 100644
index 9101fbd40a..0000000000
--- a/testsuite/tests/lib/Data.ByteString/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/lib/Data.ByteString/all.T b/testsuite/tests/lib/Data.ByteString/all.T
deleted file mode 100644
index 75c5574302..0000000000
--- a/testsuite/tests/lib/Data.ByteString/all.T
+++ /dev/null
@@ -1,18 +0,0 @@
-test('bytestring001',
- [skip, # This is designed for an earlier version of bytestring
- reqlib('QuickCheck')],
- compile_and_run,
- ['-package bytestring -package QuickCheck'])
-test('bytestring002', normal, compile_and_run, ['-package bytestring'])
-test('bytestring003', normal, compile_and_run, ['-package bytestring'])
-test('bytestring004',
- [skip, # This is designed for an earlier version of bytestring
- reqlib('QuickCheck')],
- compile_and_run,
- ['-package bytestring -package QuickCheck'])
-test('bytestring005',
- [skip, # This is designed for an earlier version of bytestring
- reqlib('QuickCheck')],
- compile_and_run,
- ['-package bytestring -package QuickCheck'])
-test('bytestring006', normal, compile_and_run, ['-package bytestring'])
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring001.hs b/testsuite/tests/lib/Data.ByteString/bytestring001.hs
deleted file mode 100644
index 00cfcb3763..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring001.hs
+++ /dev/null
@@ -1,948 +0,0 @@
-#!/usr/bin/env runhaskell
---
--- Uses multi-param type classes
---
-
-import Test.QuickCheck.Batch
-import Test.QuickCheck
-import Text.Show.Functions
-
-import Data.Char
-import Data.Int
-import Data.List
-import Data.Maybe
-import Data.Word
-
-import System.IO
-import System.Environment
-import System.IO.Unsafe
-import System.Random
-
-import Control.Monad ( liftM2 )
-import Control.Monad.Instances ()
-
-import Text.Printf
-import Debug.Trace
-
-import Foreign.Ptr
-
-import Data.ByteString.Lazy (ByteString(..), pack , unpack)
-import qualified Data.ByteString.Lazy as L
-
-import Data.ByteString.Fusion
-import qualified Data.ByteString as P
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Internal as L
-
-import qualified Data.ByteString.Char8 as PC
-import qualified Data.ByteString.Lazy.Char8 as LC
-import qualified Data.ByteString as P
-import qualified Data.ByteString.Internal as P
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy.Char8 as D
-import Data.ByteString.Fusion
-
-import Prelude hiding (abs)
-
--- Enable this to get verbose test output. Including the actual tests.
-debug = False
-
-mytest :: Testable a => a -> Int -> IO ()
-mytest a n = mycheck defaultConfig
- { configMaxTest=n
- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
-
-mycheck :: Testable a => Config -> a -> IO ()
-mycheck config a =
- do let rnd = mkStdGen 99
- mytests config (evaluate a) rnd 0 0 []
-
-mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()
-mytests config gen rnd0 ntest nfail stamps
- | ntest == configMaxTest config = do done "OK," ntest stamps
- | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
- | otherwise =
- do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
- case ok result of
- Nothing ->
- mytests config gen rnd1 ntest (nfail+1) stamps
- Just True ->
- mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
- Just False ->
- putStr ( "Falsifiable after "
- ++ show ntest
- ++ " tests:\n"
- ++ unlines (arguments result)
- ) >> hFlush stdout
- where
- result = generate (configSize config ntest) rnd2 gen
- (rnd1,rnd2) = split rnd0
-
-done :: String -> Int -> [[String]] -> IO ()
-done mesg ntest stamps =
- do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
- where
- table = display
- . map entry
- . reverse
- . sort
- . map pairLength
- . group
- . sort
- . filter (not . null)
- $ stamps
-
- display [] = ".\n"
- display [x] = " (" ++ x ++ ").\n"
- display xs = ".\n" ++ unlines (map (++ ".") xs)
-
- pairLength xss@(xs:_) = (length xss, xs)
- entry (n, xs) = percentage n ntest
- ++ " "
- ++ concat (intersperse ", " xs)
-
- percentage n m = show ((100 * n) `div` m) ++ "%"
-
-------------------------------------------------------------------------
-
-instance Arbitrary Char where
- arbitrary = choose ('a', 'i')
- coarbitrary c = variant (ord c `rem` 4)
-
-instance (Arbitrary a, Arbitrary b) => Arbitrary (PairS a b) where
- arbitrary = liftM2 (:*:) arbitrary arbitrary
- coarbitrary (a :*: b) = coarbitrary a . coarbitrary b
-
-instance Arbitrary Word8 where
- arbitrary = choose (97, 105)
- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))
-
-instance Arbitrary Int64 where
- arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n)
- coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1))
-
-instance Arbitrary a => Arbitrary (MaybeS a) where
- arbitrary = do a <- arbitrary ; elements [NothingS, JustS a]
- coarbitrary NothingS = variant 0
- coarbitrary _ = variant 1 -- ok?
-
-{-
-instance Arbitrary Char where
- arbitrary = choose ('\0', '\255') -- since we have to test words, unlines too
- coarbitrary c = variant (ord c `rem` 16)
-
-instance Arbitrary Word8 where
- arbitrary = choose (minBound, maxBound)
- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 16))
--}
-
-instance Random Word8 where
- randomR = integralRandomR
- random = randomR (minBound,maxBound)
-
-instance Random Int64 where
- randomR = integralRandomR
- random = randomR (minBound,maxBound)
-
-integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
-integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
- fromIntegral b :: Integer) g of
- (x,g) -> (fromIntegral x, g)
-
-instance Arbitrary L.ByteString where
- arbitrary = arbitrary >>= return . L.fromChunks . filter (not. P.null) -- maintain the invariant.
- coarbitrary s = coarbitrary (L.unpack s)
-
-instance Arbitrary P.ByteString where
- arbitrary = P.pack `fmap` arbitrary
- coarbitrary s = coarbitrary (P.unpack s)
-
-------------------------------------------------------------------------
---
--- We're doing two forms of testing here. Firstly, model based testing.
--- For our Lazy and strict bytestring types, we have model types:
---
--- i.e. Lazy == Byte
--- \\ //
--- List
---
--- That is, the Lazy type can be modeled by functions in both the Byte
--- and List type. For each of the 3 models, we have a set of tests that
--- check those types match.
---
--- The Model class connects a type and its model type, via a conversion
--- function.
---
---
-class Model a b where
- model :: a -> b -- get the abstract vale from a concrete value
-
---
--- Connecting our Lazy and Strict types to their models. We also check
--- the data invariant on Lazy types.
---
--- These instances represent the arrows in the above diagram
---
-instance Model B P where model = abstr . checkInvariant
-instance Model P [W] where model = P.unpack
-instance Model P [Char] where model = PC.unpack
-instance Model B [W] where model = L.unpack . checkInvariant
-instance Model B [Char] where model = LC.unpack . checkInvariant
-
--- Types are trivially modeled by themselves
-instance Model Bool Bool where model = id
-instance Model Int Int where model = id
-instance Model Int64 Int64 where model = id
-instance Model Int64 Int where model = fromIntegral
-instance Model Word8 Word8 where model = id
-instance Model Ordering Ordering where model = id
-
--- More structured types are modeled recursively, using the NatTrans class from Gofer.
-class (Functor f, Functor g) => NatTrans f g where
- eta :: f a -> g a
-
--- The transformation of the same type is identity
-instance NatTrans [] [] where eta = id
-instance NatTrans Maybe Maybe where eta = id
-instance NatTrans ((->) X) ((->) X) where eta = id
-instance NatTrans ((->) W) ((->) W) where eta = id
-
--- We have a transformation of pairs, if the pairs are in Model
-instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a)
-
--- And finally, we can take any (m a) to (n b), if we can Model m n, and a b
-instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x)
-
-------------------------------------------------------------------------
-
--- In a form more useful for QC testing (and it's lazy)
-checkInvariant :: L.ByteString -> L.ByteString
-checkInvariant cs0 = check cs0
- where check L.Empty = L.Empty
- check (L.Chunk c cs)
- | P.null c = error ("invariant violation: " ++ show cs0)
- | otherwise = L.Chunk c (check cs)
-
-abstr :: L.ByteString -> P.ByteString
-abstr = P.concat . L.toChunks
-
-
--- Some short hand.
-type X = Int
-type W = Word8
-type P = P.ByteString
-type B = L.ByteString
-
-------------------------------------------------------------------------
---
--- These comparison functions handle wrapping and equality.
---
--- A single class for these would be nice, but note that they differe in
--- the number of arguments, and those argument types, so we'd need HList
--- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs
---
-
-eq1 f g = \a ->
- model (f a) == g (model a)
-eq2 f g = \a b ->
- model (f a b) == g (model a) (model b)
-eq3 f g = \a b c ->
- model (f a b c) == g (model a) (model b) (model c)
-eq4 f g = \a b c d ->
- model (f a b c d) == g (model a) (model b) (model c) (model d)
-eq5 f g = \a b c d e ->
- model (f a b c d e) == g (model a) (model b) (model c) (model d) (model e)
-
---
--- And for functions that take non-null input
---
-eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x
-eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y
-eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z
-
-class IsNull t where isNull :: t -> Bool
-instance IsNull L.ByteString where isNull = L.null
-instance IsNull P.ByteString where isNull = P.null
-
-------------------------------------------------------------------------
-
-
---
--- ByteString.Lazy <=> ByteString
---
-
-prop_concatBP = L.concat `eq1` P.concat
-prop_nullBP = L.null `eq1` P.null
-prop_reverseBP = L.reverse `eq1` P.reverse
-prop_transposeBP = L.transpose `eq1` P.transpose
-prop_groupBP = L.group `eq1` P.group
-prop_initsBP = L.inits `eq1` P.inits
-prop_tailsBP = L.tails `eq1` P.tails
-prop_allBP = L.all `eq2` P.all
-prop_anyBP = L.any `eq2` P.any
-prop_appendBP = L.append `eq2` P.append
-prop_breakBP = L.break `eq2` P.break
--- prop_concatMapBP = L.concatMap `eq2` P.concatMap
-prop_consBP = L.cons `eq2` P.cons
-prop_countBP = L.count `eq2` P.count
-prop_dropBP = L.drop `eq2` P.drop
-prop_dropWhileBP = L.dropWhile `eq2` P.dropWhile
-prop_filterBP = L.filter `eq2` P.filter
-prop_findBP = L.find `eq2` P.find
-prop_findIndexBP = L.findIndex `eq2` P.findIndex
-prop_findIndicesBP = L.findIndices `eq2` P.findIndices
-prop_isPrefixOfBP = L.isPrefixOf `eq2` P.isPrefixOf
-prop_mapBP = L.map `eq2` P.map
-prop_replicateBP = L.replicate `eq2` P.replicate
-prop_snocBP = L.snoc `eq2` P.snoc
-prop_spanBP = L.span `eq2` P.span
-prop_splitBP = L.split `eq2` P.split
-prop_splitAtBP = L.splitAt `eq2` P.splitAt
-prop_takeBP = L.take `eq2` P.take
-prop_takeWhileBP = L.takeWhile `eq2` P.takeWhile
-prop_elemBP = L.elem `eq2` P.elem
-prop_notElemBP = L.notElem `eq2` P.notElem
-prop_elemIndexBP = L.elemIndex `eq2` P.elemIndex
-prop_elemIndicesBP = L.elemIndices `eq2` P.elemIndices
-prop_lengthBP = L.length `eq1` (fromIntegral . P.length :: P.ByteString -> Int64)
-prop_readIntBP = D.readInt `eq1` C.readInt
-prop_linesBP = D.lines `eq1` C.lines
-
-prop_headBP = L.head `eqnotnull1` P.head
-prop_initBP = L.init `eqnotnull1` P.init
-prop_lastBP = L.last `eqnotnull1` P.last
-prop_maximumBP = L.maximum `eqnotnull1` P.maximum
-prop_minimumBP = L.minimum `eqnotnull1` P.minimum
-prop_tailBP = L.tail `eqnotnull1` P.tail
-prop_foldl1BP = L.foldl1 `eqnotnull2` P.foldl1
-prop_foldl1BP' = L.foldl1' `eqnotnull2` P.foldl1'
-prop_foldr1BP = L.foldr1 `eqnotnull2` P.foldr1
-prop_scanlBP = L.scanl `eqnotnull3` P.scanl
-
-prop_eqBP = eq2
- ((==) :: B -> B -> Bool)
- ((==) :: P -> P -> Bool)
-prop_compareBP = eq2
- ((compare) :: B -> B -> Ordering)
- ((compare) :: P -> P -> Ordering)
-prop_foldlBP = eq3
- (L.foldl :: (X -> W -> X) -> X -> B -> X)
- (P.foldl :: (X -> W -> X) -> X -> P -> X)
-prop_foldlBP' = eq3
- (L.foldl' :: (X -> W -> X) -> X -> B -> X)
- (P.foldl' :: (X -> W -> X) -> X -> P -> X)
-prop_foldrBP = eq3
- (L.foldr :: (W -> X -> X) -> X -> B -> X)
- (P.foldr :: (W -> X -> X) -> X -> P -> X)
-prop_mapAccumLBP = eq3
- (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))
- (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))
-
-prop_unfoldrBP = eq3
- ((\n f a -> L.take (fromIntegral n) $
- L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)
- ((\n f a -> fst $
- P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)
-
---
--- properties comparing ByteString.Lazy `eq1` List
---
-
-prop_concatBL = L.concat `eq1` (concat :: [[W]] -> [W])
-prop_lengthBL = L.length `eq1` (length :: [W] -> Int)
-prop_nullBL = L.null `eq1` (null :: [W] -> Bool)
-prop_reverseBL = L.reverse `eq1` (reverse :: [W] -> [W])
-prop_transposeBL = L.transpose `eq1` (transpose :: [[W]] -> [[W]])
-prop_groupBL = L.group `eq1` (group :: [W] -> [[W]])
-prop_initsBL = L.inits `eq1` (inits :: [W] -> [[W]])
-prop_tailsBL = L.tails `eq1` (tails :: [W] -> [[W]])
-prop_allBL = L.all `eq2` (all :: (W -> Bool) -> [W] -> Bool)
-prop_anyBL = L.any `eq2` (any :: (W -> Bool) -> [W] -> Bool)
-prop_appendBL = L.append `eq2` ((++) :: [W] -> [W] -> [W])
-prop_breakBL = L.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W]))
--- prop_concatMapBL = L.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W])
-prop_consBL = L.cons `eq2` ((:) :: W -> [W] -> [W])
-prop_dropBL = L.drop `eq2` (drop :: Int -> [W] -> [W])
-prop_dropWhileBL = L.dropWhile `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W])
-prop_filterBL = L.filter `eq2` (filter :: (W -> Bool ) -> [W] -> [W])
-prop_findBL = L.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W)
-prop_findIndicesBL = L.findIndices `eq2` (findIndices:: (W -> Bool) -> [W] -> [Int])
-prop_findIndexBL = L.findIndex `eq2` (findIndex :: (W -> Bool) -> [W] -> Maybe Int)
-prop_isPrefixOfBL = L.isPrefixOf `eq2` (isPrefixOf:: [W] -> [W] -> Bool)
-prop_mapBL = L.map `eq2` (map :: (W -> W) -> [W] -> [W])
-prop_replicateBL = L.replicate `eq2` (replicate :: Int -> W -> [W])
-prop_snocBL = L.snoc `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])
-prop_spanBL = L.span `eq2` (span :: (W -> Bool) -> [W] -> ([W],[W]))
-prop_splitAtBL = L.splitAt `eq2` (splitAt :: Int -> [W] -> ([W],[W]))
-prop_takeBL = L.take `eq2` (take :: Int -> [W] -> [W])
-prop_takeWhileBL = L.takeWhile `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W])
-prop_elemBL = L.elem `eq2` (elem :: W -> [W] -> Bool)
-prop_notElemBL = L.notElem `eq2` (notElem :: W -> [W] -> Bool)
-prop_elemIndexBL = L.elemIndex `eq2` (elemIndex :: W -> [W] -> Maybe Int)
-prop_elemIndicesBL = L.elemIndices `eq2` (elemIndices:: W -> [W] -> [Int])
-prop_linesBL = D.lines `eq1` (lines :: String -> [String])
-
-prop_foldl1BL = L.foldl1 `eqnotnull2` (foldl1 :: (W -> W -> W) -> [W] -> W)
-prop_foldl1BL' = L.foldl1' `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W)
-prop_foldr1BL = L.foldr1 `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W)
-prop_headBL = L.head `eqnotnull1` (head :: [W] -> W)
-prop_initBL = L.init `eqnotnull1` (init :: [W] -> [W])
-prop_lastBL = L.last `eqnotnull1` (last :: [W] -> W)
-prop_maximumBL = L.maximum `eqnotnull1` (maximum :: [W] -> W)
-prop_minimumBL = L.minimum `eqnotnull1` (minimum :: [W] -> W)
-prop_tailBL = L.tail `eqnotnull1` (tail :: [W] -> [W])
-
-prop_eqBL = eq2
- ((==) :: B -> B -> Bool)
- ((==) :: [W] -> [W] -> Bool)
-prop_compareBL = eq2
- ((compare) :: B -> B -> Ordering)
- ((compare) :: [W] -> [W] -> Ordering)
-prop_foldlBL = eq3
- (L.foldl :: (X -> W -> X) -> X -> B -> X)
- ( foldl :: (X -> W -> X) -> X -> [W] -> X)
-prop_foldlBL' = eq3
- (L.foldl' :: (X -> W -> X) -> X -> B -> X)
- ( foldl' :: (X -> W -> X) -> X -> [W] -> X)
-prop_foldrBL = eq3
- (L.foldr :: (W -> X -> X) -> X -> B -> X)
- ( foldr :: (W -> X -> X) -> X -> [W] -> X)
-prop_mapAccumLBL = eq3
- (L.mapAccumL :: (X -> W -> (X,W)) -> X -> B -> (X, B))
- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
-prop_unfoldrBL = eq3
- ((\n f a -> L.take (fromIntegral n) $
- L.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> B)
- ((\n f a -> take n $
- unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])
-
---
--- And finally, check correspondance between Data.ByteString and List
---
-
-prop_lengthPL = (fromIntegral.P.length :: P -> Int) `eq1` (length :: [W] -> Int)
-prop_nullPL = P.null `eq1` (null :: [W] -> Bool)
-prop_reversePL = P.reverse `eq1` (reverse :: [W] -> [W])
-prop_transposePL = P.transpose `eq1` (transpose :: [[W]] -> [[W]])
-prop_groupPL = P.group `eq1` (group :: [W] -> [[W]])
-prop_initsPL = P.inits `eq1` (inits :: [W] -> [[W]])
-prop_tailsPL = P.tails `eq1` (tails :: [W] -> [[W]])
-prop_concatPL = P.concat `eq1` (concat :: [[W]] -> [W])
-prop_allPL = P.all `eq2` (all :: (W -> Bool) -> [W] -> Bool)
-prop_anyPL = P.any `eq2` (any :: (W -> Bool) -> [W] -> Bool)
-prop_appendPL = P.append `eq2` ((++) :: [W] -> [W] -> [W])
-prop_breakPL = P.break `eq2` (break :: (W -> Bool) -> [W] -> ([W],[W]))
--- prop_concatMapPL = P.concatMap `eq2` (concatMap :: (W -> [W]) -> [W] -> [W])
-prop_consPL = P.cons `eq2` ((:) :: W -> [W] -> [W])
-prop_dropPL = P.drop `eq2` (drop :: Int -> [W] -> [W])
-prop_dropWhilePL = P.dropWhile `eq2` (dropWhile :: (W -> Bool) -> [W] -> [W])
-prop_filterPL = P.filter `eq2` (filter :: (W -> Bool ) -> [W] -> [W])
-prop_findPL = P.find `eq2` (find :: (W -> Bool) -> [W] -> Maybe W)
-prop_findIndexPL = P.findIndex `eq2` (findIndex :: (W -> Bool) -> [W] -> Maybe Int)
-prop_isPrefixOfPL = P.isPrefixOf`eq2` (isPrefixOf:: [W] -> [W] -> Bool)
-prop_mapPL = P.map `eq2` (map :: (W -> W) -> [W] -> [W])
-prop_replicatePL = P.replicate `eq2` (replicate :: Int -> W -> [W])
-prop_snocPL = P.snoc `eq2` ((\xs x -> xs ++ [x]) :: [W] -> W -> [W])
-prop_spanPL = P.span `eq2` (span :: (W -> Bool) -> [W] -> ([W],[W]))
-prop_splitAtPL = P.splitAt `eq2` (splitAt :: Int -> [W] -> ([W],[W]))
-prop_takePL = P.take `eq2` (take :: Int -> [W] -> [W])
-prop_takeWhilePL = P.takeWhile `eq2` (takeWhile :: (W -> Bool) -> [W] -> [W])
-prop_elemPL = P.elem `eq2` (elem :: W -> [W] -> Bool)
-prop_notElemPL = P.notElem `eq2` (notElem :: W -> [W] -> Bool)
-prop_elemIndexPL = P.elemIndex `eq2` (elemIndex :: W -> [W] -> Maybe Int)
-prop_linesPL = C.lines `eq1` (lines :: String -> [String])
-prop_findIndicesPL= P.findIndices`eq2` (findIndices:: (W -> Bool) -> [W] -> [Int])
-prop_elemIndicesPL= P.elemIndices`eq2` (elemIndices:: W -> [W] -> [Int])
-
-prop_foldl1PL = P.foldl1 `eqnotnull2` (foldl1 :: (W -> W -> W) -> [W] -> W)
-prop_foldl1PL' = P.foldl1' `eqnotnull2` (foldl1' :: (W -> W -> W) -> [W] -> W)
-prop_foldr1PL = P.foldr1 `eqnotnull2` (foldr1 :: (W -> W -> W) -> [W] -> W)
-prop_scanlPL = P.scanl `eqnotnull3` (scanl :: (W -> W -> W) -> W -> [W] -> [W])
-prop_scanl1PL = P.scanl1 `eqnotnull2` (scanl1 :: (W -> W -> W) -> [W] -> [W])
-prop_scanrPL = P.scanr `eqnotnull3` (scanr :: (W -> W -> W) -> W -> [W] -> [W])
-prop_scanr1PL = P.scanr1 `eqnotnull2` (scanr1 :: (W -> W -> W) -> [W] -> [W])
-prop_headPL = P.head `eqnotnull1` (head :: [W] -> W)
-prop_initPL = P.init `eqnotnull1` (init :: [W] -> [W])
-prop_lastPL = P.last `eqnotnull1` (last :: [W] -> W)
-prop_maximumPL = P.maximum `eqnotnull1` (maximum :: [W] -> W)
-prop_minimumPL = P.minimum `eqnotnull1` (minimum :: [W] -> W)
-prop_tailPL = P.tail `eqnotnull1` (tail :: [W] -> [W])
-
-prop_eqPL = eq2
- ((==) :: P -> P -> Bool)
- ((==) :: [W] -> [W] -> Bool)
-prop_comparePL = eq2
- ((compare) :: P -> P -> Ordering)
- ((compare) :: [W] -> [W] -> Ordering)
-prop_foldlPL = eq3
- (P.foldl :: (X -> W -> X) -> X -> P -> X)
- ( foldl :: (X -> W -> X) -> X -> [W] -> X)
-prop_foldlPL' = eq3
- (P.foldl' :: (X -> W -> X) -> X -> P -> X)
- ( foldl' :: (X -> W -> X) -> X -> [W] -> X)
-prop_foldrPL = eq3
- (P.foldr :: (W -> X -> X) -> X -> P -> X)
- ( foldr :: (W -> X -> X) -> X -> [W] -> X)
-prop_mapAccumLPL= eq3
- (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))
- ( mapAccumL :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
-prop_mapAccumRPL= eq3
- (P.mapAccumR :: (X -> W -> (X,W)) -> X -> P -> (X, P))
- ( mapAccumR :: (X -> W -> (X,W)) -> X -> [W] -> (X, [W]))
-prop_unfoldrPL = eq3
- ((\n f a -> fst $
- P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)
- ((\n f a -> take n $
- unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> [W])
-
-------------------------------------------------------------------------
---
--- And check fusion RULES.
---
-
-prop_lazylooploop em1 em2 start1 start2 arr =
- loopL em2 start2 (loopArr (loopL em1 start1 arr)) ==
- loopSndAcc (loopL (em1 `fuseEFL` em2) (start1 :*: start2) arr)
- where
- _ = start1 :: Int
- _ = start2 :: Int
-
-prop_looploop em1 em2 start1 start2 arr =
- loopU em2 start2 (loopArr (loopU em1 start1 arr)) ==
- loopSndAcc (loopU (em1 `fuseEFL` em2) (start1 :*: start2) arr)
- where
- _ = start1 :: Int
- _ = start2 :: Int
-
-------------------------------------------------------------------------
-
--- check associativity of sequence loops
-prop_sequenceloops_assoc n m o x y z a1 a2 a3 xs =
-
- k ((f * g) * h) == k (f * (g * h)) -- associativity
-
- where
- (*) = sequenceLoops
- f = (sel n) x a1
- g = (sel m) y a2
- h = (sel o) z a3
-
- _ = a1 :: Int; _ = a2 :: Int; _ = a3 :: Int
- k g = loopArr (loopWrapper g xs)
-
--- check wrapper elimination
-prop_loop_loop_wrapper_elimination n m x y a1 a2 xs =
- loopWrapper g (loopArr (loopWrapper f xs)) ==
- loopSndAcc (loopWrapper (sequenceLoops f g) xs)
- where
- f = (sel n) x a1
- g = (sel m) y a2
- _ = a1 :: Int; _ = a2 :: Int
-
-sel :: Bool
- -> (acc -> Word8 -> PairS acc (MaybeS Word8))
- -> acc
- -> Ptr Word8
- -> Ptr Word8
- -> Int
- -> IO (PairS (PairS acc Int) Int)
-sel False = doDownLoop
-sel True = doUpLoop
-
-------------------------------------------------------------------------
---
--- Test fusion forms
---
-
-prop_up_up_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doUpLoop f1 acc1) (doUpLoop f2 acc2)) ==
- k (doUpLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs
-
-prop_down_down_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doDownLoop f1 acc1) (doDownLoop f2 acc2)) ==
- k (doDownLoop (f1 `fuseAccAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int ; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_noAcc_noAcc_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doNoAccLoop f1 acc1) (doNoAccLoop f2 acc2)) ==
- k (doNoAccLoop (f1 `fuseNoAccNoAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int ; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_noAcc_up_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doNoAccLoop f1 acc1) (doUpLoop f2 acc2)) ==
- k (doUpLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs
-
-prop_up_noAcc_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doUpLoop f1 acc1) (doNoAccLoop f2 acc2)) ==
- k (doUpLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs
-
-prop_noAcc_down_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doNoAccLoop f1 acc1) (doDownLoop f2 acc2)) ==
- k (doDownLoop (f1 `fuseNoAccAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_down_noAcc_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doDownLoop f1 acc1) (doNoAccLoop f2 acc2)) ==
- k (doDownLoop (f1 `fuseAccNoAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int; k g = loopWrapper g xs
-
-prop_map_map_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doMapLoop f1 acc1) (doMapLoop f2 acc2)) ==
- k (doMapLoop (f1 `fuseMapMapEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_filter_filter_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doFilterLoop f1 acc1) (doFilterLoop f2 acc2)) ==
- k (doFilterLoop (f1 `fuseFilterFilterEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_map_filter_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doMapLoop f1 acc1) (doFilterLoop f2 acc2)) ==
- k (doNoAccLoop (f1 `fuseMapFilterEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_filter_map_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doFilterLoop f1 acc1) (doMapLoop f2 acc2)) ==
- k (doNoAccLoop (f1 `fuseFilterMapEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_map_noAcc_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doMapLoop f1 acc1) (doNoAccLoop f2 acc2)) ==
- k (doNoAccLoop (f1 `fuseMapNoAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_noAcc_map_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doNoAccLoop f1 acc1) (doMapLoop f2 acc2)) ==
- k (doNoAccLoop (f1 `fuseNoAccMapEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_map_up_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doMapLoop f1 acc1) (doUpLoop f2 acc2)) ==
- k (doUpLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_up_map_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doUpLoop f1 acc1) (doMapLoop f2 acc2)) ==
- k (doUpLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_map_down_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doMapLoop f1 acc1) (doDownLoop f2 acc2)) ==
- k (doDownLoop (f1 `fuseMapAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_down_map_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doDownLoop f1 acc1) (doMapLoop f2 acc2)) ==
- k (doDownLoop (f1 `fuseAccMapEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_filter_noAcc_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doFilterLoop f1 acc1) (doNoAccLoop f2 acc2)) ==
- k (doNoAccLoop (f1 `fuseFilterNoAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_noAcc_filter_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doNoAccLoop f1 acc1) (doFilterLoop f2 acc2)) ==
- k (doNoAccLoop (f1 `fuseNoAccFilterEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_filter_up_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doFilterLoop f1 acc1) (doUpLoop f2 acc2)) ==
- k (doUpLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_up_filter_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doUpLoop f1 acc1) (doFilterLoop f2 acc2)) ==
- k (doUpLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_filter_down_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doFilterLoop f1 acc1) (doDownLoop f2 acc2)) ==
- k (doDownLoop (f1 `fuseFilterAccEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-prop_down_filter_loop_fusion f1 f2 acc1 acc2 xs =
- k (sequenceLoops (doDownLoop f1 acc1) (doFilterLoop f2 acc2)) ==
- k (doDownLoop (f1 `fuseAccFilterEFL` f2) (acc1 :*: acc2))
- where _ = acc1 :: Int; _ = acc2 :: Int ; k g = loopWrapper g xs
-
-------------------------------------------------------------------------
-
-prop_length_loop_fusion_1 f1 acc1 xs =
- P.length (loopArr (loopWrapper (doUpLoop f1 acc1) xs)) ==
- P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doUpLoop f1 acc1) xs))
- where _ = acc1 :: Int
-
-prop_length_loop_fusion_2 f1 acc1 xs =
- P.length (loopArr (loopWrapper (doDownLoop f1 acc1) xs)) ==
- P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doDownLoop f1 acc1) xs))
- where _ = acc1 :: Int
-
-prop_length_loop_fusion_3 f1 acc1 xs =
- P.length (loopArr (loopWrapper (doMapLoop f1 acc1) xs)) ==
- P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doMapLoop f1 acc1) xs))
- where _ = acc1 :: Int
-
-prop_length_loop_fusion_4 f1 acc1 xs =
- P.length (loopArr (loopWrapper (doFilterLoop f1 acc1) xs)) ==
- P.foldl' (const . (+1)) 0 (loopArr (loopWrapper (doFilterLoop f1 acc1) xs))
- where _ = acc1 :: Int
-
-------------------------------------------------------------------------
--- The entry point
-
-main :: IO ()
-main = myrun tests
-
-myrun :: [(String, Int -> IO ())] -> IO ()
-myrun tests = do
- x <- getArgs
- let n = if null x then 100 else read . head $ x
- mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
-
---
--- And now a list of all the properties to test.
---
-
-tests = misc_tests
- ++ bl_tests
- ++ bp_tests
- ++ pl_tests
- ++ fusion_tests
-
-misc_tests =
- [("invariant", mytest prop_invariant)]
-
-------------------------------------------------------------------------
--- ByteString.Lazy <=> List
-
-bl_tests =
- [("all", mytest prop_allBL)
- ,("any", mytest prop_anyBL)
- ,("append", mytest prop_appendBL)
- ,("compare", mytest prop_compareBL)
- ,("concat", mytest prop_concatBL)
- ,("cons", mytest prop_consBL)
- ,("eq", mytest prop_eqBL)
- ,("filter", mytest prop_filterBL)
- ,("find", mytest prop_findBL)
- ,("findIndex", mytest prop_findIndexBL)
- ,("findIndices", mytest prop_findIndicesBL)
- ,("foldl", mytest prop_foldlBL)
- ,("foldl'", mytest prop_foldlBL')
- ,("foldl1", mytest prop_foldl1BL)
- ,("foldl1'", mytest prop_foldl1BL')
- ,("foldr", mytest prop_foldrBL)
- ,("foldr1", mytest prop_foldr1BL)
- ,("mapAccumL", mytest prop_mapAccumLBL)
- ,("unfoldr", mytest prop_unfoldrBL)
- ,("head", mytest prop_headBL)
- ,("init", mytest prop_initBL)
- ,("isPrefixOf", mytest prop_isPrefixOfBL)
- ,("last", mytest prop_lastBL)
- ,("length", mytest prop_lengthBL)
- ,("map", mytest prop_mapBL)
- ,("maximum", mytest prop_maximumBL)
- ,("minimum", mytest prop_minimumBL)
- ,("null", mytest prop_nullBL)
- ,("reverse", mytest prop_reverseBL)
- ,("snoc", mytest prop_snocBL)
- ,("tail", mytest prop_tailBL)
- ,("transpose", mytest prop_transposeBL)
- ,("replicate", mytest prop_replicateBL)
- ,("take", mytest prop_takeBL)
- ,("drop", mytest prop_dropBL)
- ,("splitAt", mytest prop_splitAtBL)
- ,("takeWhile", mytest prop_takeWhileBL)
- ,("dropWhile", mytest prop_dropWhileBL)
- ,("break", mytest prop_breakBL)
- ,("span", mytest prop_spanBL)
- ,("group", mytest prop_groupBL)
- ,("inits", mytest prop_initsBL)
- ,("tails", mytest prop_tailsBL)
- ,("elem", mytest prop_elemBL)
- ,("notElem", mytest prop_notElemBL)
- ,("lines", mytest prop_linesBL)
- ,("elemIndex", mytest prop_elemIndexBL)
- ,("elemIndices", mytest prop_elemIndicesBL)
--- ,("concatMap", mytest prop_concatMapBL)
- ]
-
-------------------------------------------------------------------------
--- ByteString.Lazy <=> ByteString
-
-bp_tests =
- [("all", mytest prop_allBP)
- ,("any", mytest prop_anyBP)
- ,("append", mytest prop_appendBP)
- ,("compare", mytest prop_compareBP)
- ,("concat", mytest prop_concatBP)
- ,("cons", mytest prop_consBP)
- ,("eq", mytest prop_eqBP)
- ,("filter", mytest prop_filterBP)
- ,("find", mytest prop_findBP)
- ,("findIndex", mytest prop_findIndexBP)
- ,("findIndices", mytest prop_findIndicesBP)
- ,("foldl", mytest prop_foldlBP)
- ,("foldl'", mytest prop_foldlBP')
- ,("foldl1", mytest prop_foldl1BP)
- ,("foldl1'", mytest prop_foldl1BP')
- ,("foldr", mytest prop_foldrBP)
- ,("foldr1", mytest prop_foldr1BP)
- ,("mapAccumL", mytest prop_mapAccumLBP)
- ,("unfoldr", mytest prop_unfoldrBP)
- ,("head", mytest prop_headBP)
- ,("init", mytest prop_initBP)
- ,("isPrefixOf", mytest prop_isPrefixOfBP)
- ,("last", mytest prop_lastBP)
- ,("length", mytest prop_lengthBP)
- ,("readInt", mytest prop_readIntBP)
- ,("lines", mytest prop_linesBP)
- ,("map", mytest prop_mapBP)
- ,("maximum ", mytest prop_maximumBP)
- ,("minimum" , mytest prop_minimumBP)
- ,("null", mytest prop_nullBP)
- ,("reverse", mytest prop_reverseBP)
- ,("snoc", mytest prop_snocBP)
- ,("tail", mytest prop_tailBP)
- ,("scanl", mytest prop_scanlBP)
- ,("transpose", mytest prop_transposeBP)
- ,("replicate", mytest prop_replicateBP)
- ,("take", mytest prop_takeBP)
- ,("drop", mytest prop_dropBP)
- ,("splitAt", mytest prop_splitAtBP)
- ,("takeWhile", mytest prop_takeWhileBP)
- ,("dropWhile", mytest prop_dropWhileBP)
- ,("break", mytest prop_breakBP)
- ,("span", mytest prop_spanBP)
- ,("split", mytest prop_splitBP)
- ,("count", mytest prop_countBP)
- ,("group", mytest prop_groupBP)
- ,("inits", mytest prop_initsBP)
- ,("tails", mytest prop_tailsBP)
- ,("elem", mytest prop_elemBP)
- ,("notElem", mytest prop_notElemBP)
- ,("elemIndex", mytest prop_elemIndexBP)
- ,("elemIndices", mytest prop_elemIndicesBP)
--- ,("concatMap", mytest prop_concatMapBP)
- ]
-
-------------------------------------------------------------------------
--- ByteString <=> List
-
-pl_tests =
- [("all", mytest prop_allPL)
- ,("any", mytest prop_anyPL)
- ,("append", mytest prop_appendPL)
- ,("compare", mytest prop_comparePL)
- ,("concat", mytest prop_concatPL)
- ,("cons", mytest prop_consPL)
- ,("eq", mytest prop_eqPL)
- ,("filter", mytest prop_filterPL)
- ,("find", mytest prop_findPL)
- ,("findIndex", mytest prop_findIndexPL)
- ,("findIndices", mytest prop_findIndicesPL)
- ,("foldl", mytest prop_foldlPL)
- ,("foldl'", mytest prop_foldlPL')
- ,("foldl1", mytest prop_foldl1PL)
- ,("foldl1'", mytest prop_foldl1PL')
- ,("foldr1", mytest prop_foldr1PL)
- ,("foldr", mytest prop_foldrPL)
- ,("mapAccumL", mytest prop_mapAccumLPL)
- ,("mapAccumR", mytest prop_mapAccumRPL)
- ,("unfoldr", mytest prop_unfoldrPL)
- ,("scanl", mytest prop_scanlPL)
- ,("scanl1", mytest prop_scanl1PL)
- ,("scanr", mytest prop_scanrPL)
- ,("scanr1", mytest prop_scanr1PL)
- ,("head", mytest prop_headPL)
- ,("init", mytest prop_initPL)
- ,("last", mytest prop_lastPL)
- ,("maximum", mytest prop_maximumPL)
- ,("minimum", mytest prop_minimumPL)
- ,("tail", mytest prop_tailPL)
- ,("isPrefixOf", mytest prop_isPrefixOfPL)
- ,("length", mytest prop_lengthPL)
- ,("map", mytest prop_mapPL)
- ,("null", mytest prop_nullPL)
- ,("reverse", mytest prop_reversePL)
- ,("snoc", mytest prop_snocPL)
- ,("transpose", mytest prop_transposePL)
- ,("replicate", mytest prop_replicatePL)
- ,("take", mytest prop_takePL)
- ,("drop", mytest prop_dropPL)
- ,("splitAt", mytest prop_splitAtPL)
- ,("takeWhile", mytest prop_takeWhilePL)
- ,("dropWhile", mytest prop_dropWhilePL)
- ,("break", mytest prop_breakPL)
- ,("span", mytest prop_spanPL)
- ,("group", mytest prop_groupPL)
- ,("inits", mytest prop_initsPL)
- ,("tails", mytest prop_tailsPL)
- ,("elem", mytest prop_elemPL)
- ,("notElem", mytest prop_notElemPL)
- ,("lines", mytest prop_linesBL)
- ,("elemIndex", mytest prop_elemIndexPL)
- ,("elemIndices", mytest prop_elemIndicesPL)
--- ,("concatMap", mytest prop_concatMapPL)
- ]
-
-------------------------------------------------------------------------
--- Fusion rules
-
-fusion_tests =
--- v1 fusion
- [ ("lazy loop/loop fusion", mytest prop_lazylooploop)
- , ("loop/loop fusion", mytest prop_looploop)
-
--- v2 fusion
- ,("loop/loop wrapper elim", mytest prop_loop_loop_wrapper_elimination)
- ,("sequence association", mytest prop_sequenceloops_assoc)
-
- ,("up/up loop fusion", mytest prop_up_up_loop_fusion)
- ,("down/down loop fusion", mytest prop_down_down_loop_fusion)
- ,("noAcc/noAcc loop fusion", mytest prop_noAcc_noAcc_loop_fusion)
- ,("noAcc/up loop fusion", mytest prop_noAcc_up_loop_fusion)
- ,("up/noAcc loop fusion", mytest prop_up_noAcc_loop_fusion)
- ,("noAcc/down loop fusion", mytest prop_noAcc_down_loop_fusion)
- ,("down/noAcc loop fusion", mytest prop_down_noAcc_loop_fusion)
- ,("map/map loop fusion", mytest prop_map_map_loop_fusion)
- ,("filter/filter loop fusion", mytest prop_filter_filter_loop_fusion)
- ,("map/filter loop fusion", mytest prop_map_filter_loop_fusion)
- ,("filter/map loop fusion", mytest prop_filter_map_loop_fusion)
- ,("map/noAcc loop fusion", mytest prop_map_noAcc_loop_fusion)
- ,("noAcc/map loop fusion", mytest prop_noAcc_map_loop_fusion)
- ,("map/up loop fusion", mytest prop_map_up_loop_fusion)
- ,("up/map loop fusion", mytest prop_up_map_loop_fusion)
- ,("map/down loop fusion", mytest prop_map_down_fusion)
- ,("down/map loop fusion", mytest prop_down_map_loop_fusion)
- ,("filter/noAcc loop fusion", mytest prop_filter_noAcc_loop_fusion)
- ,("noAcc/filter loop fusion", mytest prop_noAcc_filter_loop_fusion)
- ,("filter/up loop fusion", mytest prop_filter_up_loop_fusion)
- ,("up/filter loop fusion", mytest prop_up_filter_loop_fusion)
- ,("filter/down loop fusion", mytest prop_filter_down_fusion)
- ,("down/filter loop fusion", mytest prop_down_filter_loop_fusion)
-
- ,("length/loop fusion", mytest prop_length_loop_fusion_1)
- ,("length/loop fusion", mytest prop_length_loop_fusion_2)
- ,("length/loop fusion", mytest prop_length_loop_fusion_3)
- ,("length/loop fusion", mytest prop_length_loop_fusion_4)
- ]
-
-
-------------------------------------------------------------------------
---
--- These are miscellaneous tests left over. Or else they test some
--- property internal to a type (i.e. head . sort == minimum), without
--- reference to a model type.
---
-
-invariant :: L.ByteString -> Bool
-invariant L.Empty = True
-invariant (L.Chunk c cs) = not (P.null c) && invariant cs
-
-prop_invariant = invariant
-
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring001.stdout b/testsuite/tests/lib/Data.ByteString/bytestring001.stdout
deleted file mode 100644
index e2b220dc41..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring001.stdout
+++ /dev/null
@@ -1,185 +0,0 @@
-invariant : OK, 100 tests.
-all : OK, 100 tests.
-any : OK, 100 tests.
-append : OK, 100 tests.
-compare : OK, 100 tests.
-concat : OK, 100 tests.
-cons : OK, 100 tests.
-eq : OK, 100 tests.
-filter : OK, 100 tests.
-find : OK, 100 tests.
-findIndex : OK, 100 tests.
-findIndices : OK, 100 tests.
-foldl : OK, 100 tests.
-foldl' : OK, 100 tests.
-foldl1 : OK, 100 tests.
-foldl1' : OK, 100 tests.
-foldr : OK, 100 tests.
-foldr1 : OK, 100 tests.
-mapAccumL : OK, 100 tests.
-unfoldr : OK, 100 tests.
-head : OK, 100 tests.
-init : OK, 100 tests.
-isPrefixOf : OK, 100 tests.
-last : OK, 100 tests.
-length : OK, 100 tests.
-map : OK, 100 tests.
-maximum : OK, 100 tests.
-minimum : OK, 100 tests.
-null : OK, 100 tests.
-reverse : OK, 100 tests.
-snoc : OK, 100 tests.
-tail : OK, 100 tests.
-transpose : OK, 100 tests.
-replicate : OK, 100 tests.
-take : OK, 100 tests.
-drop : OK, 100 tests.
-splitAt : OK, 100 tests.
-takeWhile : OK, 100 tests.
-dropWhile : OK, 100 tests.
-break : OK, 100 tests.
-span : OK, 100 tests.
-group : OK, 100 tests.
-inits : OK, 100 tests.
-tails : OK, 100 tests.
-elem : OK, 100 tests.
-notElem : OK, 100 tests.
-lines : OK, 100 tests.
-elemIndex : OK, 100 tests.
-elemIndices : OK, 100 tests.
-all : OK, 100 tests.
-any : OK, 100 tests.
-append : OK, 100 tests.
-compare : OK, 100 tests.
-concat : OK, 100 tests.
-cons : OK, 100 tests.
-eq : OK, 100 tests.
-filter : OK, 100 tests.
-find : OK, 100 tests.
-findIndex : OK, 100 tests.
-findIndices : OK, 100 tests.
-foldl : OK, 100 tests.
-foldl' : OK, 100 tests.
-foldl1 : OK, 100 tests.
-foldl1' : OK, 100 tests.
-foldr : OK, 100 tests.
-foldr1 : OK, 100 tests.
-mapAccumL : OK, 100 tests.
-unfoldr : OK, 100 tests.
-head : OK, 100 tests.
-init : OK, 100 tests.
-isPrefixOf : OK, 100 tests.
-last : OK, 100 tests.
-length : OK, 100 tests.
-readInt : OK, 100 tests.
-lines : OK, 100 tests.
-map : OK, 100 tests.
-maximum : OK, 100 tests.
-minimum : OK, 100 tests.
-null : OK, 100 tests.
-reverse : OK, 100 tests.
-snoc : OK, 100 tests.
-tail : OK, 100 tests.
-scanl : OK, 100 tests.
-transpose : OK, 100 tests.
-replicate : OK, 100 tests.
-take : OK, 100 tests.
-drop : OK, 100 tests.
-splitAt : OK, 100 tests.
-takeWhile : OK, 100 tests.
-dropWhile : OK, 100 tests.
-break : OK, 100 tests.
-span : OK, 100 tests.
-split : OK, 100 tests.
-count : OK, 100 tests.
-group : OK, 100 tests.
-inits : OK, 100 tests.
-tails : OK, 100 tests.
-elem : OK, 100 tests.
-notElem : OK, 100 tests.
-elemIndex : OK, 100 tests.
-elemIndices : OK, 100 tests.
-all : OK, 100 tests.
-any : OK, 100 tests.
-append : OK, 100 tests.
-compare : OK, 100 tests.
-concat : OK, 100 tests.
-cons : OK, 100 tests.
-eq : OK, 100 tests.
-filter : OK, 100 tests.
-find : OK, 100 tests.
-findIndex : OK, 100 tests.
-findIndices : OK, 100 tests.
-foldl : OK, 100 tests.
-foldl' : OK, 100 tests.
-foldl1 : OK, 100 tests.
-foldl1' : OK, 100 tests.
-foldr1 : OK, 100 tests.
-foldr : OK, 100 tests.
-mapAccumL : OK, 100 tests.
-mapAccumR : OK, 100 tests.
-unfoldr : OK, 100 tests.
-scanl : OK, 100 tests.
-scanl1 : OK, 100 tests.
-scanr : OK, 100 tests.
-scanr1 : OK, 100 tests.
-head : OK, 100 tests.
-init : OK, 100 tests.
-last : OK, 100 tests.
-maximum : OK, 100 tests.
-minimum : OK, 100 tests.
-tail : OK, 100 tests.
-isPrefixOf : OK, 100 tests.
-length : OK, 100 tests.
-map : OK, 100 tests.
-null : OK, 100 tests.
-reverse : OK, 100 tests.
-snoc : OK, 100 tests.
-transpose : OK, 100 tests.
-replicate : OK, 100 tests.
-take : OK, 100 tests.
-drop : OK, 100 tests.
-splitAt : OK, 100 tests.
-takeWhile : OK, 100 tests.
-dropWhile : OK, 100 tests.
-break : OK, 100 tests.
-span : OK, 100 tests.
-group : OK, 100 tests.
-inits : OK, 100 tests.
-tails : OK, 100 tests.
-elem : OK, 100 tests.
-notElem : OK, 100 tests.
-lines : OK, 100 tests.
-elemIndex : OK, 100 tests.
-elemIndices : OK, 100 tests.
-lazy loop/loop fusion : OK, 100 tests.
-loop/loop fusion : OK, 100 tests.
-loop/loop wrapper elim : OK, 100 tests.
-sequence association : OK, 100 tests.
-up/up loop fusion: OK, 100 tests.
-down/down loop fusion: OK, 100 tests.
-noAcc/noAcc loop fusion: OK, 100 tests.
-noAcc/up loop fusion: OK, 100 tests.
-up/noAcc loop fusion: OK, 100 tests.
-noAcc/down loop fusion: OK, 100 tests.
-down/noAcc loop fusion: OK, 100 tests.
-map/map loop fusion: OK, 100 tests.
-filter/filter loop fusion: OK, 100 tests.
-map/filter loop fusion: OK, 100 tests.
-filter/map loop fusion: OK, 100 tests.
-map/noAcc loop fusion: OK, 100 tests.
-noAcc/map loop fusion: OK, 100 tests.
-map/up loop fusion: OK, 100 tests.
-up/map loop fusion: OK, 100 tests.
-map/down loop fusion: OK, 100 tests.
-down/map loop fusion: OK, 100 tests.
-filter/noAcc loop fusion: OK, 100 tests.
-noAcc/filter loop fusion: OK, 100 tests.
-filter/up loop fusion: OK, 100 tests.
-up/filter loop fusion: OK, 100 tests.
-filter/down loop fusion: OK, 100 tests.
-down/filter loop fusion: OK, 100 tests.
-length/loop fusion : OK, 100 tests.
-length/loop fusion : OK, 100 tests.
-length/loop fusion : OK, 100 tests.
-length/loop fusion : OK, 100 tests.
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring002.hs b/testsuite/tests/lib/Data.ByteString/bytestring002.hs
deleted file mode 100644
index 23d6cf270f..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring002.hs
+++ /dev/null
@@ -1,6 +0,0 @@
---
--- The unix wc -l program
---
-import qualified Data.ByteString as B
-
-main = print . B.count 10 =<< B.getContents
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring002.stdin b/testsuite/tests/lib/Data.ByteString/bytestring002.stdin
deleted file mode 100644
index abffbabe44..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring002.stdin
+++ /dev/null
@@ -1,1000 +0,0 @@
-A
-a
-aa
-aal
-aalii
-aam
-Aani
-aardvark
-aardwolf
-Aaron
-Aaronic
-Aaronical
-Aaronite
-Aaronitic
-Aaru
-Ab
-aba
-Ababdeh
-Ababua
-abac
-abaca
-abacate
-abacay
-abacinate
-abacination
-abaciscus
-abacist
-aback
-abactinal
-abactinally
-abaction
-abactor
-abaculus
-abacus
-Abadite
-abaff
-abaft
-abaisance
-abaiser
-abaissed
-abalienate
-abalienation
-abalone
-Abama
-abampere
-abandon
-abandonable
-abandoned
-abandonedly
-abandonee
-abandoner
-abandonment
-Abanic
-Abantes
-abaptiston
-Abarambo
-Abaris
-abarthrosis
-abarticular
-abarticulation
-abas
-abase
-abased
-abasedly
-abasedness
-abasement
-abaser
-Abasgi
-abash
-abashed
-abashedly
-abashedness
-abashless
-abashlessly
-abashment
-abasia
-abasic
-abask
-Abassin
-abastardize
-abatable
-abate
-abatement
-abater
-abatis
-abatised
-abaton
-abator
-abattoir
-Abatua
-abature
-abave
-abaxial
-abaxile
-abaze
-abb
-Abba
-abbacomes
-abbacy
-Abbadide
-abbas
-abbasi
-abbassi
-Abbasside
-abbatial
-abbatical
-abbess
-abbey
-abbeystede
-Abbie
-abbot
-abbotcy
-abbotnullius
-abbotship
-abbreviate
-abbreviately
-abbreviation
-abbreviator
-abbreviatory
-abbreviature
-Abby
-abcoulomb
-abdal
-abdat
-Abderian
-Abderite
-abdest
-abdicable
-abdicant
-abdicate
-abdication
-abdicative
-abdicator
-Abdiel
-abditive
-abditory
-abdomen
-abdominal
-Abdominales
-abdominalian
-abdominally
-abdominoanterior
-abdominocardiac
-abdominocentesis
-abdominocystic
-abdominogenital
-abdominohysterectomy
-abdominohysterotomy
-abdominoposterior
-abdominoscope
-abdominoscopy
-abdominothoracic
-abdominous
-abdominovaginal
-abdominovesical
-abduce
-abducens
-abducent
-abduct
-abduction
-abductor
-Abe
-abeam
-abear
-abearance
-abecedarian
-abecedarium
-abecedary
-abed
-abeigh
-Abel
-abele
-Abelia
-Abelian
-Abelicea
-Abelite
-abelite
-Abelmoschus
-abelmosk
-Abelonian
-abeltree
-Abencerrages
-abenteric
-abepithymia
-Aberdeen
-aberdevine
-Aberdonian
-Aberia
-aberrance
-aberrancy
-aberrant
-aberrate
-aberration
-aberrational
-aberrator
-aberrometer
-aberroscope
-aberuncator
-abet
-abetment
-abettal
-abettor
-abevacuation
-abey
-abeyance
-abeyancy
-abeyant
-abfarad
-abhenry
-abhiseka
-abhominable
-abhor
-abhorrence
-abhorrency
-abhorrent
-abhorrently
-abhorrer
-abhorrible
-abhorring
-Abhorson
-abidal
-abidance
-abide
-abider
-abidi
-abiding
-abidingly
-abidingness
-Abie
-Abies
-abietate
-abietene
-abietic
-abietin
-Abietineae
-abietineous
-abietinic
-Abiezer
-Abigail
-abigail
-abigailship
-abigeat
-abigeus
-abilao
-ability
-abilla
-abilo
-abintestate
-abiogenesis
-abiogenesist
-abiogenetic
-abiogenetical
-abiogenetically
-abiogenist
-abiogenous
-abiogeny
-abiological
-abiologically
-abiology
-abiosis
-abiotic
-abiotrophic
-abiotrophy
-Abipon
-abir
-abirritant
-abirritate
-abirritation
-abirritative
-abiston
-Abitibi
-abiuret
-abject
-abjectedness
-abjection
-abjective
-abjectly
-abjectness
-abjoint
-abjudge
-abjudicate
-abjudication
-abjunction
-abjunctive
-abjuration
-abjuratory
-abjure
-abjurement
-abjurer
-abkar
-abkari
-Abkhas
-Abkhasian
-ablach
-ablactate
-ablactation
-ablare
-ablastemic
-ablastous
-ablate
-ablation
-ablatitious
-ablatival
-ablative
-ablator
-ablaut
-ablaze
-able
-ableeze
-ablegate
-ableness
-ablepharia
-ablepharon
-ablepharous
-Ablepharus
-ablepsia
-ableptical
-ableptically
-abler
-ablest
-ablewhackets
-ablins
-abloom
-ablow
-ablude
-abluent
-ablush
-ablution
-ablutionary
-abluvion
-ably
-abmho
-Abnaki
-abnegate
-abnegation
-abnegative
-abnegator
-Abner
-abnerval
-abnet
-abneural
-abnormal
-abnormalism
-abnormalist
-abnormality
-abnormalize
-abnormally
-abnormalness
-abnormity
-abnormous
-abnumerable
-Abo
-aboard
-Abobra
-abode
-abodement
-abody
-abohm
-aboil
-abolish
-abolisher
-abolishment
-abolition
-abolitionary
-abolitionism
-abolitionist
-abolitionize
-abolla
-aboma
-abomasum
-abomasus
-abominable
-abominableness
-abominably
-abominate
-abomination
-abominator
-abomine
-Abongo
-aboon
-aborad
-aboral
-aborally
-abord
-aboriginal
-aboriginality
-aboriginally
-aboriginary
-aborigine
-abort
-aborted
-aborticide
-abortient
-abortifacient
-abortin
-abortion
-abortional
-abortionist
-abortive
-abortively
-abortiveness
-abortus
-abouchement
-abound
-abounder
-abounding
-aboundingly
-about
-abouts
-above
-aboveboard
-abovedeck
-aboveground
-aboveproof
-abovestairs
-abox
-abracadabra
-abrachia
-abradant
-abrade
-abrader
-Abraham
-Abrahamic
-Abrahamidae
-Abrahamite
-Abrahamitic
-abraid
-Abram
-Abramis
-abranchial
-abranchialism
-abranchian
-Abranchiata
-abranchiate
-abranchious
-abrasax
-abrase
-abrash
-abrasiometer
-abrasion
-abrasive
-abrastol
-abraum
-abraxas
-abreact
-abreaction
-abreast
-abrenounce
-abret
-abrico
-abridge
-abridgeable
-abridged
-abridgedly
-abridger
-abridgment
-abrim
-abrin
-abristle
-abroach
-abroad
-Abrocoma
-abrocome
-abrogable
-abrogate
-abrogation
-abrogative
-abrogator
-Abroma
-Abronia
-abrook
-abrotanum
-abrotine
-abrupt
-abruptedly
-abruption
-abruptly
-abruptness
-Abrus
-Absalom
-absampere
-Absaroka
-absarokite
-abscess
-abscessed
-abscession
-abscessroot
-abscind
-abscise
-abscision
-absciss
-abscissa
-abscissae
-abscisse
-abscission
-absconce
-abscond
-absconded
-abscondedly
-abscondence
-absconder
-absconsa
-abscoulomb
-absence
-absent
-absentation
-absentee
-absenteeism
-absenteeship
-absenter
-absently
-absentment
-absentmindedly
-absentness
-absfarad
-abshenry
-Absi
-absinthe
-absinthial
-absinthian
-absinthiate
-absinthic
-absinthin
-absinthine
-absinthism
-absinthismic
-absinthium
-absinthol
-absit
-absmho
-absohm
-absolute
-absolutely
-absoluteness
-absolution
-absolutism
-absolutist
-absolutistic
-absolutistically
-absolutive
-absolutization
-absolutize
-absolutory
-absolvable
-absolvatory
-absolve
-absolvent
-absolver
-absolvitor
-absolvitory
-absonant
-absonous
-absorb
-absorbability
-absorbable
-absorbed
-absorbedly
-absorbedness
-absorbefacient
-absorbency
-absorbent
-absorber
-absorbing
-absorbingly
-absorbition
-absorpt
-absorptance
-absorptiometer
-absorptiometric
-absorption
-absorptive
-absorptively
-absorptiveness
-absorptivity
-absquatulate
-abstain
-abstainer
-abstainment
-abstemious
-abstemiously
-abstemiousness
-abstention
-abstentionist
-abstentious
-absterge
-abstergent
-abstersion
-abstersive
-abstersiveness
-abstinence
-abstinency
-abstinent
-abstinential
-abstinently
-abstract
-abstracted
-abstractedly
-abstractedness
-abstracter
-abstraction
-abstractional
-abstractionism
-abstractionist
-abstractitious
-abstractive
-abstractively
-abstractiveness
-abstractly
-abstractness
-abstractor
-abstrahent
-abstricted
-abstriction
-abstruse
-abstrusely
-abstruseness
-abstrusion
-abstrusity
-absume
-absumption
-absurd
-absurdity
-absurdly
-absurdness
-absvolt
-Absyrtus
-abterminal
-abthain
-abthainrie
-abthainry
-abthanage
-Abu
-abu
-abucco
-abulia
-abulic
-abulomania
-abuna
-abundance
-abundancy
-abundant
-Abundantia
-abundantly
-abura
-aburabozu
-aburban
-aburst
-aburton
-abusable
-abuse
-abusedly
-abusee
-abuseful
-abusefully
-abusefulness
-abuser
-abusion
-abusious
-abusive
-abusively
-abusiveness
-abut
-Abuta
-Abutilon
-abutment
-abuttal
-abutter
-abutting
-abuzz
-abvolt
-abwab
-aby
-abysm
-abysmal
-abysmally
-abyss
-abyssal
-Abyssinian
-abyssobenthonic
-abyssolith
-abyssopelagic
-acacatechin
-acacatechol
-acacetin
-Acacia
-Acacian
-acaciin
-acacin
-academe
-academial
-academian
-Academic
-academic
-academical
-academically
-academicals
-academician
-academicism
-academism
-academist
-academite
-academization
-academize
-Academus
-academy
-Acadia
-acadialite
-Acadian
-Acadie
-Acaena
-acajou
-acaleph
-Acalepha
-Acalephae
-acalephan
-acalephoid
-acalycal
-acalycine
-acalycinous
-acalyculate
-Acalypha
-Acalypterae
-Acalyptrata
-Acalyptratae
-acalyptrate
-Acamar
-acampsia
-acana
-acanaceous
-acanonical
-acanth
-acantha
-Acanthaceae
-acanthaceous
-acanthad
-Acantharia
-Acanthia
-acanthial
-acanthin
-acanthine
-acanthion
-acanthite
-acanthocarpous
-Acanthocephala
-acanthocephalan
-Acanthocephali
-acanthocephalous
-Acanthocereus
-acanthocladous
-Acanthodea
-acanthodean
-Acanthodei
-Acanthodes
-acanthodian
-Acanthodidae
-Acanthodii
-Acanthodini
-acanthoid
-Acantholimon
-acanthological
-acanthology
-acantholysis
-acanthoma
-Acanthomeridae
-acanthon
-Acanthopanax
-Acanthophis
-acanthophorous
-acanthopod
-acanthopodous
-acanthopomatous
-acanthopore
-acanthopteran
-Acanthopteri
-acanthopterous
-acanthopterygian
-Acanthopterygii
-acanthosis
-acanthous
-Acanthuridae
-Acanthurus
-acanthus
-acapnia
-acapnial
-acapsular
-acapu
-acapulco
-acara
-Acarapis
-acardia
-acardiac
-acari
-acarian
-acariasis
-acaricidal
-acaricide
-acarid
-Acarida
-Acaridea
-acaridean
-acaridomatium
-acariform
-Acarina
-acarine
-acarinosis
-acarocecidium
-acarodermatitis
-acaroid
-acarol
-acarologist
-acarology
-acarophilous
-acarophobia
-acarotoxic
-acarpelous
-acarpous
-Acarus
-Acastus
-acatalectic
-acatalepsia
-acatalepsy
-acataleptic
-acatallactic
-acatamathesia
-acataphasia
-acataposis
-acatastasia
-acatastatic
-acate
-acategorical
-acatery
-acatharsia
-acatharsy
-acatholic
-acaudal
-acaudate
-acaulescent
-acauline
-acaulose
-acaulous
-acca
-accede
-accedence
-acceder
-accelerable
-accelerando
-accelerant
-accelerate
-accelerated
-acceleratedly
-acceleration
-accelerative
-accelerator
-acceleratory
-accelerograph
-accelerometer
-accend
-accendibility
-accendible
-accension
-accensor
-accent
-accentless
-accentor
-accentuable
-accentual
-accentuality
-accentually
-accentuate
-accentuation
-accentuator
-accentus
-accept
-acceptability
-acceptable
-acceptableness
-acceptably
-acceptance
-acceptancy
-acceptant
-acceptation
-accepted
-acceptedly
-accepter
-acceptilate
-acceptilation
-acception
-acceptive
-acceptor
-acceptress
-accerse
-accersition
-accersitor
-access
-accessarily
-accessariness
-accessary
-accessaryship
-accessibility
-accessible
-accessibly
-accession
-accessional
-accessioner
-accessive
-accessively
-accessless
-accessorial
-accessorily
-accessoriness
-accessorius
-accessory
-accidence
-accidency
-accident
-accidental
-accidentalism
-accidentalist
-accidentality
-accidentally
-accidentalness
-accidented
-accidential
-accidentiality
-accidently
-accidia
-accidie
-accinge
-accipient
-Accipiter
-accipitral
-accipitrary
-Accipitres
-accipitrine
-accismus
-accite
-acclaim
-acclaimable
-acclaimer
-acclamation
-acclamator
-acclamatory
-acclimatable
-acclimatation
-acclimate
-acclimatement
-acclimation
-acclimatizable
-acclimatization
-acclimatize
-acclimatizer
-acclimature
-acclinal
-acclinate
-acclivitous
-acclivity
-acclivous
-accloy
-accoast
-accoil
-accolade
-accoladed
-accolated
-accolent
-accolle
-accombination
-accommodable
-accommodableness
-accommodate
-accommodately
-accommodateness
-accommodating
-accommodatingly
-accommodation
-accommodational
-accommodative
-accommodativeness
-accommodator
-accompanier
-accompaniment
-accompanimental
-accompanist
-accompany
-accompanyist
-accompletive
-accomplice
-accompliceship
-accomplicity
-accomplish
-accomplishable
-accomplished
-accomplisher
-accomplishment
-accomplisht
-accompt
-accord
-accordable
-accordance
-accordancy
-accordant
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring002.stdout b/testsuite/tests/lib/Data.ByteString/bytestring002.stdout
deleted file mode 100644
index 83b33d238d..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring002.stdout
+++ /dev/null
@@ -1 +0,0 @@
-1000
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring003.hs b/testsuite/tests/lib/Data.ByteString/bytestring003.hs
deleted file mode 100644
index c31ab8d17f..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring003.hs
+++ /dev/null
@@ -1,36 +0,0 @@
-{-# OPTIONS -cpp #-}
-
---
--- 'sums' benchmark from the great language shootout
---
-
-import System.IO
-import qualified Data.ByteString as B
-import Data.ByteString (ByteString)
-import Data.ByteString.Unsafe (unsafeTail,unsafeIndex)
-import Data.Char -- seems to help!
-
-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined
-
-main = print . go 0 =<< B.getContents
-
-STRICT2(go)
-go i ps
- | B.null ps = i
- | x == 45 = neg 0 xs
- | otherwise = pos (parse x) xs
- where
- (x, xs) = (ps `unsafeIndex` 0, unsafeTail ps)
-
- STRICT2(neg)
- neg n qs | x == 10 = go (i-n) xs
- | otherwise = neg (parse x + (10 * n)) xs
- where (x, xs) = (qs `unsafeIndex` 0, unsafeTail qs)
-
- STRICT2(pos)
- pos n qs | x == 10 = go (i+n) xs
- | otherwise = pos (parse x + (10 * n)) xs
- where (x, xs) = (qs `unsafeIndex` 0, unsafeTail qs)
-
-parse w = fromIntegral (w - 48) :: Int
-{-# INLINE parse #-}
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring003.stdin b/testsuite/tests/lib/Data.ByteString/bytestring003.stdin
deleted file mode 100644
index 956aba1447..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring003.stdin
+++ /dev/null
@@ -1,1000 +0,0 @@
-276
-498
--981
-770
--401
-702
-966
-950
--853
--53
--293
-604
-288
-892
--697
-204
-96
-408
-880
--7
--817
-422
--261
--485
--77
-826
-184
-864
--751
-626
-812
--369
--353
--371
-488
--83
--659
-24
-524
--21
-840
--757
--17
--973
--843
-260
-858
--389
--521
--99
-482
--561
--213
-630
-766
-932
-112
--419
--877
-762
-266
--837
-170
-834
-746
-764
-922
--89
-576
--63
-90
-684
-316
-506
--959
-708
-70
-252
--747
-342
--593
--895
--937
--707
-350
-588
--201
--683
--113
--511
--867
-322
-202
-472
-150
--9
--643
-28
-336
-86
--925
-836
--473
--451
--971
--805
--619
-84
--67
-806
-270
-366
-334
--555
--557
--331
--409
--553
--145
--71
-528
-490
-492
-828
-628
--961
-536
--859
--271
-974
--671
--749
-414
--257
-778
-56
-598
--437
--899
--785
--987
-32
--999
-132
--821
--209
-402
--543
-194
--967
-294
--943
--285
--483
--97
-660
--481
--829
--309
--597
--855
-80
--355
-192
--823
-436
-916
-282
--629
-612
--329
--535
-780
--47
-706
-110
-756
--857
--933
--345
--523
-718
--31
-902
-678
-540
-698
-456
--399
-126
-412
--563
--321
--487
--641
--195
--199
--955
-772
-570
-18
--217
-886
-984
--721
--995
-46
--989
-946
-64
-716
--719
--869
--579
-776
-450
-936
-980
--439
--977
--455
--997
-6
-268
--269
--421
-328
-352
-578
--575
-476
-976
--57
--469
-544
-582
--43
-510
--939
--581
--337
--203
--737
--827
-852
--279
--803
--911
--865
-548
-48
--75
-416
--275
-688
--255
--687
--461
--233
-420
-912
--901
--299
-12
-568
-694
--411
--883
--327
--361
--339
-646
--137
--905
-670
-686
--131
--849
--825
-256
-228
--841
-68
-368
--909
-242
-298
-118
-10
-222
-954
--493
--459
--445
-608
--765
-34
-468
--715
-690
--185
--551
--571
--241
-292
-92
-768
--923
-956
-614
-8
-730
-208
--417
-300
-136
--59
--251
--539
-166
-798
-866
-454
--391
--317
-668
-502
--15
-994
-854
--189
-666
-446
--565
--5
-42
--227
--87
--779
-26
-312
-354
-754
-396
--515
-220
-872
-654
-88
--667
-250
-572
-952
-72
-982
-972
--529
--471
--533
--427
-538
-154
--457
--819
-750
-152
-452
--41
-838
--489
-418
--649
--637
--197
-74
-394
--653
--727
--435
--23
-348
-638
--611
-914
--357
--743
--685
-580
--247
--577
-54
--931
--3
-558
--793
--443
--759
-162
--811
-384
-720
--117
-900
--519
--39
-744
-432
-286
--873
-380
--167
--283
-430
--155
--755
-206
-100
-364
--677
-332
--567
-382
--605
--181
-676
--475
--845
-910
-546
-14
-398
-616
--769
-424
-992
--235
--239
-774
-478
--919
-168
--771
--773
--69
--509
-930
-550
--463
-178
--861
--761
--795
-234
--831
--61
--979
--851
--665
--709
-896
-742
--123
-590
--693
--887
--379
-144
--717
-20
-174
-82
-464
-30
--969
--349
--531
--799
--661
--647
--623
-878
-148
--545
-238
--259
-554
-726
--37
--797
-98
-78
--591
--975
-962
-120
-906
--207
-656
--171
-652
-188
-672
--133
--91
-224
-818
--333
--839
--499
-22
--739
-142
-378
--403
--315
-370
-284
-122
-230
--527
--127
-442
-534
-160
-722
-262
--657
-304
-258
--103
-960
--495
--265
-634
--101
-480
--363
-308
-76
--949
--585
-904
-146
--703
-164
-850
-246
-732
--725
-566
-274
--163
--935
--681
--229
-254
--733
--547
--273
--903
-736
--711
-794
-392
--655
--549
-808
--429
-484
--701
--617
-804
-36
--775
--335
--927
-714
--177
--325
--413
--963
-114
--253
--789
--645
-40
-434
-898
-924
--19
-738
-788
-280
--121
-594
--913
-426
-816
--373
--45
-340
--109
--323
-58
--249
-940
--297
-988
-998
--607
--745
--633
--115
-996
--893
-696
-400
-848
-500
--263
-562
--807
--105
--603
-658
--73
--863
-448
-680
--157
--161
-728
-814
--477
--375
-1000
--631
--991
-362
-156
--187
--705
--917
--449
--741
-556
-440
--589
--11
--359
--891
--801
--153
--381
-938
--173
--243
-618
--599
--497
-486
-128
-790
-460
--27
--305
--205
--215
-324
--341
-50
-458
-52
--621
-874
-386
-560
--569
--51
-802
-786
-920
--425
-466
-444
--507
--915
-346
-622
--679
-784
--689
-388
-508
--613
--313
--447
-564
--897
--211
--225
--615
--367
-186
-894
--65
--453
--245
-602
-496
--651
--601
-820
-226
--695
--119
-372
-180
-94
-214
-542
-648
--871
-592
-584
-824
-796
-374
--945
--311
-516
-942
--221
--433
-200
--465
--953
-870
-868
--879
-518
-356
--223
-682
-990
--191
--541
--951
--921
--319
--169
--291
--289
-792
-876
-306
--491
-326
--885
-62
-514
--929
-318
--231
-632
-44
--107
-644
--267
--343
--847
-934
-734
--505
--351
-574
--627
-636
--93
--431
--835
-428
--183
--151
-2
--813
--595
-958
--141
-692
--385
-610
--179
-376
-948
-198
--675
-964
--907
-918
--165
--1
-406
-748
--111
-532
--55
--281
-740
-504
-236
--29
-662
--713
--537
-196
--587
-822
--135
-700
--35
-674
--407
-240
--673
--669
--393
-470
--525
--875
--383
--625
-296
--85
--147
--277
-800
--691
--143
-16
--983
--303
-290
--139
-172
-320
-512
-596
-640
-664
--791
--783
--387
--735
--467
--301
-810
-134
-216
-278
-176
-606
-140
--787
-978
-586
-890
-882
--753
--13
-970
--941
--175
--777
--809
--441
--347
--377
-390
--423
-842
-642
-190
-302
-438
-704
-310
--49
-124
--781
--287
-724
--767
-830
-620
--295
-244
--159
--307
--397
-66
--237
-314
--79
-624
-710
-272
--365
-928
-856
-138
--479
-520
-832
-862
-760
-846
--81
-106
--513
--193
-650
-782
--517
-944
-218
-712
--663
--559
-462
--635
--25
-182
-530
-844
-330
--833
-102
--881
-108
--947
--763
--405
-232
-410
-104
--729
--149
--889
-888
-360
-968
-908
-116
--815
--129
-522
--723
--993
-860
--503
-926
--219
--415
-60
-158
--609
--501
-986
--699
--583
-884
-212
-210
--957
-526
--985
-552
-344
--395
--95
-338
-248
-494
-130
-404
-358
-600
--639
--125
--33
--965
-752
-474
--731
-758
--573
-4
-38
-264
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring003.stdout b/testsuite/tests/lib/Data.ByteString/bytestring003.stdout
deleted file mode 100644
index 1b79f38e25..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring003.stdout
+++ /dev/null
@@ -1 +0,0 @@
-500
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring004.hs b/testsuite/tests/lib/Data.ByteString/bytestring004.hs
deleted file mode 100644
index 5c4df86a90..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring004.hs
+++ /dev/null
@@ -1,564 +0,0 @@
-#!/usr/bin/env runhaskell
---
--- Uses multi-param type classes
---
-
-import Test.QuickCheck.Batch
-import Test.QuickCheck
-import Text.Show.Functions
-
-import Data.Char
-import Data.Int
-import Data.List
-import Data.Maybe
-import Data.Word
-
-import System.IO
-import System.Environment
-import System.IO.Unsafe
-import System.Random
-
-import Control.Monad ( liftM2 )
-import Control.Monad.Instances ()
-
-import Text.Printf
-import Debug.Trace
-
-import Foreign.Ptr
-
-import Data.ByteString.Lazy (ByteString(..), pack , unpack)
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Internal as L
-
-import Data.ByteString.Fusion
-import qualified Data.ByteString as P
-import qualified Data.ByteString.Lazy as L
-
-import qualified Data.ByteString.Char8 as PC
-import qualified Data.ByteString.Lazy.Char8 as LC
-import qualified Data.ByteString as P
-import qualified Data.ByteString.Internal as P
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy.Char8 as D
-import Data.ByteString.Fusion
-
-import Prelude hiding (abs)
-
--- Enable this to get verbose test output. Including the actual tests.
-debug = False
-
-mytest :: Testable a => a -> Int -> IO ()
-mytest a n = mycheck defaultConfig
- { configMaxTest=n
- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
-
-mycheck :: Testable a => Config -> a -> IO ()
-mycheck config a =
- do let rnd = mkStdGen 99
- mytests config (evaluate a) rnd 0 0 []
-
-mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()
-mytests config gen rnd0 ntest nfail stamps
- | ntest == configMaxTest config = do done "OK," ntest stamps
- | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
- | otherwise =
- do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
- case ok result of
- Nothing ->
- mytests config gen rnd1 ntest (nfail+1) stamps
- Just True ->
- mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
- Just False ->
- putStr ( "Falsifiable after "
- ++ show ntest
- ++ " tests:\n"
- ++ unlines (arguments result)
- ) >> hFlush stdout
- where
- result = generate (configSize config ntest) rnd2 gen
- (rnd1,rnd2) = split rnd0
-
-done :: String -> Int -> [[String]] -> IO ()
-done mesg ntest stamps =
- do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
- where
- table = display
- . map entry
- . reverse
- . sort
- . map pairLength
- . group
- . sort
- . filter (not . null)
- $ stamps
-
- display [] = ".\n"
- display [x] = " (" ++ x ++ ").\n"
- display xs = ".\n" ++ unlines (map (++ ".") xs)
-
- pairLength xss@(xs:_) = (length xss, xs)
- entry (n, xs) = percentage n ntest
- ++ " "
- ++ concat (intersperse ", " xs)
-
- percentage n m = show ((100 * n) `div` m) ++ "%"
-
-------------------------------------------------------------------------
-
-instance Arbitrary Char where
- arbitrary = choose ('a', 'i')
- coarbitrary c = variant (ord c `rem` 4)
-
-instance (Arbitrary a, Arbitrary b) => Arbitrary (PairS a b) where
- arbitrary = liftM2 (:*:) arbitrary arbitrary
- coarbitrary (a :*: b) = coarbitrary a . coarbitrary b
-
-instance Arbitrary Word8 where
- arbitrary = choose (97, 105)
- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))
-
-instance Arbitrary Int64 where
- arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n)
- coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1))
-
-instance Arbitrary a => Arbitrary (MaybeS a) where
- arbitrary = do a <- arbitrary ; elements [NothingS, JustS a]
- coarbitrary NothingS = variant 0
- coarbitrary _ = variant 1 -- ok?
-
-{-
-instance Arbitrary Char where
- arbitrary = choose ('\0', '\255') -- since we have to test words, unlines too
- coarbitrary c = variant (ord c `rem` 16)
-
-instance Arbitrary Word8 where
- arbitrary = choose (minBound, maxBound)
- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 16))
--}
-
-instance Random Word8 where
- randomR = integralRandomR
- random = randomR (minBound,maxBound)
-
-instance Random Int64 where
- randomR = integralRandomR
- random = randomR (minBound,maxBound)
-
-integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
-integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
- fromIntegral b :: Integer) g of
- (x,g) -> (fromIntegral x, g)
-
-instance Arbitrary L.ByteString where
- arbitrary = arbitrary >>= return . L.fromChunks . filter (not. P.null) -- maintain the invariant.
- coarbitrary s = coarbitrary (L.unpack s)
-
-instance Arbitrary P.ByteString where
- arbitrary = P.pack `fmap` arbitrary
- coarbitrary s = coarbitrary (P.unpack s)
-
-------------------------------------------------------------------------
---
--- We're doing two forms of testing here. Firstly, model based testing.
--- For our Lazy and strict bytestring types, we have model types:
---
--- i.e. Lazy == Byte
--- \\ //
--- List
---
--- That is, the Lazy type can be modeled by functions in both the Byte
--- and List type. For each of the 3 models, we have a set of tests that
--- check those types match.
---
--- The Model class connects a type and its model type, via a conversion
--- function.
---
---
-class Model a b where
- model :: a -> b -- get the abstract vale from a concrete value
-
---
--- Connecting our Lazy and Strict types to their models. We also check
--- the data invariant on Lazy types.
---
--- These instances represent the arrows in the above diagram
---
-instance Model B P where model = abstr . checkInvariant
-instance Model P [W] where model = P.unpack
-instance Model P [Char] where model = PC.unpack
-instance Model B [W] where model = L.unpack . checkInvariant
-instance Model B [Char] where model = LC.unpack . checkInvariant
-
--- Types are trivially modeled by themselves
-instance Model Bool Bool where model = id
-instance Model Int Int where model = id
-instance Model Int64 Int64 where model = id
-instance Model Int64 Int where model = fromIntegral
-instance Model Word8 Word8 where model = id
-instance Model Ordering Ordering where model = id
-
--- More structured types are modeled recursively, using the NatTrans class from Gofer.
-class (Functor f, Functor g) => NatTrans f g where
- eta :: f a -> g a
-
--- The transformation of the same type is identity
-instance NatTrans [] [] where eta = id
-instance NatTrans Maybe Maybe where eta = id
-instance NatTrans ((->) X) ((->) X) where eta = id
-instance NatTrans ((->) W) ((->) W) where eta = id
-
--- We have a transformation of pairs, if the pairs are in Model
-instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a)
-
--- And finally, we can take any (m a) to (n b), if we can Model m n, and a b
-instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x)
-
-------------------------------------------------------------------------
-
--- In a form more useful for QC testing (and it's lazy)
-checkInvariant :: L.ByteString -> L.ByteString
-checkInvariant cs0 = check cs0
- where check L.Empty = L.Empty
- check (L.Chunk c cs)
- | P.null c = error ("invariant violation: " ++ show cs0)
- | otherwise = L.Chunk c (check cs)
-
-abstr :: L.ByteString -> P.ByteString
-abstr = P.concat . L.toChunks
-
--- Some short hand.
-type X = Int
-type W = Word8
-type P = P.ByteString
-type B = L.ByteString
-
-------------------------------------------------------------------------
---
--- These comparison functions handle wrapping and equality.
---
--- A single class for these would be nice, but note that they differe in
--- the number of arguments, and those argument types, so we'd need HList
--- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs
---
-
-eq1 f g = \a ->
- model (f a) == g (model a)
-eq2 f g = \a b ->
- model (f a b) == g (model a) (model b)
-eq3 f g = \a b c ->
- model (f a b c) == g (model a) (model b) (model c)
-eq4 f g = \a b c d ->
- model (f a b c d) == g (model a) (model b) (model c) (model d)
-eq5 f g = \a b c d e ->
- model (f a b c d e) == g (model a) (model b) (model c) (model d) (model e)
-
---
--- And for functions that take non-null input
---
-eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x
-eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y
-eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z
-
-class IsNull t where isNull :: t -> Bool
-instance IsNull L.ByteString where isNull = L.null
-instance IsNull P.ByteString where isNull = P.null
-
-main = do
- x <- getArgs
- let n = if null x then 100 else read . head $ x
- mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
-
---
--- Test that, after loop fusion, our code behaves the same as the
--- unfused lazy or list models. Use -ddump-simpl to also check that
--- rules are firing for each case.
---
-tests = -- 29/5/06, all tests are fusing:
- [("down/down list", mytest prop_downdown_list) -- checked
- ,("down/filter list", mytest prop_downfilter_list) -- checked
- ,("down/map list", mytest prop_downmap_list) -- checked
- ,("filter/down lazy", mytest prop_filterdown_lazy) -- checked
- ,("filter/down list", mytest prop_filterdown_list) -- checked
- ,("filter/filter lazy", mytest prop_filterfilter_lazy) -- checked
- ,("filter/filter list", mytest prop_filterfilter_list) -- checked
- ,("filter/map lazy", mytest prop_filtermap_lazy) -- checked
- ,("filter/map list", mytest prop_filtermap_list) -- checked
- ,("filter/up lazy", mytest prop_filterup_lazy) -- checked
- ,("filter/up list", mytest prop_filterup_list) -- checked
- ,("map/down lazy", mytest prop_mapdown_lazy) -- checked
- ,("map/down list", mytest prop_mapdown_list) -- checked
- ,("map/filter lazy", mytest prop_mapfilter_lazy) -- checked
- ,("map/filter list", mytest prop_mapfilter_list) -- checked
- ,("map/map lazy", mytest prop_mapmap_lazy) -- checked
- ,("map/map list", mytest prop_mapmap_list) -- checked
- ,("map/up lazy", mytest prop_mapup_lazy) -- checked
- ,("map/up list", mytest prop_mapup_list) -- checked
- ,("up/filter lazy", mytest prop_upfilter_lazy) -- checked
- ,("up/filter list", mytest prop_upfilter_list) -- checked
- ,("up/map lazy", mytest prop_upmap_lazy) -- checked
- ,("up/map list", mytest prop_upmap_list) -- checked
- ,("up/up lazy", mytest prop_upup_lazy) -- checked
- ,("up/up list", mytest prop_upup_list) -- checked
- ,("noacc/noacc lazy", mytest prop_noacc_noacc_lazy) -- checked
- ,("noacc/noacc list", mytest prop_noacc_noacc_list) -- checked
- ,("noacc/up lazy", mytest prop_noacc_up_lazy) -- checked
- ,("noacc/up list", mytest prop_noacc_up_list) -- checked
- ,("up/noacc lazy", mytest prop_up_noacc_lazy) -- checked
- ,("up/noacc list", mytest prop_up_noacc_list) -- checked
- ,("map/noacc lazy", mytest prop_map_noacc_lazy) -- checked
- ,("map/noacc list", mytest prop_map_noacc_list) -- checked
- ,("noacc/map lazy", mytest prop_noacc_map_lazy) -- checked
- ,("noacc/map list", mytest prop_noacc_map_list) -- checked
- ,("filter/noacc lazy", mytest prop_filter_noacc_lazy) -- checked
- ,("filter/noacc list", mytest prop_filter_noacc_list) -- checked
- ,("noacc/filter lazy", mytest prop_noacc_filter_lazy) -- checked
- ,("noacc/filter list", mytest prop_noacc_filter_list) -- checked
- ,("noacc/down lazy", mytest prop_noacc_down_lazy) -- checked
- ,("noacc/down list", mytest prop_noacc_down_list) -- checked
--- ,("down/noacc lazy", mytest prop_down_noacc_lazy) -- checked
- ,("down/noacc list", mytest prop_down_noacc_list) -- checked
-
-
- ,("length/loop list", mytest prop_lengthloop_list)
--- ,("length/loop lazy", mytest prop_lengthloop_lazy)
- ,("maximum/loop list", mytest prop_maximumloop_list)
--- ,("maximum/loop lazy", mytest prop_maximumloop_lazy)
- ,("minimum/loop list", mytest prop_minimumloop_list)
--- ,("minimum/loop lazy", mytest prop_minimumloop_lazy)
-
- ]
-
-prop_upup_list = eq3
- (\f g -> P.foldl f (0::Int) . P.scanl g (0::W))
- ((\f g -> foldl f (0::Int) . scanl g (0::W)) :: (X -> W -> X) -> (W -> W -> W) -> [W] -> X)
-
-prop_upup_lazy = eq3
- (\f g -> L.foldl f (0::X) . L.scanl g (0::W))
- (\f g -> P.foldl f (0::X) . P.scanl g (0::W))
-
-prop_mapmap_list = eq3
- (\f g -> P.map f . P.map g)
- ((\f g -> map f . map g) :: (W -> W) -> (W -> W) -> [W] -> [W])
-
-prop_mapmap_lazy = eq3
- (\f g -> L.map f . L.map g)
- (\f g -> P.map f . P.map g)
-
-prop_filterfilter_list = eq3
- (\f g -> P.filter f . P.filter g)
- ((\f g -> filter f . filter g) :: (W -> Bool) -> (W -> Bool) -> [W] -> [W])
-
-prop_filterfilter_lazy = eq3
- (\f g -> L.filter f . L.filter g)
- (\f g -> P.filter f . P.filter g)
-
-prop_mapfilter_list = eq3
- (\f g -> P.filter f . P.map g)
- ((\f g -> filter f . map g) :: (W -> Bool) -> (W -> W) -> [W] -> [W])
-
-prop_mapfilter_lazy = eq3
- (\f g -> L.filter f . L.map g)
- (\f g -> P.filter f . P.map g)
-
-prop_filtermap_list = eq3
- (\f g -> P.map f . P.filter g)
- ((\f g -> map f . filter g) :: (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-prop_filtermap_lazy = eq3
- (\f g -> L.map f . L.filter g)
- (\f g -> P.map f . P.filter g)
-
-prop_mapup_list = eq3
- (\f g -> P.foldl g (0::W) . P.map f)
- ((\f g -> foldl g (0::W) . map f) :: (W -> W) -> (W -> W -> W) -> [W] -> W)
-
-prop_mapup_lazy = eq3
- (\f g -> L.foldl g (0::W) . L.map f) -- n.b. scan doesn't fuse here, atm
- (\f g -> P.foldl g (0::W) . P.map f)
-
-prop_upmap_list = eq3
- (\f g -> P.map f . P.scanl g (0::W))
- ((\f g -> map f . scanl g (0::W)) :: (W -> W) -> (W -> W -> W) -> [W] -> [W])
-
-prop_upmap_lazy = eq3
- (\f g -> L.map f . L.scanl g (0::W))
- (\f g -> P.map f . P.scanl g (0::W))
-
-prop_filterup_list = eq3
- (\f g -> P.foldl g (0::W) . P.filter f)
- ((\f g -> foldl g (0::W) . filter f) :: (W -> Bool) -> (W -> W -> W) -> [W] -> W)
-
-prop_filterup_lazy = eq3
- (\f g -> L.foldl g (0::W) . L.filter f)
- (\f g -> P.foldl g (0::W) . P.filter f)
-
-prop_upfilter_list = eq3
- (\f g -> P.filter f . P.scanl g (0::W))
- ((\f g -> filter f . scanl g (0::W)) :: (W -> Bool) -> (W -> W -> W) -> [W] -> [W])
-
-prop_upfilter_lazy = eq3
- (\f g -> L.filter f . L.scanl g (0::W))
- (\f g -> P.filter f . P.scanl g (0::W))
-
-prop_downdown_list = eq3
- (\f g -> P.foldr f (0::X) . P.scanr g (0::W))
- ((\f g -> foldr f (0::X) . scanr g (0::W)) :: (W -> X -> X) -> (W -> W -> W) -> [W] -> X)
-
-{-
--- no lazy scanr yet
-prop_downdown_lazy = eq3
- (\f g -> L.foldr f (0::X) . L.scanr g (0::W))
- (\f g -> P.foldr f (0::X) . P.scanr g (0::W))
--}
-
-prop_mapdown_list = eq3
- (\f g -> P.foldr g (0::W) . P.map f)
- ((\f g -> foldr g (0::W) . map f) :: (W -> W) -> (W -> W -> W) -> [W] -> W)
-
-prop_mapdown_lazy = eq3
- (\f g -> L.foldr g (0::W) . L.map f) -- n.b. scan doesn't fuse here, atm
- (\f g -> P.foldr g (0::W) . P.map f)
-
-prop_downmap_list = eq3
- (\f g -> P.map f . P.scanr g (0::W))
- ((\f g -> map f . scanr g (0::W)) :: (W -> W) -> (W -> W -> W) -> [W] -> [W])
-
-{-
-prop_downmap_lazy = eq3
- (\f g -> L.map f . L.scanr g (0::W))
- (\f g -> P.map f . P.scanr g (0::W))
--}
-
-prop_filterdown_list = eq3
- (\f g -> P.foldr g (0::W) . P.filter f)
- ((\f g -> foldr g (0::W) . filter f) :: (W -> Bool) -> (W -> W -> W) -> [W] -> W)
-
-prop_filterdown_lazy = eq3
- (\f g -> L.foldr g (0::W) . L.filter f) -- n.b. scan doesn't fuse here, atm
- (\f g -> P.foldr g (0::W) . P.filter f)
-
-prop_downfilter_list = eq3
- (\f g -> P.filter f . P.scanr g (0::W))
- ((\f g -> filter f . scanr g (0::W)) :: (W -> Bool) -> (W -> W -> W) -> [W] -> [W])
-
-{-
-prop_downfilter_lazy = eq3
- (\f g -> L.filter f . L.scanr g (0::W))
- (\f g -> P.filter f . P.scanr g (0::W))
--}
-
-prop_noacc_noacc_list = eq5
- (\f g h i -> (P.map f . P.filter g) . (P.map h . P.filter i))
- ((\f g h i -> ( map f . filter g) . ( map h . filter i))
- :: (W -> W) -> (W -> Bool) -> (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-prop_noacc_noacc_lazy = eq5
- (\f g h i -> (L.map f . L.filter g) . (L.map h . L.filter i))
- (\f g h i -> (P.map f . P.filter g) . (P.map h . P.filter i))
-
-prop_noacc_up_list = eq4
- ( \g h i -> P.foldl g (0::W) . (P.map h . P.filter i))
- ((\g h i -> foldl g (0::W) . ( map h . filter i))
- :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> W)
-
-prop_noacc_up_lazy = eq4
- (\g h i -> L.foldl g (0::W) . (L.map h . L.filter i))
- (\g h i -> P.foldl g (0::W) . (P.map h . P.filter i))
-
-prop_up_noacc_list = eq4
- ( \g h i -> (P.map h . P.filter i) . P.scanl g (0::W))
- ((\g h i -> ( map h . filter i) . scanl g (0::W))
- :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-prop_up_noacc_lazy = eq4
- (\g h i -> (L.map h . L.filter i) . L.scanl g (0::W))
- (\g h i -> (P.map h . P.filter i) . P.scanl g (0::W))
-
-prop_map_noacc_list = eq4
- ( \g h i -> (P.map h . P.filter i) . P.map g)
- ((\g h i -> ( map h . filter i) . map g)
- :: (W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-prop_map_noacc_lazy = eq4
- (\g h i -> (L.map h . L.filter i) . L.map g)
- (\g h i -> (P.map h . P.filter i) . P.map g)
-
-prop_noacc_map_list = eq4
- ( \g h i -> P.map g . (P.map h . P.filter i))
- ((\g h i -> map g . ( map h . filter i))
- :: (W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-prop_noacc_map_lazy = eq4
- (\g h i -> L.map g . (L.map h . L.filter i))
- (\g h i -> P.map g . (P.map h . P.filter i))
-
-prop_filter_noacc_list = eq4
- ( \g h i -> (P.map h . P.filter i) . P.filter g)
- ((\g h i -> ( map h . filter i) . filter g)
- :: (W -> Bool) -> (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-prop_filter_noacc_lazy = eq4
- (\g h i -> (L.map h . L.filter i) . L.filter g)
- (\g h i -> (P.map h . P.filter i) . P.filter g)
-
-prop_noacc_filter_list = eq4
- ( \g h i -> P.filter g . (P.map h . P.filter i))
- ((\g h i -> filter g . ( map h . filter i))
- :: (W -> Bool) -> (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-prop_noacc_filter_lazy = eq4
- (\g h i -> L.filter g . (L.map h . L.filter i))
- (\g h i -> P.filter g . (P.map h . P.filter i))
-
-prop_noacc_down_list = eq4
- ( \g h i -> P.foldr g (0::W) . (P.map h . P.filter i))
- ((\g h i -> foldr g (0::W) . ( map h . filter i))
- :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> W)
-
-prop_noacc_down_lazy = eq4
- (\g h i -> L.foldr g (0::W) . (L.map h . L.filter i))
- (\g h i -> P.foldr g (0::W) . (P.map h . P.filter i))
-
-prop_down_noacc_list = eq4
- ( \g h i -> (P.map h . P.filter i) . P.scanr g (0::W))
- ((\g h i -> ( map h . filter i) . scanr g (0::W))
- :: (W -> W -> W) -> (W -> W) -> (W -> Bool) -> [W] -> [W])
-
-{-
-prop_down_noacc_lazy = eq4
- (\g h i -> (L.map h . L.filter i) . L.scanl g (0::W))
- (\g h i -> (P.map h . P.filter i) . P.scanl g (0::W))
--}
-
-------------------------------------------------------------------------
-
-prop_lengthloop_list = eq2
- (\f -> P.length . P.filter f)
- ((\f -> length . filter f) :: (W -> Bool) -> [W] -> X)
-
-{-
-prop_lengthloop_lazy = eq2
- (\f g -> L.length . L.filter f) -- n.b. scan doesn't fuse here, atm
- (\f g -> P.length . P.filter f)
--}
-
-prop_maximumloop_list = eqnotnull2
- (\f -> P.maximum . P.map f) -- so we don't get null strings
- ((\f -> maximum . map f) :: (W -> W) -> [W] -> W)
-
-{-
-prop_maximumloop_lazy = eq2
- (\f g -> L.maximum . L.filter f) -- n.b. scan doesn't fuse here, atm
- (\f g -> P.maximum . P.filter f)
--}
-
-prop_minimumloop_list = eqnotnull2
- (\f -> P.minimum . P.map f)
- ((\f -> minimum . map f) :: (W -> W) -> [W] -> W)
-
-{-
-prop_minimumloop_lazy = eq2
- (\f g -> L.minimum . L.filter f) -- n.b. scan doesn't fuse here, atm
- (\f g -> P.minimum . P.filter f)
--}
-
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring004.stdout b/testsuite/tests/lib/Data.ByteString/bytestring004.stdout
deleted file mode 100644
index cbc88dbf91..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring004.stdout
+++ /dev/null
@@ -1,45 +0,0 @@
-down/down list : OK, 100 tests.
-down/filter list : OK, 100 tests.
-down/map list : OK, 100 tests.
-filter/down lazy : OK, 100 tests.
-filter/down list : OK, 100 tests.
-filter/filter lazy : OK, 100 tests.
-filter/filter list : OK, 100 tests.
-filter/map lazy : OK, 100 tests.
-filter/map list : OK, 100 tests.
-filter/up lazy : OK, 100 tests.
-filter/up list : OK, 100 tests.
-map/down lazy : OK, 100 tests.
-map/down list : OK, 100 tests.
-map/filter lazy : OK, 100 tests.
-map/filter list : OK, 100 tests.
-map/map lazy : OK, 100 tests.
-map/map list : OK, 100 tests.
-map/up lazy : OK, 100 tests.
-map/up list : OK, 100 tests.
-up/filter lazy : OK, 100 tests.
-up/filter list : OK, 100 tests.
-up/map lazy : OK, 100 tests.
-up/map list : OK, 100 tests.
-up/up lazy : OK, 100 tests.
-up/up list : OK, 100 tests.
-noacc/noacc lazy : OK, 100 tests.
-noacc/noacc list : OK, 100 tests.
-noacc/up lazy : OK, 100 tests.
-noacc/up list : OK, 100 tests.
-up/noacc lazy : OK, 100 tests.
-up/noacc list : OK, 100 tests.
-map/noacc lazy : OK, 100 tests.
-map/noacc list : OK, 100 tests.
-noacc/map lazy : OK, 100 tests.
-noacc/map list : OK, 100 tests.
-filter/noacc lazy : OK, 100 tests.
-filter/noacc list : OK, 100 tests.
-noacc/filter lazy : OK, 100 tests.
-noacc/filter list : OK, 100 tests.
-noacc/down lazy : OK, 100 tests.
-noacc/down list : OK, 100 tests.
-down/noacc list : OK, 100 tests.
-length/loop list : OK, 100 tests.
-maximum/loop list : OK, 100 tests.
-minimum/loop list : OK, 100 tests.
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring005.hs b/testsuite/tests/lib/Data.ByteString/bytestring005.hs
deleted file mode 100644
index 7bd37da004..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring005.hs
+++ /dev/null
@@ -1,1138 +0,0 @@
-#!/usr/bin/env runhaskell
---
--- Uses multi-param type classes
---
-
-import Test.QuickCheck
-import Text.Show.Functions
-
-import Data.Char
-import Data.Int
-import Data.List
-import Data.Maybe
-import Data.Word
-
-import System.IO
-import System.Environment
-import System.IO.Unsafe
-import System.Random
-
-import Control.Monad ( liftM2 )
-import Control.Monad.Instances ()
-
-import Text.Printf
-import Debug.Trace
-
-import Foreign.Ptr
-
-import Data.ByteString.Lazy (ByteString(..), pack , unpack)
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Internal as L
-
-import Data.ByteString.Fusion
-import qualified Data.ByteString as P
-import qualified Data.ByteString.Unsafe as P
-import qualified Data.ByteString.Lazy as L
-
-import qualified Data.ByteString.Char8 as PC
-import qualified Data.ByteString.Lazy.Char8 as LC
-import qualified Data.ByteString as P
-import qualified Data.ByteString.Internal as P
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy.Char8 as D
-import Data.ByteString.Fusion
-
-import Prelude hiding (abs)
-
--- Enable this to get verbose test output. Including the actual tests.
-debug = False
-
-mytest :: Testable a => a -> Int -> IO ()
-mytest a n = mycheck defaultConfig
- { configMaxTest=n
- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a
-
-mycheck :: Testable a => Config -> a -> IO ()
-mycheck config a =
- do let rnd = mkStdGen 99
- mytests config (evaluate a) rnd 0 0 []
-
-mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()
-mytests config gen rnd0 ntest nfail stamps
- | ntest == configMaxTest config = do done "OK," ntest stamps
- | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
- | otherwise =
- do putStr (configEvery config ntest (arguments result)) >> hFlush stdout
- case ok result of
- Nothing ->
- mytests config gen rnd1 ntest (nfail+1) stamps
- Just True ->
- mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
- Just False ->
- putStr ( "Falsifiable after "
- ++ show ntest
- ++ " tests:\n"
- ++ unlines (arguments result)
- ) >> hFlush stdout
- where
- result = generate (configSize config ntest) rnd2 gen
- (rnd1,rnd2) = split rnd0
-
-done :: String -> Int -> [[String]] -> IO ()
-done mesg ntest stamps =
- do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )
- where
- table = display
- . map entry
- . reverse
- . sort
- . map pairLength
- . group
- . sort
- . filter (not . null)
- $ stamps
-
- display [] = ".\n"
- display [x] = " (" ++ x ++ ").\n"
- display xs = ".\n" ++ unlines (map (++ ".") xs)
-
- pairLength xss@(xs:_) = (length xss, xs)
- entry (n, xs) = percentage n ntest
- ++ " "
- ++ concat (intersperse ", " xs)
-
- percentage n m = show ((100 * n) `div` m) ++ "%"
-
-------------------------------------------------------------------------
-
-instance Arbitrary Char where
- arbitrary = choose ('a', 'i')
- coarbitrary c = variant (ord c `rem` 4)
-
-instance (Arbitrary a, Arbitrary b) => Arbitrary (PairS a b) where
- arbitrary = liftM2 (:*:) arbitrary arbitrary
- coarbitrary (a :*: b) = coarbitrary a . coarbitrary b
-
-instance Arbitrary Word8 where
- arbitrary = choose (97, 105)
- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))
-
-instance Arbitrary Int64 where
- arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n)
- coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1))
-
-instance Arbitrary a => Arbitrary (MaybeS a) where
- arbitrary = do a <- arbitrary ; elements [NothingS, JustS a]
- coarbitrary NothingS = variant 0
- coarbitrary _ = variant 1 -- ok?
-
-{-
-instance Arbitrary Char where
- arbitrary = choose ('\0', '\255') -- since we have to test words, unlines too
- coarbitrary c = variant (ord c `rem` 16)
-
-instance Arbitrary Word8 where
- arbitrary = choose (minBound, maxBound)
- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 16))
--}
-
-instance Random Word8 where
- randomR = integralRandomR
- random = randomR (minBound,maxBound)
-
-instance Random Int64 where
- randomR = integralRandomR
- random = randomR (minBound,maxBound)
-
-integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)
-integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,
- fromIntegral b :: Integer) g of
- (x,g) -> (fromIntegral x, g)
-
-instance Arbitrary L.ByteString where
- arbitrary = arbitrary >>= return . L.fromChunks . filter (not. P.null) -- maintain the invariant.
- coarbitrary s = coarbitrary (L.unpack s)
-
-instance Arbitrary P.ByteString where
- arbitrary = P.pack `fmap` arbitrary
- coarbitrary s = coarbitrary (P.unpack s)
-
-------------------------------------------------------------------------
---
--- We're doing two forms of testing here. Firstly, model based testing.
--- For our Lazy and strict bytestring types, we have model types:
---
--- i.e. Lazy == Byte
--- \\ //
--- List
---
--- That is, the Lazy type can be modeled by functions in both the Byte
--- and List type. For each of the 3 models, we have a set of tests that
--- check those types match.
---
--- The Model class connects a type and its model type, via a conversion
--- function.
---
---
-class Model a b where
- model :: a -> b -- get the abstract vale from a concrete value
-
---
--- Connecting our Lazy and Strict types to their models. We also check
--- the data invariant on Lazy types.
---
--- These instances represent the arrows in the above diagram
---
-instance Model B P where model = abstr . checkInvariant
-instance Model P [W] where model = P.unpack
-instance Model P [Char] where model = PC.unpack
-instance Model B [W] where model = L.unpack . checkInvariant
-instance Model B [Char] where model = LC.unpack . checkInvariant
-
--- Types are trivially modeled by themselves
-instance Model Bool Bool where model = id
-instance Model Int Int where model = id
-instance Model Int64 Int64 where model = id
-instance Model Int64 Int where model = fromIntegral
-instance Model Word8 Word8 where model = id
-instance Model Ordering Ordering where model = id
-
--- More structured types are modeled recursively, using the NatTrans class from Gofer.
-class (Functor f, Functor g) => NatTrans f g where
- eta :: f a -> g a
-
--- The transformation of the same type is identity
-instance NatTrans [] [] where eta = id
-instance NatTrans Maybe Maybe where eta = id
-instance NatTrans ((->) X) ((->) X) where eta = id
-instance NatTrans ((->) W) ((->) W) where eta = id
-
--- We have a transformation of pairs, if the pairs are in Model
-instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a)
-
--- And finally, we can take any (m a) to (n b), if we can Model m n, and a b
-instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x)
-
-------------------------------------------------------------------------
-
--- In a form more useful for QC testing (and it's lazy)
-checkInvariant :: L.ByteString -> L.ByteString
-checkInvariant cs0 = check cs0
- where check L.Empty = L.Empty
- check (L.Chunk c cs)
- | P.null c = error ("invariant violation: " ++ show cs0)
- | otherwise = L.Chunk c (check cs)
-
-abstr :: L.ByteString -> P.ByteString
-abstr = P.concat . L.toChunks
-
--- Some short hand.
-type X = Int
-type W = Word8
-type P = P.ByteString
-type B = L.ByteString
-
-------------------------------------------------------------------------
---
--- These comparison functions handle wrapping and equality.
---
--- A single class for these would be nice, but note that they differe in
--- the number of arguments, and those argument types, so we'd need HList
--- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs
---
-
-eq1 f g = \a ->
- model (f a) == g (model a)
-eq2 f g = \a b ->
- model (f a b) == g (model a) (model b)
-eq3 f g = \a b c ->
- model (f a b c) == g (model a) (model b) (model c)
-eq4 f g = \a b c d ->
- model (f a b c d) == g (model a) (model b) (model c) (model d)
-eq5 f g = \a b c d e ->
- model (f a b c d e) == g (model a) (model b) (model c) (model d) (model e)
-
---
--- And for functions that take non-null input
---
-eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x
-eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y
-eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z
-
-class IsNull t where isNull :: t -> Bool
-instance IsNull L.ByteString where isNull = L.null
-instance IsNull P.ByteString where isNull = P.null
-
-------------------------------------------------------------------------
-
---
--- These are miscellaneous tests left over. Or else they test some
--- property internal to a type (i.e. head . sort == minimum), without
--- reference to a model type.
---
-
-invariant :: L.ByteString -> Bool
-invariant L.Empty = True
-invariant (L.Chunk c cs) = not (P.null c) && invariant cs
-
-prop_invariant = invariant
-
-prop_eq_refl x = x == (x :: ByteString)
-prop_eq_symm x y = (x == y) == (y == (x :: ByteString))
-
-prop_eq1 xs = xs == (unpack . pack $ xs)
-prop_eq2 xs = xs == (xs :: ByteString)
-prop_eq3 xs ys = (xs == ys) == (unpack xs == unpack ys)
-
-prop_compare1 xs = (pack xs `compare` pack xs) == EQ
-prop_compare2 xs c = (pack (xs++[c]) `compare` pack xs) == GT
-prop_compare3 xs c = (pack xs `compare` pack (xs++[c])) == LT
-
-prop_compare4 xs = (not (null xs)) ==> (pack xs `compare` L.empty) == GT
-prop_compare5 xs = (not (null xs)) ==> (L.empty `compare` pack xs) == LT
-prop_compare6 xs ys = (not (null ys)) ==> (pack (xs++ys) `compare` pack xs) == GT
-
-prop_compare7 x y = x `compare` y == (L.singleton x `compare` L.singleton y)
-prop_compare8 xs ys = xs `compare` ys == (L.pack xs `compare` L.pack ys)
-
-prop_empty1 = L.length L.empty == 0
-prop_empty2 = L.unpack L.empty == []
-
-prop_packunpack s = (L.unpack . L.pack) s == id s
-prop_unpackpack s = (L.pack . L.unpack) s == id s
-
-prop_null xs = null (L.unpack xs) == L.null xs
-
-prop_length1 xs = fromIntegral (length xs) == L.length (L.pack xs)
-
-prop_length2 xs = L.length xs == length1 xs
- where length1 ys
- | L.null ys = 0
- | otherwise = 1 + length1 (L.tail ys)
-
-prop_cons1 c xs = unpack (L.cons c (pack xs)) == (c:xs)
-prop_cons2 c = L.singleton c == (c `L.cons` L.empty)
-prop_cons3 c = unpack (L.singleton c) == (c:[])
-prop_cons4 c = (c `L.cons` L.empty) == pack (c:[])
-
-prop_snoc1 xs c = xs ++ [c] == unpack ((pack xs) `L.snoc` c)
-
-prop_head xs = (not (null xs)) ==> head xs == (L.head . pack) xs
-prop_head1 xs = not (L.null xs) ==> L.head xs == head (L.unpack xs)
-
-prop_tail xs = not (L.null xs) ==> L.tail xs == pack (tail (unpack xs))
-prop_tail1 xs = (not (null xs)) ==> tail xs == (unpack . L.tail . pack) xs
-
-prop_last xs = (not (null xs)) ==> last xs == (L.last . pack) xs
-
-prop_init xs =
- (not (null xs)) ==>
- init xs == (unpack . L.init . pack) xs
-
-prop_append1 xs = (xs ++ xs) == (unpack $ pack xs `L.append` pack xs)
-prop_append2 xs ys = (xs ++ ys) == (unpack $ pack xs `L.append` pack ys)
-prop_append3 xs ys = L.append xs ys == pack (unpack xs ++ unpack ys)
-
-prop_map1 f xs = L.map f (pack xs) == pack (map f xs)
-prop_map2 f g xs = L.map f (L.map g xs) == L.map (f . g) xs
-prop_map3 f xs = map f xs == (unpack . L.map f . pack) xs
-
-prop_filter1 c xs = (filter (/=c) xs) == (unpack $ L.filter (/=c) (pack xs))
-prop_filter2 p xs = (filter p xs) == (unpack $ L.filter p (pack xs))
-
-prop_reverse xs = reverse xs == (unpack . L.reverse . pack) xs
-prop_reverse1 xs = L.reverse (pack xs) == pack (reverse xs)
-prop_reverse2 xs = reverse (unpack xs) == (unpack . L.reverse) xs
-
-prop_transpose xs = (transpose xs) == ((map unpack) . L.transpose . (map pack)) xs
-
-prop_foldl f c xs = L.foldl f c (pack xs) == foldl f c xs
- where _ = c :: Char
-
-prop_foldr f c xs = L.foldl f c (pack xs) == foldl f c xs
- where _ = c :: Char
-
-prop_foldl_1 xs = L.foldl (\xs c -> c `L.cons` xs) L.empty xs == L.reverse xs
-prop_foldr_1 xs = L.foldr (\c xs -> c `L.cons` xs) L.empty xs == id xs
-
-prop_foldl1_1 xs =
- (not . L.null) xs ==>
- L.foldl1 (\x c -> if c > x then c else x) xs ==
- L.foldl (\x c -> if c > x then c else x) 0 xs
-
-prop_foldl1_2 xs =
- (not . L.null) xs ==>
- L.foldl1 const xs == L.head xs
-
-prop_foldl1_3 xs =
- (not . L.null) xs ==>
- L.foldl1 (flip const) xs == L.last xs
-
-prop_foldr1_1 xs =
- (not . L.null) xs ==>
- L.foldr1 (\c x -> if c > x then c else x) xs ==
- L.foldr (\c x -> if c > x then c else x) 0 xs
-
-prop_foldr1_2 xs =
- (not . L.null) xs ==>
- L.foldr1 (flip const) xs == L.last xs
-
-prop_foldr1_3 xs =
- (not . L.null) xs ==>
- L.foldr1 const xs == L.head xs
-
-prop_concat1 xs = (concat [xs,xs]) == (unpack $ L.concat [pack xs, pack xs])
-prop_concat2 xs = (concat [xs,[]]) == (unpack $ L.concat [pack xs, pack []])
-prop_concat3 xss = L.concat (map pack xss) == pack (concat xss)
-
-prop_concatMap xs = L.concatMap L.singleton xs == (pack . concatMap (:[]) . unpack) xs
-
-prop_any xs a = (any (== a) xs) == (L.any (== a) (pack xs))
-prop_all xs a = (all (== a) xs) == (L.all (== a) (pack xs))
-
-prop_maximum xs = (not (null xs)) ==> (maximum xs) == (L.maximum ( pack xs ))
-prop_minimum xs = (not (null xs)) ==> (minimum xs) == (L.minimum ( pack xs ))
-
-prop_replicate1 n c =
- (n >= 0) ==> unpack (L.replicate (fromIntegral n) c) == replicate n c
-
-prop_replicate2 c = unpack (L.replicate 0 c) == replicate 0 c
-
-prop_take1 i xs = L.take (fromIntegral i) (pack xs) == pack (take i xs)
-prop_drop1 i xs = L.drop (fromIntegral i) (pack xs) == pack (drop i xs)
-
-prop_splitAt i xs = collect (i >= 0 && i < length xs) $
- L.splitAt (fromIntegral i) (pack xs) == let (a,b) = splitAt i xs in (pack a, pack b)
-
-prop_takeWhile f xs = L.takeWhile f (pack xs) == pack (takeWhile f xs)
-prop_dropWhile f xs = L.dropWhile f (pack xs) == pack (dropWhile f xs)
-
-prop_break f xs = L.break f (pack xs) ==
- let (a,b) = break f xs in (pack a, pack b)
-
-prop_breakspan xs c = L.break (==c) xs == L.span (/=c) xs
-
-prop_span xs a = (span (/=a) xs) == (let (x,y) = L.span (/=a) (pack xs) in (unpack x, unpack y))
-
--- prop_breakByte xs c = L.break (== c) xs == L.breakByte c xs
-
--- prop_spanByte c xs = (L.span (==c) xs) == L.spanByte c xs
-
-prop_split c xs = (map L.unpack . map checkInvariant . L.split c $ xs)
- == (map P.unpack . P.split c . P.pack . L.unpack $ xs)
-
-prop_splitWith f xs = (l1 == l2 || l1 == l2+1) &&
- sum (map L.length splits) == L.length xs - l2
- where splits = L.splitWith f xs
- l1 = fromIntegral (length splits)
- l2 = L.length (L.filter f xs)
-
-prop_joinsplit c xs = L.intercalate (pack [c]) (L.split c xs) == id xs
-
-prop_group xs = group xs == (map unpack . L.group . pack) xs
--- prop_groupBy f xs = groupBy f xs == (map unpack . L.groupBy f . pack) xs
-
--- prop_joinjoinByte xs ys c = L.joinWithByte c xs ys == L.join (L.singleton c) [xs,ys]
-
-prop_index xs =
- not (null xs) ==>
- forAll indices $ \i -> (xs !! i) == L.pack xs `L.index` (fromIntegral i)
- where indices = choose (0, length xs -1)
-
-prop_elemIndex xs c = (elemIndex c xs) == fmap fromIntegral (L.elemIndex c (pack xs))
-
-prop_elemIndices xs c = elemIndices c xs == map fromIntegral (L.elemIndices c (pack xs))
-
-prop_count c xs = length (L.elemIndices c xs) == fromIntegral (L.count c xs)
-
-prop_findIndex xs f = (findIndex f xs) == fmap fromIntegral (L.findIndex f (pack xs))
-prop_findIndicies xs f = (findIndices f xs) == map fromIntegral (L.findIndices f (pack xs))
-
-prop_elem xs c = (c `elem` xs) == (c `L.elem` (pack xs))
-prop_notElem xs c = (c `notElem` xs) == (L.notElem c (pack xs))
-prop_elem_notelem xs c = c `L.elem` xs == not (c `L.notElem` xs)
-
--- prop_filterByte xs c = L.filterByte c xs == L.filter (==c) xs
--- prop_filterByte2 xs c = unpack (L.filterByte c xs) == filter (==c) (unpack xs)
-
--- prop_filterNotByte xs c = L.filterNotByte c xs == L.filter (/=c) xs
--- prop_filterNotByte2 xs c = unpack (L.filterNotByte c xs) == filter (/=c) (unpack xs)
-
-prop_find p xs = find p xs == L.find p (pack xs)
-
-prop_find_findIndex p xs =
- L.find p xs == case L.findIndex p xs of
- Just n -> Just (xs `L.index` n)
- _ -> Nothing
-
-prop_isPrefixOf xs ys = isPrefixOf xs ys == (pack xs `L.isPrefixOf` pack ys)
-
-{-
-prop_sort1 xs = sort xs == (unpack . L.sort . pack) xs
-prop_sort2 xs = (not (null xs)) ==> (L.head . L.sort . pack $ xs) == minimum xs
-prop_sort3 xs = (not (null xs)) ==> (L.last . L.sort . pack $ xs) == maximum xs
-prop_sort4 xs ys =
- (not (null xs)) ==>
- (not (null ys)) ==>
- (L.head . L.sort) (L.append (pack xs) (pack ys)) == min (minimum xs) (minimum ys)
-
-prop_sort5 xs ys =
- (not (null xs)) ==>
- (not (null ys)) ==>
- (L.last . L.sort) (L.append (pack xs) (pack ys)) == max (maximum xs) (maximum ys)
-
--}
-
-------------------------------------------------------------------------
--- Misc ByteString properties
-
-prop_nil1BB = P.length P.empty == 0
-prop_nil2BB = P.unpack P.empty == []
-
-prop_tailSBB xs = not (P.null xs) ==> P.tail xs == P.pack (tail (P.unpack xs))
-
-prop_nullBB xs = null (P.unpack xs) == P.null xs
-
-prop_lengthBB xs = P.length xs == length1 xs
- where
- length1 ys
- | P.null ys = 0
- | otherwise = 1 + length1 (P.tail ys)
-
-prop_lengthSBB xs = length xs == P.length (P.pack xs)
-
-prop_indexBB xs =
- not (null xs) ==>
- forAll indices $ \i -> (xs !! i) == P.pack xs `P.index` i
- where indices = choose (0, length xs -1)
-
-prop_unsafeIndexBB xs =
- not (null xs) ==>
- forAll indices $ \i -> (xs !! i) == P.pack xs `P.unsafeIndex` i
- where indices = choose (0, length xs -1)
-
-prop_mapfusionBB f g xs = P.map f (P.map g xs) == P.map (f . g) xs
-
-prop_filterBB f xs = P.filter f (P.pack xs) == P.pack (filter f xs)
-
-prop_filterfusionBB f g xs = P.filter f (P.filter g xs) == P.filter (\c -> f c && g c) xs
-
-prop_elemSBB x xs = P.elem x (P.pack xs) == elem x xs
-
-prop_takeSBB i xs = P.take i (P.pack xs) == P.pack (take i xs)
-prop_dropSBB i xs = P.drop i (P.pack xs) == P.pack (drop i xs)
-
-prop_splitAtSBB i xs = -- collect (i >= 0 && i < length xs) $
- P.splitAt i (P.pack xs) ==
- let (a,b) = splitAt i xs in (P.pack a, P.pack b)
-
-prop_foldlBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs
- where types = c :: Char
-
-prop_scanlfoldlBB f z xs = not (P.null xs) ==> P.last (P.scanl f z xs) == P.foldl f z xs
-
-prop_foldrBB f c xs = P.foldl f c (P.pack xs) == foldl f c xs
- where types = c :: Char
-
-prop_takeWhileSBB f xs = P.takeWhile f (P.pack xs) == P.pack (takeWhile f xs)
-prop_dropWhileSBB f xs = P.dropWhile f (P.pack xs) == P.pack (dropWhile f xs)
-
-prop_spanSBB f xs = P.span f (P.pack xs) ==
- let (a,b) = span f xs in (P.pack a, P.pack b)
-
-prop_breakSBB f xs = P.break f (P.pack xs) ==
- let (a,b) = break f xs in (P.pack a, P.pack b)
-
-prop_breakspan_1BB xs c = P.break (== c) xs == P.span (/= c) xs
-
-prop_linesSBB xs = C.lines (C.pack xs) == map C.pack (lines xs)
-
-prop_unlinesSBB xss = C.unlines (map C.pack xss) == C.pack (unlines xss)
-
-prop_wordsSBB xs =
- C.words (C.pack xs) == map C.pack (words xs)
-
-prop_unwordsSBB xss = C.unwords (map C.pack xss) == C.pack (unwords xss)
-
-prop_splitWithBB f xs = (l1 == l2 || l1 == l2+1) &&
- sum (map P.length splits) == P.length xs - l2
- where splits = P.splitWith f xs
- l1 = length splits
- l2 = P.length (P.filter f xs)
-
-prop_joinsplitBB c xs = P.intercalate (P.pack [c]) (P.split c xs) == xs
-
--- prop_linessplitBB xs =
--- (not . C.null) xs ==>
--- C.lines' xs == C.split '\n' xs
-
-prop_linessplit2BB xs =
- C.lines xs == C.split '\n' xs ++ (if C.last xs == '\n' then [C.empty] else [])
-
-prop_splitsplitWithBB c xs = P.split c xs == P.splitWith (== c) xs
-
-prop_bijectionBB c = (P.w2c . P.c2w) c == id c
-prop_bijectionBB' w = (P.c2w . P.w2c) w == id w
-
-prop_packunpackBB s = (P.unpack . P.pack) s == id s
-prop_packunpackBB' s = (P.pack . P.unpack) s == id s
-
-prop_eq1BB xs = xs == (P.unpack . P.pack $ xs)
-prop_eq2BB xs = xs == xs
-prop_eq3BB xs ys = (xs == ys) == (P.unpack xs == P.unpack ys)
-
-prop_compare1BB xs = (P.pack xs `compare` P.pack xs) == EQ
-prop_compare2BB xs c = (P.pack (xs++[c]) `compare` P.pack xs) == GT
-prop_compare3BB xs c = (P.pack xs `compare` P.pack (xs++[c])) == LT
-
-prop_compare4BB xs = (not (null xs)) ==> (P.pack xs `compare` P.empty) == GT
-prop_compare5BB xs = (not (null xs)) ==> (P.empty `compare` P.pack xs) == LT
-prop_compare6BB xs ys= (not (null ys)) ==> (P.pack (xs++ys) `compare` P.pack xs) == GT
-
-prop_compare7BB x y = x `compare` y == (C.singleton x `compare` C.singleton y)
-prop_compare8BB xs ys = xs `compare` ys == (P.pack xs `compare` P.pack ys)
-
-prop_consBB c xs = P.unpack (P.cons c (P.pack xs)) == (c:xs)
-prop_cons1BB xs = 'X' : xs == C.unpack ('X' `C.cons` (C.pack xs))
-prop_cons2BB xs c = c : xs == P.unpack (c `P.cons` (P.pack xs))
-prop_cons3BB c = C.unpack (C.singleton c) == (c:[])
-prop_cons4BB c = (c `P.cons` P.empty) == P.pack (c:[])
-
-prop_snoc1BB xs c = xs ++ [c] == P.unpack ((P.pack xs) `P.snoc` c)
-
-prop_head1BB xs = (not (null xs)) ==> head xs == (P.head . P.pack) xs
-prop_head2BB xs = (not (null xs)) ==> head xs == (P.unsafeHead . P.pack) xs
-prop_head3BB xs = not (P.null xs) ==> P.head xs == head (P.unpack xs)
-
-prop_tailBB xs = (not (null xs)) ==> tail xs == (P.unpack . P.tail . P.pack) xs
-prop_tail1BB xs = (not (null xs)) ==> tail xs == (P.unpack . P.unsafeTail. P.pack) xs
-
-prop_lastBB xs = (not (null xs)) ==> last xs == (P.last . P.pack) xs
-
-prop_initBB xs =
- (not (null xs)) ==>
- init xs == (P.unpack . P.init . P.pack) xs
-
--- prop_null xs = (null xs) ==> null xs == (nullPS (pack xs))
-
-prop_append1BB xs = (xs ++ xs) == (P.unpack $ P.pack xs `P.append` P.pack xs)
-prop_append2BB xs ys = (xs ++ ys) == (P.unpack $ P.pack xs `P.append` P.pack ys)
-prop_append3BB xs ys = P.append xs ys == P.pack (P.unpack xs ++ P.unpack ys)
-
-prop_map1BB f xs = P.map f (P.pack xs) == P.pack (map f xs)
-prop_map2BB f g xs = P.map f (P.map g xs) == P.map (f . g) xs
-prop_map3BB f xs = map f xs == (P.unpack . P.map f . P.pack) xs
--- prop_mapBB' f xs = P.map' f (P.pack xs) == P.pack (map f xs)
-
-prop_filter1BB xs = (filter (=='X') xs) == (C.unpack $ C.filter (=='X') (C.pack xs))
-prop_filter2BB p xs = (filter p xs) == (P.unpack $ P.filter p (P.pack xs))
-
-prop_findBB p xs = find p xs == P.find p (P.pack xs)
-
-prop_find_findIndexBB p xs =
- P.find p xs == case P.findIndex p xs of
- Just n -> Just (xs `P.unsafeIndex` n)
- _ -> Nothing
-
-prop_foldl1BB xs a = ((foldl (\x c -> if c == a then x else c:x) [] xs)) ==
- (P.unpack $ P.foldl (\x c -> if c == a then x else c `P.cons` x) P.empty (P.pack xs))
-prop_foldl2BB xs = P.foldl (\xs c -> c `P.cons` xs) P.empty (P.pack xs) == P.reverse (P.pack xs)
-
-prop_foldr1BB xs a = ((foldr (\c x -> if c == a then x else c:x) [] xs)) ==
- (P.unpack $ P.foldr (\c x -> if c == a then x else c `P.cons` x)
- P.empty (P.pack xs))
-
-prop_foldr2BB xs = P.foldr (\c xs -> c `P.cons` xs) P.empty (P.pack xs) == (P.pack xs)
-
-prop_foldl1_1BB xs =
- (not . P.null) xs ==>
- P.foldl1 (\x c -> if c > x then c else x) xs ==
- P.foldl (\x c -> if c > x then c else x) 0 xs
-
-prop_foldl1_2BB xs =
- (not . P.null) xs ==>
- P.foldl1 const xs == P.head xs
-
-prop_foldl1_3BB xs =
- (not . P.null) xs ==>
- P.foldl1 (flip const) xs == P.last xs
-
-prop_foldr1_1BB xs =
- (not . P.null) xs ==>
- P.foldr1 (\c x -> if c > x then c else x) xs ==
- P.foldr (\c x -> if c > x then c else x) 0 xs
-
-prop_foldr1_2BB xs =
- (not . P.null) xs ==>
- P.foldr1 (flip const) xs == P.last xs
-
-prop_foldr1_3BB xs =
- (not . P.null) xs ==>
- P.foldr1 const xs == P.head xs
-
-prop_takeWhileBB xs a = (takeWhile (/= a) xs) == (P.unpack . (P.takeWhile (/= a)) . P.pack) xs
-
-prop_dropWhileBB xs a = (dropWhile (/= a) xs) == (P.unpack . (P.dropWhile (/= a)) . P.pack) xs
-
-prop_takeBB xs = (take 10 xs) == (P.unpack . (P.take 10) . P.pack) xs
-
-prop_dropBB xs = (drop 10 xs) == (P.unpack . (P.drop 10) . P.pack) xs
-
-prop_splitAtBB i xs = -- collect (i >= 0 && i < length xs) $
- splitAt i xs ==
- let (x,y) = P.splitAt i (P.pack xs) in (P.unpack x, P.unpack y)
-
-prop_spanBB xs a = (span (/=a) xs) == (let (x,y) = P.span (/=a) (P.pack xs)
- in (P.unpack x, P.unpack y))
-
-prop_breakBB xs a = (break (/=a) xs) == (let (x,y) = P.break (/=a) (P.pack xs)
- in (P.unpack x, P.unpack y))
-
-prop_reverse1BB xs = (reverse xs) == (P.unpack . P.reverse . P.pack) xs
-prop_reverse2BB xs = P.reverse (P.pack xs) == P.pack (reverse xs)
-prop_reverse3BB xs = reverse (P.unpack xs) == (P.unpack . P.reverse) xs
-
-prop_elemBB xs a = (a `elem` xs) == (a `P.elem` (P.pack xs))
-
-prop_notElemBB c xs = P.notElem c (P.pack xs) == notElem c xs
-
--- should try to stress it
-prop_concat1BB xs = (concat [xs,xs]) == (P.unpack $ P.concat [P.pack xs, P.pack xs])
-prop_concat2BB xs = (concat [xs,[]]) == (P.unpack $ P.concat [P.pack xs, P.pack []])
-prop_concatBB xss = P.concat (map P.pack xss) == P.pack (concat xss)
-
-prop_concatMapBB xs = C.concatMap C.singleton xs == (C.pack . concatMap (:[]) . C.unpack) xs
-
-prop_anyBB xs a = (any (== a) xs) == (P.any (== a) (P.pack xs))
-prop_allBB xs a = (all (== a) xs) == (P.all (== a) (P.pack xs))
-
-prop_linesBB xs = (lines xs) == ((map C.unpack) . C.lines . C.pack) xs
-
-prop_unlinesBB xs = (unlines.lines) xs == (C.unpack. C.unlines . C.lines .C.pack) xs
-
-prop_wordsBB xs =
- (words xs) == ((map C.unpack) . C.words . C.pack) xs
--- prop_wordstokensBB xs = C.words xs == C.tokens isSpace xs
-
-prop_unwordsBB xs =
- (C.pack.unwords.words) xs == (C.unwords . C.words .C.pack) xs
-
-prop_groupBB xs = group xs == (map P.unpack . P.group . P.pack) xs
-
-prop_groupByBB xs = groupBy (==) xs == (map P.unpack . P.groupBy (==) . P.pack) xs
-prop_groupBy1BB xs = groupBy (/=) xs == (map P.unpack . P.groupBy (/=) . P.pack) xs
-
-prop_joinBB xs ys = (concat . (intersperse ys) . lines) xs ==
- (C.unpack $ C.intercalate (C.pack ys) (C.lines (C.pack xs)))
-
-prop_elemIndex1BB xs = (elemIndex 'X' xs) == (C.elemIndex 'X' (C.pack xs))
-prop_elemIndex2BB xs c = (elemIndex c xs) == (C.elemIndex c (C.pack xs))
-
--- prop_lineIndices1BB xs = C.elemIndices '\n' xs == C.lineIndices xs
-
-prop_countBB c xs = length (P.elemIndices c xs) == P.count c xs
-
-prop_elemIndexEnd1BB c xs = (P.elemIndexEnd c (P.pack xs)) ==
- (case P.elemIndex c (P.pack (reverse xs)) of
- Nothing -> Nothing
- Just i -> Just (length xs -1 -i))
-
-prop_elemIndexEnd2BB c xs = (P.elemIndexEnd c (P.pack xs)) ==
- ((-) (length xs - 1) `fmap` P.elemIndex c (P.pack $ reverse xs))
-
-prop_elemIndicesBB xs c = elemIndices c xs == P.elemIndices c (P.pack xs)
-
-prop_findIndexBB xs a = (findIndex (==a) xs) == (P.findIndex (==a) (P.pack xs))
-
-prop_findIndiciesBB xs c = (findIndices (==c) xs) == (P.findIndices (==c) (P.pack xs))
-
--- example properties from QuickCheck.Batch
-prop_sort1BB xs = sort xs == (P.unpack . P.sort . P.pack) xs
-prop_sort2BB xs = (not (null xs)) ==> (P.head . P.sort . P.pack $ xs) == minimum xs
-prop_sort3BB xs = (not (null xs)) ==> (P.last . P.sort . P.pack $ xs) == maximum xs
-prop_sort4BB xs ys =
- (not (null xs)) ==>
- (not (null ys)) ==>
- (P.head . P.sort) (P.append (P.pack xs) (P.pack ys)) == min (minimum xs) (minimum ys)
-prop_sort5BB xs ys =
- (not (null xs)) ==>
- (not (null ys)) ==>
- (P.last . P.sort) (P.append (P.pack xs) (P.pack ys)) == max (maximum xs) (maximum ys)
-
-prop_intersperseBB c xs = (intersperse c xs) == (P.unpack $ P.intersperse c (P.pack xs))
-
-prop_transposeBB xs = (transpose xs) == ((map P.unpack) . P.transpose . (map P.pack)) xs
-
-prop_maximumBB xs = (not (null xs)) ==> (maximum xs) == (P.maximum ( P.pack xs ))
-prop_minimumBB xs = (not (null xs)) ==> (minimum xs) == (P.minimum ( P.pack xs ))
-
--- prop_dropSpaceBB xs = dropWhile isSpace xs == C.unpack (C.dropSpace (C.pack xs))
--- prop_dropSpaceEndBB xs = (C.reverse . (C.dropWhile isSpace) . C.reverse) (C.pack xs) ==
--- (C.dropSpaceEnd (C.pack xs))
-
--- prop_breakSpaceBB xs =
--- (let (x,y) = C.breakSpace (C.pack xs)
--- in (C.unpack x, C.unpack y)) == (break isSpace xs)
-
-prop_spanEndBB xs =
- (C.spanEnd (not . isSpace) (C.pack xs)) ==
- (let (x,y) = C.span (not.isSpace) (C.reverse (C.pack xs)) in (C.reverse y,C.reverse x))
-
-prop_breakEndBB p xs = P.breakEnd (not.p) xs == P.spanEnd p xs
-
--- prop_breakCharBB c xs =
--- (break (==c) xs) ==
--- (let (x,y) = C.breakChar c (C.pack xs) in (C.unpack x, C.unpack y))
-
--- prop_spanCharBB c xs =
--- (break (/=c) xs) ==
--- (let (x,y) = C.spanChar c (C.pack xs) in (C.unpack x, C.unpack y))
-
--- prop_spanChar_1BB c xs =
--- (C.span (==c) xs) == C.spanChar c xs
-
--- prop_wordsBB' xs =
--- (C.unpack . C.unwords . C.words' . C.pack) xs ==
--- (map (\c -> if isSpace c then ' ' else c) xs)
-
--- prop_linesBB' xs = (C.unpack . C.unlines' . C.lines' . C.pack) xs == (xs)
-
-prop_unfoldrBB c n =
- (fst $ C.unfoldrN n fn c) == (C.pack $ take n $ unfoldr fn c)
- where
- fn x = Just (x, chr (ord x + 1))
-
-prop_prefixBB xs ys = isPrefixOf xs ys == (P.pack xs `P.isPrefixOf` P.pack ys)
-prop_suffixBB xs ys = isSuffixOf xs ys == (P.pack xs `P.isSuffixOf` P.pack ys)
-
-prop_copyBB xs = let p = P.pack xs in P.copy p == p
-
-prop_initsBB xs = inits xs == map P.unpack (P.inits (P.pack xs))
-
-prop_tailsBB xs = tails xs == map P.unpack (P.tails (P.pack xs))
-
-prop_findSubstringsBB s x l
- = C.findSubstrings (C.pack p) (C.pack s) == naive_findSubstrings p s
- where
- _ = l :: Int
- _ = x :: Int
-
- -- we look for some random substring of the test string
- p = take (model l) $ drop (model x) s
-
- -- naive reference implementation
- naive_findSubstrings :: String -> String -> [Int]
- naive_findSubstrings p s = [x | x <- [0..length s], p `isPrefixOf` drop x s]
-
-prop_replicate1BB n c = P.unpack (P.replicate n c) == replicate n c
-prop_replicate2BB n c = P.replicate n c == fst (P.unfoldrN n (\u -> Just (u,u)) c)
-
-prop_replicate3BB c = P.unpack (P.replicate 0 c) == replicate 0 c
-
-prop_readintBB n = (fst . fromJust . C.readInt . C.pack . show) n == (n :: Int)
-prop_readintLL n = (fst . fromJust . D.readInt . D.pack . show) n == (n :: Int)
-
-prop_readint2BB s =
- let s' = filter (\c -> c `notElem` ['0'..'9']) s
- in C.readInt (C.pack s') == Nothing
-
--- prop_filterChar1BB c xs = (filter (==c) xs) == ((C.unpack . C.filterChar c . C.pack) xs)
--- prop_filterChar2BB c xs = (C.filter (==c) (C.pack xs)) == (C.filterChar c (C.pack xs))
--- prop_filterChar3BB c xs = C.filterChar c xs == C.replicate (C.count c xs) c
-
--- prop_filterNotChar1BB c xs = (filter (/=c) xs) == ((C.unpack . C.filterNotChar c . C.pack) xs)
--- prop_filterNotChar2BB c xs = (C.filter (/=c) (C.pack xs)) == (C.filterNotChar c (C.pack xs))
-
--- prop_joinjoinpathBB xs ys c = C.joinWithChar c xs ys == C.join (C.singleton c) [xs,ys]
-
-prop_zipBB xs ys = zip xs ys == P.zip (P.pack xs) (P.pack ys)
-prop_zip1BB xs ys = P.zip xs ys == zip (P.unpack xs) (P.unpack ys)
-
-prop_zipWithBB xs ys = P.zipWith (,) xs ys == P.zip xs ys
--- prop_zipWith'BB xs ys = P.pack (P.zipWith (+) xs ys) == P.zipWith' (+) xs ys
-
-prop_unzipBB x = let (xs,ys) = unzip x in (P.pack xs, P.pack ys) == P.unzip x
-
-------------------------------------------------------------------------
--- The entry point
-
-main = run tests
-
-run :: [(String, Int -> IO ())] -> IO ()
-run tests = do
- x <- getArgs
- let n = if null x then 100 else read . head $ x
- mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests
-
---
--- And now a list of all the properties to test.
---
-
-tests = bb_tests ++ ll_tests
-
-------------------------------------------------------------------------
--- extra ByteString properties
-
-bb_tests =
- [ ("bijection", mytest prop_bijectionBB)
- , ("bijection'", mytest prop_bijectionBB')
- , ("pack/unpack", mytest prop_packunpackBB)
- , ("unpack/pack", mytest prop_packunpackBB')
- , ("eq 1", mytest prop_eq1BB)
- , ("eq 2", mytest prop_eq3BB)
- , ("eq 3", mytest prop_eq3BB)
- , ("compare 1", mytest prop_compare1BB)
- , ("compare 2", mytest prop_compare2BB)
- , ("compare 3", mytest prop_compare3BB)
- , ("compare 4", mytest prop_compare4BB)
- , ("compare 5", mytest prop_compare5BB)
- , ("compare 6", mytest prop_compare6BB)
- , ("compare 7", mytest prop_compare7BB)
- , ("compare 8", mytest prop_compare8BB)
- , ("empty 1", mytest prop_nil1BB)
- , ("empty 2", mytest prop_nil2BB)
- , ("null", mytest prop_nullBB)
- , ("length 1", mytest prop_lengthBB)
- , ("length 2", mytest prop_lengthSBB)
- , ("cons 1", mytest prop_consBB)
- , ("cons 2", mytest prop_cons1BB)
- , ("cons 3", mytest prop_cons2BB)
- , ("cons 4", mytest prop_cons3BB)
- , ("cons 5", mytest prop_cons4BB)
- , ("snoc", mytest prop_snoc1BB)
- , ("head 1", mytest prop_head1BB)
- , ("head 2", mytest prop_head2BB)
- , ("head 3", mytest prop_head3BB)
- , ("tail", mytest prop_tailBB)
- , ("tail 1", mytest prop_tail1BB)
- , ("last", mytest prop_lastBB)
- , ("init", mytest prop_initBB)
- , ("append 1", mytest prop_append1BB)
- , ("append 2", mytest prop_append2BB)
- , ("append 3", mytest prop_append3BB)
- , ("map 1", mytest prop_map1BB)
- , ("map 2", mytest prop_map2BB)
- , ("map 3", mytest prop_map3BB)
- , ("filter1", mytest prop_filter1BB)
- , ("filter2", mytest prop_filter2BB)
- , ("map fusion", mytest prop_mapfusionBB)
- , ("filter fusion", mytest prop_filterfusionBB)
- , ("reverse 1", mytest prop_reverse1BB)
- , ("reverse 2", mytest prop_reverse2BB)
- , ("reverse 3", mytest prop_reverse3BB)
- , ("foldl 1", mytest prop_foldl1BB)
- , ("foldl 2", mytest prop_foldl2BB)
- , ("foldr 1", mytest prop_foldr1BB)
- , ("foldr 2", mytest prop_foldr2BB)
- , ("foldl1 1", mytest prop_foldl1_1BB)
- , ("foldl1 2", mytest prop_foldl1_2BB)
- , ("foldl1 3", mytest prop_foldl1_3BB)
- , ("foldr1 1", mytest prop_foldr1_1BB)
- , ("foldr1 2", mytest prop_foldr1_2BB)
- , ("foldr1 3", mytest prop_foldr1_3BB)
- , ("scanl/foldl", mytest prop_scanlfoldlBB)
- , ("all", mytest prop_allBB)
- , ("any", mytest prop_anyBB)
- , ("take", mytest prop_takeBB)
- , ("drop", mytest prop_dropBB)
- , ("takeWhile", mytest prop_takeWhileBB)
- , ("dropWhile", mytest prop_dropWhileBB)
- , ("splitAt", mytest prop_splitAtBB)
- , ("span", mytest prop_spanBB)
- , ("break", mytest prop_breakBB)
- , ("elem", mytest prop_elemBB)
- , ("notElem", mytest prop_notElemBB)
- , ("concat 1", mytest prop_concat1BB)
- , ("concat 2", mytest prop_concat2BB)
- , ("concat 3", mytest prop_concatBB)
- , ("lines", mytest prop_linesBB)
- , ("unlines", mytest prop_unlinesBB)
- , ("words", mytest prop_wordsBB)
- , ("unwords", mytest prop_unwordsBB)
- , ("group", mytest prop_groupBB)
- , ("groupBy", mytest prop_groupByBB)
- , ("groupBy 1", mytest prop_groupBy1BB)
- , ("join", mytest prop_joinBB)
- , ("elemIndex 1", mytest prop_elemIndex1BB)
- , ("elemIndex 2", mytest prop_elemIndex2BB)
- , ("findIndex", mytest prop_findIndexBB)
- , ("findIndicies", mytest prop_findIndiciesBB)
- , ("elemIndices", mytest prop_elemIndicesBB)
- , ("find", mytest prop_findBB)
- , ("find/findIndex", mytest prop_find_findIndexBB)
- , ("sort 1", mytest prop_sort1BB)
- , ("sort 2", mytest prop_sort2BB)
- , ("sort 3", mytest prop_sort3BB)
- , ("sort 4", mytest prop_sort4BB)
- , ("sort 5", mytest prop_sort5BB)
- , ("intersperse", mytest prop_intersperseBB)
- , ("maximum", mytest prop_maximumBB)
- , ("minimum", mytest prop_minimumBB)
--- , ("breakChar", mytest prop_breakCharBB)
--- , ("spanChar 1", mytest prop_spanCharBB)
--- , ("spanChar 2", mytest prop_spanChar_1BB)
--- , ("breakSpace", mytest prop_breakSpaceBB)
--- , ("dropSpace", mytest prop_dropSpaceBB)
- , ("spanEnd", mytest prop_spanEndBB)
- , ("breakEnd", mytest prop_breakEndBB)
- , ("elemIndexEnd 1",mytest prop_elemIndexEnd1BB)
- , ("elemIndexEnd 2",mytest prop_elemIndexEnd2BB)
--- , ("words'", mytest prop_wordsBB')
--- , ("lines'", mytest prop_linesBB')
--- , ("dropSpaceEnd", mytest prop_dropSpaceEndBB)
- , ("unfoldr", mytest prop_unfoldrBB)
- , ("prefix", mytest prop_prefixBB)
- , ("suffix", mytest prop_suffixBB)
- , ("copy", mytest prop_copyBB)
- , ("inits", mytest prop_initsBB)
- , ("tails", mytest prop_tailsBB)
- , ("findSubstrings ",mytest prop_findSubstringsBB)
- , ("replicate1", mytest prop_replicate1BB)
- , ("replicate2", mytest prop_replicate2BB)
- , ("replicate3", mytest prop_replicate3BB)
- , ("readInt", mytest prop_readintBB)
- , ("readInt 2", mytest prop_readint2BB)
- , ("Lazy.readInt", mytest prop_readintLL)
--- , ("filterChar1", mytest prop_filterChar1BB)
--- , ("filterChar2", mytest prop_filterChar2BB)
--- , ("filterChar3", mytest prop_filterChar3BB)
--- , ("filterNotChar1", mytest prop_filterNotChar1BB)
--- , ("filterNotChar2", mytest prop_filterNotChar2BB)
- , ("tail", mytest prop_tailSBB)
- , ("index", mytest prop_indexBB)
- , ("unsafeIndex", mytest prop_unsafeIndexBB)
--- , ("map'", mytest prop_mapBB')
- , ("filter", mytest prop_filterBB)
- , ("elem", mytest prop_elemSBB)
- , ("take", mytest prop_takeSBB)
- , ("drop", mytest prop_dropSBB)
- , ("splitAt", mytest prop_splitAtSBB)
- , ("foldl", mytest prop_foldlBB)
- , ("foldr", mytest prop_foldrBB)
- , ("takeWhile ", mytest prop_takeWhileSBB)
- , ("dropWhile ", mytest prop_dropWhileSBB)
- , ("span ", mytest prop_spanSBB)
- , ("break ", mytest prop_breakSBB)
- , ("breakspan", mytest prop_breakspan_1BB)
- , ("lines ", mytest prop_linesSBB)
- , ("unlines ", mytest prop_unlinesSBB)
- , ("words ", mytest prop_wordsSBB)
- , ("unwords ", mytest prop_unwordsSBB)
--- , ("wordstokens", mytest prop_wordstokensBB)
- , ("splitWith", mytest prop_splitWithBB)
- , ("joinsplit", mytest prop_joinsplitBB)
--- , ("lineIndices", mytest prop_lineIndices1BB)
- , ("count", mytest prop_countBB)
--- , ("linessplit", mytest prop_linessplitBB)
- , ("splitsplitWith", mytest prop_splitsplitWithBB)
--- , ("joinjoinpath", mytest prop_joinjoinpathBB)
- , ("zip", mytest prop_zipBB)
- , ("zip1", mytest prop_zip1BB)
- , ("zipWith", mytest prop_zipWithBB)
--- , ("zipWith'", mytest prop_zipWith'BB)
- , ("unzip", mytest prop_unzipBB)
- , ("concatMap", mytest prop_concatMapBB)
- ]
-
-
-------------------------------------------------------------------------
--- Extra lazy properties
-
-ll_tests =
- [("eq 1", mytest prop_eq1)
- ,("eq 2", mytest prop_eq2)
- ,("eq 3", mytest prop_eq3)
- ,("eq refl", mytest prop_eq_refl)
- ,("eq symm", mytest prop_eq_symm)
- ,("compare 1", mytest prop_compare1)
- ,("compare 2", mytest prop_compare2)
- ,("compare 3", mytest prop_compare3)
- ,("compare 4", mytest prop_compare4)
- ,("compare 5", mytest prop_compare5)
- ,("compare 6", mytest prop_compare6)
- ,("compare 7", mytest prop_compare7)
- ,("compare 8", mytest prop_compare8)
- ,("empty 1", mytest prop_empty1)
- ,("empty 2", mytest prop_empty2)
- ,("pack/unpack", mytest prop_packunpack)
- ,("unpack/pack", mytest prop_unpackpack)
- ,("null", mytest prop_null)
- ,("length 1", mytest prop_length1)
- ,("length 2", mytest prop_length2)
- ,("cons 1" , mytest prop_cons1)
- ,("cons 2" , mytest prop_cons2)
- ,("cons 3" , mytest prop_cons3)
- ,("cons 4" , mytest prop_cons4)
- ,("snoc" , mytest prop_snoc1)
- ,("head/pack", mytest prop_head)
- ,("head/unpack", mytest prop_head1)
- ,("tail/pack", mytest prop_tail)
- ,("tail/unpack", mytest prop_tail1)
- ,("last", mytest prop_last)
- ,("init", mytest prop_init)
- ,("append 1", mytest prop_append1)
- ,("append 2", mytest prop_append2)
- ,("append 3", mytest prop_append3)
- ,("map 1", mytest prop_map1)
- ,("map 2", mytest prop_map2)
- ,("map 3", mytest prop_map3)
- ,("filter 1", mytest prop_filter1)
- ,("filter 2", mytest prop_filter2)
- ,("reverse", mytest prop_reverse)
- ,("reverse1", mytest prop_reverse1)
- ,("reverse2", mytest prop_reverse2)
- ,("transpose", mytest prop_transpose)
- ,("foldl", mytest prop_foldl)
- ,("foldl/reverse", mytest prop_foldl_1)
- ,("foldr", mytest prop_foldr)
- ,("foldr/id", mytest prop_foldr_1)
- ,("foldl1/foldl", mytest prop_foldl1_1)
- ,("foldl1/head", mytest prop_foldl1_2)
- ,("foldl1/tail", mytest prop_foldl1_3)
- ,("foldr1/foldr", mytest prop_foldr1_1)
- ,("foldr1/last", mytest prop_foldr1_2)
- ,("foldr1/head", mytest prop_foldr1_3)
- ,("concat 1", mytest prop_concat1)
- ,("concat 2", mytest prop_concat2)
- ,("concat/pack", mytest prop_concat3)
- ,("any", mytest prop_any)
- ,("all", mytest prop_all)
- ,("maximum", mytest prop_maximum)
- ,("minimum", mytest prop_minimum)
- ,("replicate 1", mytest prop_replicate1)
- ,("replicate 2", mytest prop_replicate2)
- ,("take", mytest prop_take1)
- ,("drop", mytest prop_drop1)
- ,("splitAt", mytest prop_drop1)
- ,("takeWhile", mytest prop_takeWhile)
- ,("dropWhile", mytest prop_dropWhile)
- ,("break", mytest prop_break)
- ,("span", mytest prop_span)
- ,("break/span", mytest prop_breakspan)
--- ,("break/breakByte", mytest prop_breakByte)
--- ,("span/spanByte", mytest prop_spanByte)
- ,("split", mytest prop_split)
- ,("splitWith", mytest prop_splitWith)
- ,("join.split/id", mytest prop_joinsplit)
--- ,("join/joinByte", mytest prop_joinjoinByte)
- ,("group", mytest prop_group)
--- ,("groupBy", mytest prop_groupBy)
- ,("index", mytest prop_index)
- ,("elemIndex", mytest prop_elemIndex)
- ,("elemIndices", mytest prop_elemIndices)
- ,("count/elemIndices", mytest prop_count)
- ,("findIndex", mytest prop_findIndex)
- ,("findIndices", mytest prop_findIndicies)
- ,("find", mytest prop_find)
- ,("find/findIndex", mytest prop_find_findIndex)
- ,("elem", mytest prop_elem)
- ,("notElem", mytest prop_notElem)
- ,("elem/notElem", mytest prop_elem_notelem)
--- ,("filterByte 1", mytest prop_filterByte)
--- ,("filterByte 2", mytest prop_filterByte2)
--- ,("filterNotByte 1", mytest prop_filterNotByte)
--- ,("filterNotByte 2", mytest prop_filterNotByte2)
- ,("isPrefixOf", mytest prop_isPrefixOf)
- ,("concatMap", mytest prop_concatMap)
- ]
-
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring005.stdout b/testsuite/tests/lib/Data.ByteString/bytestring005.stdout
deleted file mode 100644
index 2efe5278dc..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring005.stdout
+++ /dev/null
@@ -1,226 +0,0 @@
-bijection : OK, 100 tests.
-bijection' : OK, 100 tests.
-pack/unpack : OK, 100 tests.
-unpack/pack : OK, 100 tests.
-eq 1 : OK, 100 tests.
-eq 2 : OK, 100 tests.
-eq 3 : OK, 100 tests.
-compare 1 : OK, 100 tests.
-compare 2 : OK, 100 tests.
-compare 3 : OK, 100 tests.
-compare 4 : OK, 100 tests.
-compare 5 : OK, 100 tests.
-compare 6 : OK, 100 tests.
-compare 7 : OK, 100 tests.
-compare 8 : OK, 100 tests.
-empty 1 : OK, 100 tests.
-empty 2 : OK, 100 tests.
-null : OK, 100 tests.
-length 1 : OK, 100 tests.
-length 2 : OK, 100 tests.
-cons 1 : OK, 100 tests.
-cons 2 : OK, 100 tests.
-cons 3 : OK, 100 tests.
-cons 4 : OK, 100 tests.
-cons 5 : OK, 100 tests.
-snoc : OK, 100 tests.
-head 1 : OK, 100 tests.
-head 2 : OK, 100 tests.
-head 3 : OK, 100 tests.
-tail : OK, 100 tests.
-tail 1 : OK, 100 tests.
-last : OK, 100 tests.
-init : OK, 100 tests.
-append 1 : OK, 100 tests.
-append 2 : OK, 100 tests.
-append 3 : OK, 100 tests.
-map 1 : OK, 100 tests.
-map 2 : OK, 100 tests.
-map 3 : OK, 100 tests.
-filter1 : OK, 100 tests.
-filter2 : OK, 100 tests.
-map fusion : OK, 100 tests.
-filter fusion : OK, 100 tests.
-reverse 1 : OK, 100 tests.
-reverse 2 : OK, 100 tests.
-reverse 3 : OK, 100 tests.
-foldl 1 : OK, 100 tests.
-foldl 2 : OK, 100 tests.
-foldr 1 : OK, 100 tests.
-foldr 2 : OK, 100 tests.
-foldl1 1 : OK, 100 tests.
-foldl1 2 : OK, 100 tests.
-foldl1 3 : OK, 100 tests.
-foldr1 1 : OK, 100 tests.
-foldr1 2 : OK, 100 tests.
-foldr1 3 : OK, 100 tests.
-scanl/foldl : OK, 100 tests.
-all : OK, 100 tests.
-any : OK, 100 tests.
-take : OK, 100 tests.
-drop : OK, 100 tests.
-takeWhile : OK, 100 tests.
-dropWhile : OK, 100 tests.
-splitAt : OK, 100 tests.
-span : OK, 100 tests.
-break : OK, 100 tests.
-elem : OK, 100 tests.
-notElem : OK, 100 tests.
-concat 1 : OK, 100 tests.
-concat 2 : OK, 100 tests.
-concat 3 : OK, 100 tests.
-lines : OK, 100 tests.
-unlines : OK, 100 tests.
-words : OK, 100 tests.
-unwords : OK, 100 tests.
-group : OK, 100 tests.
-groupBy : OK, 100 tests.
-groupBy 1 : OK, 100 tests.
-join : OK, 100 tests.
-elemIndex 1 : OK, 100 tests.
-elemIndex 2 : OK, 100 tests.
-findIndex : OK, 100 tests.
-findIndicies : OK, 100 tests.
-elemIndices : OK, 100 tests.
-find : OK, 100 tests.
-find/findIndex : OK, 100 tests.
-sort 1 : OK, 100 tests.
-sort 2 : OK, 100 tests.
-sort 3 : OK, 100 tests.
-sort 4 : OK, 100 tests.
-sort 5 : OK, 100 tests.
-intersperse : OK, 100 tests.
-maximum : OK, 100 tests.
-minimum : OK, 100 tests.
-spanEnd : OK, 100 tests.
-breakEnd : OK, 100 tests.
-elemIndexEnd 1 : OK, 100 tests.
-elemIndexEnd 2 : OK, 100 tests.
-unfoldr : OK, 100 tests.
-prefix : OK, 100 tests.
-suffix : OK, 100 tests.
-copy : OK, 100 tests.
-inits : OK, 100 tests.
-tails : OK, 100 tests.
-findSubstrings : OK, 100 tests.
-replicate1 : OK, 100 tests.
-replicate2 : OK, 100 tests.
-replicate3 : OK, 100 tests.
-readInt : OK, 100 tests.
-readInt 2 : OK, 100 tests.
-Lazy.readInt : OK, 100 tests.
-tail : OK, 100 tests.
-index : OK, 100 tests.
-unsafeIndex : OK, 100 tests.
-filter : OK, 100 tests.
-elem : OK, 100 tests.
-take : OK, 100 tests.
-drop : OK, 100 tests.
-splitAt : OK, 100 tests.
-foldl : OK, 100 tests.
-foldr : OK, 100 tests.
-takeWhile : OK, 100 tests.
-dropWhile : OK, 100 tests.
-span : OK, 100 tests.
-break : OK, 100 tests.
-breakspan : OK, 100 tests.
-lines : OK, 100 tests.
-unlines : OK, 100 tests.
-words : OK, 100 tests.
-unwords : OK, 100 tests.
-splitWith : OK, 100 tests.
-joinsplit : OK, 100 tests.
-count : OK, 100 tests.
-splitsplitWith : OK, 100 tests.
-zip : OK, 100 tests.
-zip1 : OK, 100 tests.
-zipWith : OK, 100 tests.
-unzip : OK, 100 tests.
-concatMap : OK, 100 tests.
-eq 1 : OK, 100 tests.
-eq 2 : OK, 100 tests.
-eq 3 : OK, 100 tests.
-eq refl : OK, 100 tests.
-eq symm : OK, 100 tests.
-compare 1 : OK, 100 tests.
-compare 2 : OK, 100 tests.
-compare 3 : OK, 100 tests.
-compare 4 : OK, 100 tests.
-compare 5 : OK, 100 tests.
-compare 6 : OK, 100 tests.
-compare 7 : OK, 100 tests.
-compare 8 : OK, 100 tests.
-empty 1 : OK, 100 tests.
-empty 2 : OK, 100 tests.
-pack/unpack : OK, 100 tests.
-unpack/pack : OK, 100 tests.
-null : OK, 100 tests.
-length 1 : OK, 100 tests.
-length 2 : OK, 100 tests.
-cons 1 : OK, 100 tests.
-cons 2 : OK, 100 tests.
-cons 3 : OK, 100 tests.
-cons 4 : OK, 100 tests.
-snoc : OK, 100 tests.
-head/pack : OK, 100 tests.
-head/unpack : OK, 100 tests.
-tail/pack : OK, 100 tests.
-tail/unpack : OK, 100 tests.
-last : OK, 100 tests.
-init : OK, 100 tests.
-append 1 : OK, 100 tests.
-append 2 : OK, 100 tests.
-append 3 : OK, 100 tests.
-map 1 : OK, 100 tests.
-map 2 : OK, 100 tests.
-map 3 : OK, 100 tests.
-filter 1 : OK, 100 tests.
-filter 2 : OK, 100 tests.
-reverse : OK, 100 tests.
-reverse1 : OK, 100 tests.
-reverse2 : OK, 100 tests.
-transpose : OK, 100 tests.
-foldl : OK, 100 tests.
-foldl/reverse : OK, 100 tests.
-foldr : OK, 100 tests.
-foldr/id : OK, 100 tests.
-foldl1/foldl : OK, 100 tests.
-foldl1/head : OK, 100 tests.
-foldl1/tail : OK, 100 tests.
-foldr1/foldr : OK, 100 tests.
-foldr1/last : OK, 100 tests.
-foldr1/head : OK, 100 tests.
-concat 1 : OK, 100 tests.
-concat 2 : OK, 100 tests.
-concat/pack : OK, 100 tests.
-any : OK, 100 tests.
-all : OK, 100 tests.
-maximum : OK, 100 tests.
-minimum : OK, 100 tests.
-replicate 1 : OK, 100 tests.
-replicate 2 : OK, 100 tests.
-take : OK, 100 tests.
-drop : OK, 100 tests.
-splitAt : OK, 100 tests.
-takeWhile : OK, 100 tests.
-dropWhile : OK, 100 tests.
-break : OK, 100 tests.
-span : OK, 100 tests.
-break/span : OK, 100 tests.
-split : OK, 100 tests.
-splitWith : OK, 100 tests.
-join.split/id : OK, 100 tests.
-group : OK, 100 tests.
-index : OK, 100 tests.
-elemIndex : OK, 100 tests.
-elemIndices : OK, 100 tests.
-count/elemIndices : OK, 100 tests.
-findIndex : OK, 100 tests.
-findIndices : OK, 100 tests.
-find : OK, 100 tests.
-find/findIndex : OK, 100 tests.
-elem : OK, 100 tests.
-notElem : OK, 100 tests.
-elem/notElem : OK, 100 tests.
-isPrefixOf : OK, 100 tests.
-concatMap : OK, 100 tests.
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring006.hs b/testsuite/tests/lib/Data.ByteString/bytestring006.hs
deleted file mode 100644
index d58147a485..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring006.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-
-module Main (main) where
-
-import qualified Data.ByteString.Char8 as B
-import qualified Data.ByteString.Lazy.Char8 as L
-
-main :: IO ()
-main = do print $ map B.unpack $ B.lines $ B.pack "a\n\nb\n\nc"
- print $ map L.unpack $ L.lines $ L.pack "a\n\nb\n\nc"
-
diff --git a/testsuite/tests/lib/Data.ByteString/bytestring006.stdout b/testsuite/tests/lib/Data.ByteString/bytestring006.stdout
deleted file mode 100644
index 240d746197..0000000000
--- a/testsuite/tests/lib/Data.ByteString/bytestring006.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-["a","","b","","c"]
-["a","","b","","c"]
diff --git a/testsuite/tests/lib/OldException/OldException001.hs b/testsuite/tests/lib/OldException/OldException001.hs
deleted file mode 100644
index 150dc2aba7..0000000000
--- a/testsuite/tests/lib/OldException/OldException001.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-
--- trace #2913
-
-{-# LANGUAGE DeriveDataTypeable #-}
-
-import qualified Control.Exception as New
-import qualified Control.OldException as Old
-
-import Data.Typeable
-
-data MyException = MyException
- deriving (Eq, Show, Typeable)
-
-instance New.Exception MyException
-
-main :: IO ()
-main = (New.throwIO MyException
- `Old.catch`
- (\e -> do putStrLn ("Old got " ++ show e)
- Old.throw e)
- ) `New.catch` (\e -> putStrLn ("New got " ++ show (e :: MyException)))
-
diff --git a/testsuite/tests/lib/OldException/OldException001.stdout b/testsuite/tests/lib/OldException/OldException001.stdout
deleted file mode 100644
index ba73072274..0000000000
--- a/testsuite/tests/lib/OldException/OldException001.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-Old got exception :: SomeException
-New got MyException
diff --git a/testsuite/tests/lib/OldException/all.T b/testsuite/tests/lib/OldException/all.T
deleted file mode 100644
index 55459823eb..0000000000
--- a/testsuite/tests/lib/OldException/all.T
+++ /dev/null
@@ -1,3 +0,0 @@
-
-test('OldException001', normal, compile_and_run, [''])
-
diff --git a/testsuite/tests/lib/PrettyPrint/Makefile b/testsuite/tests/lib/PrettyPrint/Makefile
deleted file mode 100644
index 9101fbd40a..0000000000
--- a/testsuite/tests/lib/PrettyPrint/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/lib/PrettyPrint/T3911.hs b/testsuite/tests/lib/PrettyPrint/T3911.hs
deleted file mode 100644
index 01ccb22b01..0000000000
--- a/testsuite/tests/lib/PrettyPrint/T3911.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-
-module Main where
-
-import Text.PrettyPrint.HughesPJ
-
-xs :: [Doc]
-xs = [text "hello",
- nest 10 (text "world")]
-
-d1 :: Doc
-d1 = vcat xs
-
-d2 :: Doc
-d2 = foldr ($$) empty xs
-
-d3 :: Doc
-d3 = foldr ($+$) empty xs
-
-main :: IO ()
-main = do print d1
- print d2
- print d3
-
diff --git a/testsuite/tests/lib/PrettyPrint/T3911.stdout b/testsuite/tests/lib/PrettyPrint/T3911.stdout
deleted file mode 100644
index 7677e8d6f4..0000000000
--- a/testsuite/tests/lib/PrettyPrint/T3911.stdout
+++ /dev/null
@@ -1,4 +0,0 @@
-hello world
-hello world
-hello
- world
diff --git a/testsuite/tests/lib/PrettyPrint/all.T b/testsuite/tests/lib/PrettyPrint/all.T
deleted file mode 100644
index 5189843c15..0000000000
--- a/testsuite/tests/lib/PrettyPrint/all.T
+++ /dev/null
@@ -1,2 +0,0 @@
-test('pp1', compose(expect_broken(1062), only_ways(['normal'])), compile_and_run, [''])
-test('T3911', normal, compile_and_run, [''])
diff --git a/testsuite/tests/lib/PrettyPrint/pp1.hs b/testsuite/tests/lib/PrettyPrint/pp1.hs
deleted file mode 100644
index 384d5656b8..0000000000
--- a/testsuite/tests/lib/PrettyPrint/pp1.hs
+++ /dev/null
@@ -1,18 +0,0 @@
--- This code used to print an infinite string, by calling 'spaces'
--- with a negative argument. There's a patch in the library now,
--- which makes 'spaces' do something sensible when called with a negative
--- argument, but it really should not happen at all.
-
-
-module Main where
-
-import Text.PrettyPrint.HughesPJ
-
-
-ncat x y = nest 4 $ cat [ x, y ]
-
-d1 = foldl1 ncat $ take 50 $ repeat $ char 'a'
-d2 = parens $ sep [ d1, text "+" , d1 ]
-
-main = print d2
-
diff --git a/testsuite/tests/lib/PrettyPrint/pp1.stdout b/testsuite/tests/lib/PrettyPrint/pp1.stdout
deleted file mode 100644
index 6915311150..0000000000
--- a/testsuite/tests/lib/PrettyPrint/pp1.stdout
+++ /dev/null
@@ -1,4 +0,0 @@
-This output is not what is expected, becuase the
-test "works" now, by virtue of a hack in HughesPJ.spaces.
-I'm leaving this strange output here to remind us to look
-at the root cause of the problem. Sometime. \ No newline at end of file
diff --git a/testsuite/tests/lib/Regex/Makefile b/testsuite/tests/lib/Regex/Makefile
deleted file mode 100644
index 9101fbd40a..0000000000
--- a/testsuite/tests/lib/Regex/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/lib/Regex/all.T b/testsuite/tests/lib/Regex/all.T
deleted file mode 100644
index c69bfd665a..0000000000
--- a/testsuite/tests/lib/Regex/all.T
+++ /dev/null
@@ -1,3 +0,0 @@
-test('regex001', reqlib('regex-posix'), compile_and_run, ['-package regex-posix'])
-test('regex002', reqlib('regex-posix'), compile_and_run, ['-package regex-posix'])
-test('regex003', reqlib('regex-posix'), compile_and_run, ['-package regex-posix'])
diff --git a/testsuite/tests/lib/Regex/regex001.hs b/testsuite/tests/lib/Regex/regex001.hs
deleted file mode 100644
index 1c9393c1b2..0000000000
--- a/testsuite/tests/lib/Regex/regex001.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Main where
-
-import Control.Exception
-import Text.Regex.Posix
-
--- caused GHC 6.0 to crash, due to regfree'ing the regex after a
--- failed regcomp.
-main = sequence_
- [ try ("abc" =~~ "[[[" :: IO Bool) :: IO (Either IOException Bool)
- | _ <- [1..10000] ]
-
diff --git a/testsuite/tests/lib/Regex/regex002.hs b/testsuite/tests/lib/Regex/regex002.hs
deleted file mode 100644
index 9a87a85618..0000000000
--- a/testsuite/tests/lib/Regex/regex002.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-import Text.Regex.Base
-import Text.Regex.Posix((=~),(=~~)) -- or DFA or PCRE or PosixRE
-import qualified Data.ByteString.Char8 as B(ByteString,pack)
-
-main = let b :: Bool
- b = ("abaca" =~ "(.)a")
- c :: [MatchArray]
- c = ("abaca" =~ "(.)a")
- d :: Maybe (String,String,String,[String])
- d = ("abaca" =~~ "(.)a")
- in do print b
- print c
- print d
diff --git a/testsuite/tests/lib/Regex/regex002.stdout b/testsuite/tests/lib/Regex/regex002.stdout
deleted file mode 100644
index 99b5656f91..0000000000
--- a/testsuite/tests/lib/Regex/regex002.stdout
+++ /dev/null
@@ -1,3 +0,0 @@
-True
-[array (0,1) [(0,(1,2)),(1,(1,1))],array (0,1) [(0,(3,2)),(1,(3,1))]]
-Just ("a","ba","ca",["b"])
diff --git a/testsuite/tests/lib/Regex/regex003.hs b/testsuite/tests/lib/Regex/regex003.hs
deleted file mode 100644
index 0aa51fe7aa..0000000000
--- a/testsuite/tests/lib/Regex/regex003.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-import Text.Regex.Base
-import Text.Regex.Posix(Regex,(=~),(=~~)) -- or DFA or PCRE or PosixRE
-import qualified Data.ByteString.Char8 as B(ByteString,pack)
-
--- Show mixing of ByteString and String as well as polymorphism:
-
-main = let x :: (RegexContext Regex String target) => target
- x = ("abaca" =~ B.pack "(.)a")
- x' :: (RegexContext Regex String target,Monad m) => m target
- x' = ("abaca" =~~ "(.)a")
- y :: (RegexContext Regex B.ByteString target) => target
- y = (B.pack "abaca" =~ "(.)a")
- y' :: (RegexContext Regex B.ByteString target,Monad m) => m target
- y' = (B.pack "abaca" =~~ B.pack "(.)a")
- in do print (x :: Bool)
- print (x :: Int)
- print (x :: [MatchArray])
- print (x' :: Maybe (String,String,String,[String]))
- print (y :: Bool)
- print (y :: Int)
- print (y :: [MatchArray])
- print (y' :: Maybe (B.ByteString,B.ByteString,B.ByteString,[B.ByteString]))
-
-{- Output is, except for replacing Full with DFA (which has no capture)
-True
-2
-[array (0,1) [(0,(1,2)),(1,(1,1))],array (0,1) [(0,(3,2)),(1,(3,1))]]
-Just ("a","ba","ca",["b"])
-True
-2
-[array (0,1) [(0,(1,2)),(1,(1,1))],array (0,1) [(0,(3,2)),(1,(3,1))]]
-Just ("a","ba","ca",["b"])
--}
-{- The output for DFA is
-True
-2
-[array (0,0) [(0,(1,2))],array (0,0) [(0,(3,2))]]
-Just ("a","ba","ca",[])
-True
-2
-[array (0,0) [(0,(1,2))],array (0,0) [(0,(3,2))]]
-Just ("a","ba","ca",[])
--}
diff --git a/testsuite/tests/lib/Regex/regex003.stdout b/testsuite/tests/lib/Regex/regex003.stdout
deleted file mode 100644
index 49d7499e91..0000000000
--- a/testsuite/tests/lib/Regex/regex003.stdout
+++ /dev/null
@@ -1,8 +0,0 @@
-True
-2
-[array (0,1) [(0,(1,2)),(1,(1,1))],array (0,1) [(0,(3,2)),(1,(3,1))]]
-Just ("a","ba","ca",["b"])
-True
-2
-[array (0,1) [(0,(1,2)),(1,(1,1))],array (0,1) [(0,(3,2)),(1,(3,1))]]
-Just ("a","ba","ca",["b"])
diff --git a/testsuite/tests/lib/Text.Printf/1548.hs b/testsuite/tests/lib/Text.Printf/1548.hs
deleted file mode 100644
index 68cec0548f..0000000000
--- a/testsuite/tests/lib/Text.Printf/1548.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-import Text.Printf
-
-main = do
- printf "%.*f\n" (2::Int) ((1/3) :: Double)
- -- (expected: "0.33")
-
- printf "%.3s\n" "foobar"
- -- (expected: "foo")
-
- printf "%10.5d\n" (4::Int)
- -- (expected: " 00004")
diff --git a/testsuite/tests/lib/Text.Printf/1548.stdout b/testsuite/tests/lib/Text.Printf/1548.stdout
deleted file mode 100644
index 4976334b4f..0000000000
--- a/testsuite/tests/lib/Text.Printf/1548.stdout
+++ /dev/null
@@ -1,3 +0,0 @@
-0.33
-foo
- 00004
diff --git a/testsuite/tests/lib/Text.Printf/Makefile b/testsuite/tests/lib/Text.Printf/Makefile
deleted file mode 100644
index 9101fbd40a..0000000000
--- a/testsuite/tests/lib/Text.Printf/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/lib/Text.Printf/all.T b/testsuite/tests/lib/Text.Printf/all.T
deleted file mode 100644
index aa26ff2d96..0000000000
--- a/testsuite/tests/lib/Text.Printf/all.T
+++ /dev/null
@@ -1 +0,0 @@
-test('1548', normal, compile_and_run, [''])
diff --git a/testsuite/tests/lib/Time/Makefile b/testsuite/tests/lib/Time/Makefile
deleted file mode 100644
index 9101fbd40a..0000000000
--- a/testsuite/tests/lib/Time/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/lib/Time/T5430.hs b/testsuite/tests/lib/Time/T5430.hs
deleted file mode 100644
index 28353d80e3..0000000000
--- a/testsuite/tests/lib/Time/T5430.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-
-import System.Locale
-import System.Time
-
-main :: IO ()
-main = do let clockTime = TOD 32400 0 -- 00:00:00 on 1 Jan 1970
- calTime <- toCalendarTime clockTime
- -- We check for 001 or 365 (timezone locale will determine which one)
- -- and output 001 for testing output consistently.
- putStrLn $ case (formatCalendarTime defaultTimeLocale "%j" calTime) of
- "001" -> "001" -- good!
- "365" -> "001" -- good!
- n -> n -- error!
-
diff --git a/testsuite/tests/lib/Time/T5430.stdout b/testsuite/tests/lib/Time/T5430.stdout
deleted file mode 100644
index 5325a8dff7..0000000000
--- a/testsuite/tests/lib/Time/T5430.stdout
+++ /dev/null
@@ -1 +0,0 @@
-001
diff --git a/testsuite/tests/lib/Time/all.T b/testsuite/tests/lib/Time/all.T
deleted file mode 100644
index 3b310b416e..0000000000
--- a/testsuite/tests/lib/Time/all.T
+++ /dev/null
@@ -1,4 +0,0 @@
-test('time002', normal, compile_and_run, [''])
-test('time003', normal, compile_and_run, [''])
-test('time004', normal, compile_and_run, [''])
-test('T5430', normal, compile_and_run, [''])
diff --git a/testsuite/tests/lib/Time/time002.hs b/testsuite/tests/lib/Time/time002.hs
deleted file mode 100644
index e2f9bcb7a7..0000000000
--- a/testsuite/tests/lib/Time/time002.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-import System.Time
-
--- !!! check that we can read the current ClockTime, convert it
--- !!! to CalendarTime and back again, and that all three times when
--- !!! converted to strings compare equal.
-
-main = do
- t <- getClockTime
- let clock = show t
- c <- toCalendarTime t
- let cal = calendarTimeToString c
- let t2 = toClockTime c
- clock2 = show t2
- if (clock == cal && clock == clock2)
- then putStrLn "Ok."
- else putStrLn "Failed."
diff --git a/testsuite/tests/lib/Time/time002.stdout b/testsuite/tests/lib/Time/time002.stdout
deleted file mode 100644
index 587579af91..0000000000
--- a/testsuite/tests/lib/Time/time002.stdout
+++ /dev/null
@@ -1 +0,0 @@
-Ok.
diff --git a/testsuite/tests/lib/Time/time003.hs b/testsuite/tests/lib/Time/time003.hs
deleted file mode 100644
index 4dda0e466f..0000000000
--- a/testsuite/tests/lib/Time/time003.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-import System.Time
-
-main :: IO ()
-main = do
- time <- getClockTime
- print (plausible (show time))
- let (CalendarTime year month mday hour min sec psec
- wday yday timezone gmtoff isdst) = toUTCTime time
- time2 = wdays !! fromEnum wday ++
- (' ' : months !! fromEnum month) ++
- (' ' : shows2 mday (' ' : shows2 hour (':' : shows2 min (':' : shows2 sec
- (' ' : timezone ++ ' ' : shows year "\n")))))
- print (plausible time2)
-
- where
- wdays = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
- months = ["Jan", "Feb", "Mar", "Apr", "May", "Jun",
- "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
- shows2 x = showString (pad2 x)
- pad2 x = case show x of
- c@[_] -> '0' : c
- cs -> cs
-
- plausible str = filter (== ':') str == "::" \ No newline at end of file
diff --git a/testsuite/tests/lib/Time/time003.stdout b/testsuite/tests/lib/Time/time003.stdout
deleted file mode 100644
index dbde422651..0000000000
--- a/testsuite/tests/lib/Time/time003.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-True
-True
diff --git a/testsuite/tests/lib/Time/time004.hs b/testsuite/tests/lib/Time/time004.hs
deleted file mode 100644
index 9a281a10da..0000000000
--- a/testsuite/tests/lib/Time/time004.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-import System.Time
-
-main :: IO ()
-main = do
- time <- getClockTime
- let (CalendarTime year month mday hour min sec psec
- wday yday timezone gmtoff isdst) = toUTCTime time
- time' = toClockTime (CalendarTime (year - 1) month mday hour min sec psec
- wday yday timezone gmtoff isdst)
- print (length (show time) == length (show time'))
diff --git a/testsuite/tests/lib/Time/time004.stdout b/testsuite/tests/lib/Time/time004.stdout
deleted file mode 100644
index 0ca95142bb..0000000000
--- a/testsuite/tests/lib/Time/time004.stdout
+++ /dev/null
@@ -1 +0,0 @@
-True
diff --git a/testsuite/tests/lib/exceptions/Makefile b/testsuite/tests/lib/exceptions/Makefile
deleted file mode 100644
index 9101fbd40a..0000000000
--- a/testsuite/tests/lib/exceptions/Makefile
+++ /dev/null
@@ -1,3 +0,0 @@
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/lib/exceptions/all.T b/testsuite/tests/lib/exceptions/all.T
deleted file mode 100644
index 04b3a7fce4..0000000000
--- a/testsuite/tests/lib/exceptions/all.T
+++ /dev/null
@@ -1 +0,0 @@
-test('exceptions001', normal, compile_and_run, [''])
diff --git a/testsuite/tests/lib/exceptions/exceptions001.hs b/testsuite/tests/lib/exceptions/exceptions001.hs
deleted file mode 100644
index f5fcbf0087..0000000000
--- a/testsuite/tests/lib/exceptions/exceptions001.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-
--- trac #2508
-
-import System.Exit
-import Control.OldException
-
-main = exitWith ExitSuccess `finally` return ()
diff --git a/testsuite/tests/lib/libposix/posix003.hs b/testsuite/tests/lib/libposix/posix003.hs
index 12984501ff..b28f9f7dbf 100644
--- a/testsuite/tests/lib/libposix/posix003.hs
+++ b/testsuite/tests/lib/libposix/posix003.hs
@@ -6,7 +6,7 @@ import System.IO
import System.Process
main = do hw <- openFile "po003.out" WriteMode
- ph <- runProcess "pwd" [] (Just "/tmp") Nothing Nothing (Just hw) Nothing
+ ph <- runProcess "pwd" [] (Just "/dev") Nothing Nothing (Just hw) Nothing
ec <- waitForProcess ph
hClose hw
unless (ec == ExitSuccess) $ error "pwd failed"
diff --git a/testsuite/tests/lib/libposix/posix003.stdout b/testsuite/tests/lib/libposix/posix003.stdout
index 0bef00a432..5206ef3c22 100644
--- a/testsuite/tests/lib/libposix/posix003.stdout
+++ b/testsuite/tests/lib/libposix/posix003.stdout
@@ -1 +1 @@
-Got: "/tmp"
+Got: "/dev"
diff --git a/testsuite/tests/lib/should_run/all.T b/testsuite/tests/lib/should_run/all.T
index 4855cefc02..d113d21651 100644
--- a/testsuite/tests/lib/should_run/all.T
+++ b/testsuite/tests/lib/should_run/all.T
@@ -1,4 +1,3 @@
-test('array001', extra_clean(['array001.data']), compile_and_run, [''])
test('char001', normal, compile_and_run, [''])
test('char002', normal, compile_and_run, [''])
diff --git a/testsuite/tests/lib/should_run/array001.hs b/testsuite/tests/lib/should_run/array001.hs
deleted file mode 100644
index b5839b9d53..0000000000
--- a/testsuite/tests/lib/should_run/array001.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- !!! Testing that #4827 is fixed (hPutArray/hGetArray use count argument)
-module Main(main) where
-
-import Control.Monad
-
-import Data.Array.MArray
-import Data.Array.IO
-
-import System.IO
-
-main :: IO ()
-main = do
- the_array <- newListArray (0, 11) [1..12]
-
- -- Write out almost all of the array
- h_out <- openBinaryFile "array001.data" WriteMode
- hPutArray h_out the_array 11
- hClose h_out
-
-
- the_array <- newListArray (0, 11) [0 | i <- [1..12]]
-
- -- Read in almost all of the array
- h_in <- openBinaryFile "array001.data" ReadMode
- wrote_size <- hFileSize h_in
- hGetArray h_in the_array 10
- hClose h_in
-
-
- read_elems <- getElems the_array
-
-
- print wrote_size -- Bytes written, should == 11
- print read_elems -- Bytes read, should match written array in first 10 bytes, be 0 afterwards
diff --git a/testsuite/tests/lib/should_run/array001.stdout b/testsuite/tests/lib/should_run/array001.stdout
deleted file mode 100644
index 7c9b768654..0000000000
--- a/testsuite/tests/lib/should_run/array001.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-11
-[1,2,3,4,5,6,7,8,9,10,0,0]
diff --git a/testsuite/tests/lib/should_run/exceptionsrun001.hs b/testsuite/tests/lib/should_run/exceptionsrun001.hs
index 9c6febc049..c858ba5574 100644
--- a/testsuite/tests/lib/should_run/exceptionsrun001.hs
+++ b/testsuite/tests/lib/should_run/exceptionsrun001.hs
@@ -1,7 +1,8 @@
module Main where
import Prelude hiding (catch)
-import Control.OldException
+import Control.Exception
+import System.IO.Error hiding (catch, try)
main = do
ioTest
@@ -9,48 +10,38 @@ main = do
noMethodTest
patMatchTest
guardTest
- dynTest
ioTest :: IO ()
-ioTest = catchJust userErrors (ioError (userError "wibble"))
- (\ex -> putStr "user exception caught\n")
+ioTest = catchJust (\e -> if isUserError e then Just () else Nothing)
+ (ioError (userError "wibble"))
+ (\() -> putStrLn "user exception caught")
errorTest :: IO ()
-errorTest = try (evaluate (1 + error "call to 'error'")) >>= \r ->
- case r of
- Left exception -> putStr "error call caught\n"
- Right _ -> error "help!"
+errorTest = do r <- try (evaluate (1 + error "call to 'error'"))
+ case r of
+ Left (ErrorCall _) -> putStrLn "error call caught"
+ Right _ -> error "help!"
instance (Show a, Eq a) => Num (Maybe a) where {}
noMethodTest :: IO ()
-noMethodTest = try (evaluate (Just () + Just ())) >>= \ r ->
- case r of
- Left (NoMethodError err) -> putStr "no method error\n"
- Right _ -> error "help!"
+noMethodTest = do r <- try (evaluate (Just () + Just ()))
+ case r of
+ Left (NoMethodError err) -> putStrLn "no method error"
+ Right _ -> error "help!"
patMatchTest :: IO ()
patMatchTest = catch (case test1 [1..10] of () -> return ())
(\ex -> case ex of
- PatternMatchFail err -> putStr err
- other -> error "help!")
-
+ PatternMatchFail err -> putStr err
+ _ -> error "help!")
+
test1 [] = ()
guardTest = catch (case test2 of () -> return ())
- (\ex -> case ex of
- PatternMatchFail err -> putStr err
- other -> error "help!")
+ (\ex -> case ex of
+ PatternMatchFail err -> putStr err
+ _ -> error "help!")
test2 | all (==0) [1] = ()
-dynTest = catchDyn (case throwDyn (42::Int, (+1)::Int->Int) of () -> return ())
- (\(i,f) -> let x = f (i::Int) :: Int in putStr (show x))
-
-{-
-recSelTest
-recConTest
-recUpdTest
-assertTest
-arithTest
--}
diff --git a/testsuite/tests/lib/should_run/exceptionsrun001.stdout b/testsuite/tests/lib/should_run/exceptionsrun001.stdout
index 2d1930f8c9..a84f33ace9 100644
--- a/testsuite/tests/lib/should_run/exceptionsrun001.stdout
+++ b/testsuite/tests/lib/should_run/exceptionsrun001.stdout
@@ -1,6 +1,5 @@
user exception caught
error call caught
no method error
-exceptionsrun001.hs:38:1-13: Non-exhaustive patterns in function test1
-exceptionsrun001.hs:45:1-26: Non-exhaustive patterns in function test2
-43 \ No newline at end of file
+exceptionsrun001.hs:39:1-13: Non-exhaustive patterns in function test1
+exceptionsrun001.hs:46:1-26: Non-exhaustive patterns in function test2
diff --git a/testsuite/tests/lib/should_run/exceptionsrun002.hs b/testsuite/tests/lib/should_run/exceptionsrun002.hs
index 13b642a3ab..9503001a31 100644
--- a/testsuite/tests/lib/should_run/exceptionsrun002.hs
+++ b/testsuite/tests/lib/should_run/exceptionsrun002.hs
@@ -1,105 +1,96 @@
module Main where
- {
- import qualified Control.OldException as Exception;
- import Data.IORef;
- import Prelude;
- safeCatch :: IO () -> IO ();
- safeCatch f = Exception.catch f (\_ -> return ());
+import qualified Control.Exception as Exception
+import System.IO.Error (mkIOError)
+import Data.IORef
+import Prelude
- type Thrower = IO Bool;
+safeCatch :: IO () -> IO ()
+safeCatch f = Exception.catch f
+ ((\_ -> return ()) :: Exception.SomeException -> IO ())
- type Catcher = IO Bool -> IO () -> IO ();
+type Thrower = IO Bool
- checkCatch :: Catcher -> Thrower -> IO Bool;
- checkCatch catcher thrower = do
- {
- ref <- newIORef False;
- safeCatch (catcher thrower (writeIORef ref True));
- readIORef ref;
- };
+type Catcher = IO Bool -> IO () -> IO ()
- data Named a = MkNamed String a;
+checkCatch :: Catcher -> Thrower -> IO Bool
+checkCatch catcher thrower = do
+ ref <- newIORef False
+ safeCatch (catcher thrower (writeIORef ref True))
+ readIORef ref
- checkNamedCatch :: Named Catcher -> Named Thrower -> IO ();
- checkNamedCatch (MkNamed cname catcher) (MkNamed tname thrower) = do
- {
- didCatch <- checkCatch catcher thrower;
- putStrLn (cname ++ (if didCatch then " CAUGHT " else " MISSED ") ++ tname);
- };
+data Named a = MkNamed String a
- checkNamedCatches :: [Named Catcher] -> [Named Thrower] -> IO ();
- checkNamedCatches [] _ = return ();
- checkNamedCatches _ [] = return ();
- checkNamedCatches [c] (t:tr) = do
- {
- checkNamedCatch c t;
- checkNamedCatches [c] tr;
- };
- checkNamedCatches (c:cr) ts = do
- {
- checkNamedCatches [c] ts;
- checkNamedCatches cr ts
- };
+checkNamedCatch :: Named Catcher -> Named Thrower -> IO ()
+checkNamedCatch (MkNamed cname catcher) (MkNamed tname thrower) = do
+ didCatch <- checkCatch catcher thrower
+ putStrLn (cname ++ (if didCatch then " CAUGHT " else " MISSED ") ++ tname)
+checkNamedCatches :: [Named Catcher] -> [Named Thrower] -> IO ()
+checkNamedCatches [] _ = return ()
+checkNamedCatches _ [] = return ()
+checkNamedCatches [c] (t:tr) = do checkNamedCatch c t
+ checkNamedCatches [c] tr
+checkNamedCatches (c:cr) ts = do checkNamedCatches [c] ts
+ checkNamedCatches cr ts
- -- throwers
- returnThrower :: Named Thrower;
- returnThrower = MkNamed "return" (return True);
+-- throwers
- returnUndefinedThrower :: Named Thrower;
- returnUndefinedThrower = MkNamed "return undefined" (return undefined);
+returnThrower :: Named Thrower
+returnThrower = MkNamed "return" (return True)
- returnErrorThrower :: Named Thrower;
- returnErrorThrower = MkNamed "return error" (return (error "some error"));
+returnUndefinedThrower :: Named Thrower
+returnUndefinedThrower = MkNamed "return undefined" (return undefined)
- undefinedThrower :: Named Thrower;
- undefinedThrower = MkNamed "undefined" undefined;
+returnErrorThrower :: Named Thrower
+returnErrorThrower = MkNamed "return error" (return (error "some error"))
- failThrower :: Named Thrower;
- failThrower = MkNamed "fail" (fail "some failure");
+undefinedThrower :: Named Thrower
+undefinedThrower = MkNamed "undefined" undefined
- errorThrower :: Named Thrower;
- errorThrower = MkNamed "error" (error "some error");
+failThrower :: Named Thrower
+failThrower = MkNamed "fail" (fail "some failure")
- throwThrower :: Named Thrower;
- throwThrower = MkNamed "Exception.throw"
- (Exception.throw (Exception.ErrorCall "throw error"));
+errorThrower :: Named Thrower
+errorThrower = MkNamed "error" (error "some error")
- ioErrorErrorCallThrower :: Named Thrower;
- ioErrorErrorCallThrower = MkNamed "ioError ErrorCall"
- (Exception.throwIO (Exception.ErrorCall "throw error"));
+throwThrower :: Named Thrower
+throwThrower = MkNamed "Exception.throw"
+ (Exception.throw (Exception.ErrorCall "throw error"))
- ioErrorIOExceptionThrower :: Named Thrower;
- ioErrorIOExceptionThrower = MkNamed "ioError IOException"
- (Exception.throwIO (Exception.IOException undefined));
+ioErrorErrorCallThrower :: Named Thrower
+ioErrorErrorCallThrower = MkNamed "ioError ErrorCall"
+ (Exception.throwIO (Exception.ErrorCall "throw error"))
- returnThrowThrower :: Named Thrower;
- returnThrowThrower = MkNamed "return Exception.throw"
- (return (Exception.throw (Exception.ErrorCall "throw error")));
+ioErrorIOExceptionThrower :: Named Thrower
+ioErrorIOExceptionThrower = MkNamed "ioError IOException"
+ (Exception.throwIO (mkIOError undefined undefined undefined undefined))
+returnThrowThrower :: Named Thrower
+returnThrowThrower = MkNamed "return Exception.throw"
+ (return (Exception.throw (Exception.ErrorCall "throw error")))
- -- catchers
- bindCatcher :: Named Catcher;
- bindCatcher = MkNamed ">>" (>>);
+-- catchers
- preludeCatchCatcher :: Named Catcher;
- preludeCatchCatcher = MkNamed "Prelude.catch"
- (\f cc -> Prelude.catch (f >> (return ())) (const cc));
+bindCatcher :: Named Catcher
+bindCatcher = MkNamed ">>" (>>)
- ceCatchCatcher :: Named Catcher;
- ceCatchCatcher = MkNamed "Exception.catch"
- (\f cc -> Exception.catch (f >> (return ())) (const cc));
+preludeCatchCatcher :: Named Catcher
+preludeCatchCatcher = MkNamed "Prelude.catch"
+ (\f cc -> Prelude.catch (f >> (return ())) (const cc))
- finallyCatcher :: Named Catcher;
- finallyCatcher = MkNamed "Exception.finally"
- (\f cc -> Exception.finally (f >> (return ())) cc);
+ceCatchCatcher :: Named Catcher
+ceCatchCatcher = MkNamed "Exception.catch"
+ (\f cc -> Exception.catch (f >> (return ())) (const cc :: Exception.SomeException -> IO ()))
- main = checkNamedCatches
- [bindCatcher,preludeCatchCatcher,ceCatchCatcher,finallyCatcher]
- [returnThrower,returnUndefinedThrower,returnThrowThrower,returnErrorThrower,failThrower,
- errorThrower,throwThrower,ioErrorErrorCallThrower,ioErrorIOExceptionThrower,undefinedThrower];
+finallyCatcher :: Named Catcher
+finallyCatcher = MkNamed "Exception.finally"
+ (\f cc -> Exception.finally (f >> (return ())) cc)
+
+main = checkNamedCatches
+ [bindCatcher,preludeCatchCatcher,ceCatchCatcher,finallyCatcher]
+ [returnThrower,returnUndefinedThrower,returnThrowThrower,returnErrorThrower,failThrower,
+ errorThrower,throwThrower,ioErrorErrorCallThrower,ioErrorIOExceptionThrower,undefinedThrower]
- }
diff --git a/testsuite/tests/module/T1074.stderr b/testsuite/tests/module/T1074.stderr
index b368ca119e..53b33604b9 100644
--- a/testsuite/tests/module/T1074.stderr
+++ b/testsuite/tests/module/T1074.stderr
@@ -1,5 +1,5 @@
-T1074.hs:5:1:
- Warning: The import of `Control.Monad.Reader' is redundant
- except perhaps to import instances from `Control.Monad.Reader'
- To import instances alone, use: import Control.Monad.Reader()
+T1074.hs:5:1: Warning:
+ The qualified import of `Control.Monad.Reader' is redundant
+ except perhaps to import instances from `Control.Monad.Reader'
+ To import instances alone, use: import Control.Monad.Reader()
diff --git a/testsuite/tests/module/mod45.stderr b/testsuite/tests/module/mod45.stderr
index 8ead3b58b8..8aadf22b10 100644
--- a/testsuite/tests/module/mod45.stderr
+++ b/testsuite/tests/module/mod45.stderr
@@ -1,6 +1,6 @@
-
-mod45.hs:5:3:
- Illegal type signature in instance declaration:
- (==) :: T -> T -> Bool
- (Use -XInstanceSigs to allow this)
- In the instance declaration for `Eq T'
+
+mod45.hs:5:11:
+ Illegal type signature in instance declaration:
+ (==) :: T -> T -> Bool
+ (Use -XInstanceSigs to allow this)
+ In the instance declaration for `Eq T'
diff --git a/testsuite/tests/numeric/should_run/add2.hs b/testsuite/tests/numeric/should_run/add2.hs
new file mode 100644
index 0000000000..5990f4fa83
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/add2.hs
@@ -0,0 +1,26 @@
+
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Prim
+import GHC.Word
+import Data.Bits
+
+main :: IO ()
+main = do f 5 6
+ f maxBound 23
+ f maxBound maxBound
+
+f :: Word -> Word -> IO ()
+f wx@(W# x) wy@(W# y)
+ = do putStrLn "-----"
+ putStrLn ("Doing " ++ show wx ++ " + " ++ show wy)
+ case x `plusWord2#` y of
+ (# h, l #) ->
+ do let wh = W# h
+ wl = W# l
+ r = shiftL (fromIntegral wh) (bitSize wh)
+ + fromIntegral wl
+ putStrLn ("High: " ++ show wh)
+ putStrLn ("Low: " ++ show wl)
+ putStrLn ("Result: " ++ show (r :: Integer))
+
diff --git a/testsuite/tests/numeric/should_run/add2.stdout b/testsuite/tests/numeric/should_run/add2.stdout
new file mode 100644
index 0000000000..bdeff7290a
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/add2.stdout
@@ -0,0 +1,15 @@
+-----
+Doing 5 + 6
+High: 0
+Low: 11
+Result: 11
+-----
+Doing 18446744073709551615 + 23
+High: 1
+Low: 22
+Result: 18446744073709551638
+-----
+Doing 18446744073709551615 + 18446744073709551615
+High: 1
+Low: 18446744073709551614
+Result: 36893488147419103230
diff --git a/testsuite/tests/numeric/should_run/add2.stdout-ws-32 b/testsuite/tests/numeric/should_run/add2.stdout-ws-32
new file mode 100644
index 0000000000..55d0f6a361
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/add2.stdout-ws-32
@@ -0,0 +1,15 @@
+-----
+Doing 5 + 6
+High: 0
+Low: 11
+Result: 11
+-----
+Doing 4294967295 + 23
+High: 1
+Low: 22
+Result: 4294967318
+-----
+Doing 4294967295 + 4294967295
+High: 1
+Low: 4294967294
+Result: 8589934590
diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T
index af46ec12e0..2cfcae7756 100644
--- a/testsuite/tests/numeric/should_run/all.T
+++ b/testsuite/tests/numeric/should_run/all.T
@@ -53,3 +53,7 @@ test('1603', skip, compile_and_run, [''])
test('3676', expect_broken(3676), compile_and_run, [''])
test('4381', normal, compile_and_run, [''])
test('4383', normal, compile_and_run, [''])
+
+test('add2', normal, compile_and_run, [''])
+test('mul2', normal, compile_and_run, [''])
+
diff --git a/testsuite/tests/numeric/should_run/mul2.hs b/testsuite/tests/numeric/should_run/mul2.hs
new file mode 100644
index 0000000000..82a89d66d0
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/mul2.hs
@@ -0,0 +1,26 @@
+
+{-# LANGUAGE MagicHash, UnboxedTuples #-}
+
+import GHC.Prim
+import GHC.Word
+import Data.Bits
+
+main :: IO ()
+main = do f 5 6
+ f 0xFD94E3B7FE36FB18 49
+ f 0xFD94E3B7FE36FB18 0xFC1D8A3BFB29FC6A
+
+f :: Word -> Word -> IO ()
+f wx@(W# x) wy@(W# y)
+ = do putStrLn "-----"
+ putStrLn ("Doing " ++ show wx ++ " * " ++ show wy)
+ case x `timesWord2#` y of
+ (# h, l #) ->
+ do let wh = W# h
+ wl = W# l
+ r = shiftL (fromIntegral wh) (bitSize wh)
+ + fromIntegral wl
+ putStrLn ("High: " ++ show wh)
+ putStrLn ("Low: " ++ show wl)
+ putStrLn ("Result: " ++ show (r :: Integer))
+
diff --git a/testsuite/tests/numeric/should_run/mul2.stdout b/testsuite/tests/numeric/should_run/mul2.stdout
new file mode 100644
index 0000000000..1a5107c9c7
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/mul2.stdout
@@ -0,0 +1,15 @@
+-----
+Doing 5 * 6
+High: 0
+Low: 30
+Result: 30
+-----
+Doing 18272479967532481304 * 49
+High: 48
+Low: 9907802871033106328
+Result: 895351518409091583896
+-----
+Doing 18272479967532481304 * 18166828462103985258
+High: 17995208684035254268
+Low: 13422369508946319344
+Result: 331953009147393985806713771139776616432
diff --git a/testsuite/tests/numeric/should_run/mul2.stdout-ws-32 b/testsuite/tests/numeric/should_run/mul2.stdout-ws-32
new file mode 100644
index 0000000000..78b06d5c1b
--- /dev/null
+++ b/testsuite/tests/numeric/should_run/mul2.stdout-ws-32
@@ -0,0 +1,15 @@
+-----
+Doing 5 * 6
+High: 0
+Low: 30
+Result: 30
+-----
+Doing 4265016088 * 49
+High: 48
+Low: 2827358104
+Result: 208985788312
+-----
+Doing 4265016088 * 4213832810
+High: 4184447398
+Low: 549951472
+Result: 17972064726792247280
diff --git a/testsuite/tests/parser/should_fail/readFail036.stderr b/testsuite/tests/parser/should_fail/readFail036.stderr
index 8c89f29e34..088f0a9975 100644
--- a/testsuite/tests/parser/should_fail/readFail036.stderr
+++ b/testsuite/tests/parser/should_fail/readFail036.stderr
@@ -1,4 +1,5 @@
-readFail036.hs:4:1:
- Illegal kind signature for `a'
+readFail036.hs:4:16:
+ Illegal kind signature: `*'
Perhaps you intended to use -XKindSignatures
+ In the data type declaration for `Foo'
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 731258a94b..ed729ad26d 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1,3 +1,10 @@
+def no_core_lint(opts):
+ opts.compiler_always_flags = \
+ filter(lambda opt: opt != '-dcore-lint', opts.compiler_always_flags)
+
+setTestOpts(no_core_lint)
+
+
test('T1969',
[if_wordsize(32,
compiler_stats_num_field('peak_megabytes_allocated', 13,
@@ -17,9 +24,8 @@ test('T1969',
# 5717704 (x86/Windows 17/05/10)
# 6149572 (x86/Linux, 31/12/09)
if_wordsize(64,
- compiler_stats_num_field('max_bytes_used', 9000000,
- 13000000)),
- # expected value: 11404664 (amd64/Linux)
+ compiler_stats_range_field('max_bytes_used', 12000000, 10)),
+ # expected value: 11178376 (amd64/Linux)
if_wordsize(32,
compiler_stats_num_field('bytes allocated', 210000000,
270000000)),
@@ -32,7 +38,10 @@ test('T1969',
# 08/12/2009: 459,776,680 (amd64/Linux)
# 17/05/2010: 519,377,728 (amd64/Linux)
# 05/08/2011: 561,382,568 (amd64/OS X)
- only_ways(['normal'])
+ only_ways(['normal']),
+ extra_hc_opts('-dcore-lint')
+ # Leave -dcore-lint on for this one test, so that we have something
+ # that will catch a regression in -dcore-lint performance.
],
compile,
[''])
@@ -80,22 +89,17 @@ test('T4801',
[ # expect_broken(5224),
# temporarily unbroken (#5227)
if_wordsize(32,
- # expected value x86/OSX: 27
- compiler_stats_num_field('peak_megabytes_allocated', 25, 29)),
- # expected value: 48-54 (amd64/Linux):
- if_wordsize(64,
- compiler_stats_num_field('peak_megabytes_allocated', 47, 54)),
+ compiler_stats_range_field('peak_megabytes_allocated', 30, 10)),
+ if_wordsize(64, # sample from (amd64/Linux):
+ compiler_stats_range_field('peak_megabytes_allocated', 47, 10)),
# expected value: 58 (amd64/OS X):
if_platform('x86_64-apple-darwin',
compiler_stats_num_field('peak_megabytes_allocated', 56, 60)),
# expected value: 228286660 (x86/OS X)
if_wordsize(32,
- compiler_stats_num_field('bytes allocated', 200000000,
- 240000000)),
- # expected value: 458700632 (amd64/Linux):
- if_wordsize(64,
- compiler_stats_num_field('bytes allocated', 440000000,
- 480000000)),
+ compiler_stats_range_field('bytes allocated', 185669232, 10)),
+ if_wordsize(64, # (amd64/Linux):
+ compiler_stats_range_field('bytes allocated', 360243576, 10)),
# expected value: 510938976 (amd64/OS X):
if_platform('x86_64-apple-darwin',
compiler_stats_num_field('bytes allocated', 490000000,
@@ -128,12 +132,11 @@ test('T3064',
compiler_stats_num_field('peak_megabytes_allocated', 9, 16)),
# expected value: 56380288 (x86/Linux) (28/6/2011)
if_wordsize(32,
- compiler_stats_num_field('bytes allocated', 50000000,
- 70000000)),
- # expected value: 108937496 (amd64/Linux) (28/6/2011):
+ compiler_stats_range_field('bytes allocated', 39800820, 10)),
+ # expected value: 73259544 (amd64/Linux) (28/6/2011):
if_wordsize(64,
- compiler_stats_num_field('bytes allocated', 110000000,
- 140000000)),
+ compiler_stats_num_field('bytes allocated', 60000000,
+ 80000000)),
# expected value: 2247016 (x86/Linux) (28/6/2011):
if_wordsize(32,
compiler_stats_num_field('max_bytes_used', 2000000,
@@ -155,26 +158,23 @@ test('T4007',
test('T5030',
[# expected value: 449368924 (x86/Linux)
if_wordsize(32,
- compiler_stats_num_field('bytes allocated', 400000000,
- 500000000)),
- # expected value: 902776064 (amd64/Linux):
+ compiler_stats_range_field('bytes allocated', 176193448, 10)),
+ # expected value: 346750856 (amd64/Linux):
if_wordsize(64,
- compiler_stats_num_field('bytes allocated', 800000000,
- 1000000000)),
+ compiler_stats_num_field('bytes allocated', 300000000,
+ 400000000)),
only_ways(['normal'])
],
compile,
['-fcontext-stack=300'])
test('T5631',
- [# expected value: 629864032 (x86/Darwin)
- if_wordsize(32,
- compiler_stats_num_field('bytes allocated', 1000000000,
- 1200000000)),
- # expected value: 1255998208 (amd64/Linux):
+ [if_wordsize(32, # sample from x86/Linux
+ compiler_stats_range_field('bytes allocated', 392904228, 10)),
+ # expected value: 774,595,008 (amd64/Linux):
if_wordsize(64,
- compiler_stats_num_field('bytes allocated', 2000000000,
- 2400000000)),
+ compiler_stats_num_field('bytes allocated', 600000000,
+ 900000000)),
only_ways(['normal'])
],
compile,
@@ -200,47 +200,41 @@ test('T783',
if_wordsize(32,
compiler_stats_num_field('bytes allocated', 125000000,
225000000)),
- # expected value: 390895576 (amd64/Linux):
+ # sample: 349263216 (amd64/Linux)
if_wordsize(64,
- compiler_stats_num_field('bytes allocated', 350000000,
- 450000000))
+ compiler_stats_range_field('bytes allocated', 349263216, 10))
],
compile,[''])
test('T5321Fun',
[ only_ways(['normal']), # no optimisation for this one
- # expected value: 175,569,928 (x86/Linux)
+ # sample from x86/Linux
if_wordsize(32,
- compiler_stats_num_field('bytes allocated', 1000000000,
- 1100000000)),
- # expected value: 390895576 (amd64/Linux):
+ compiler_stats_range_field('bytes allocated', 341591280, 10)),
+ # expected value: 669165280 (amd64/Linux):
if_wordsize(64,
- compiler_stats_num_field('bytes allocated', 2000000000,
- 2200000000))
+ compiler_stats_range_field('bytes allocated', 669165280, 10))
],
compile,[''])
test('T5321FD',
[ only_ways(['normal']), # no optimisation for this one
- # expected value: 175,569,928 (x86/Linux)
+ # sample from x86/Linux
if_wordsize(32,
- compiler_stats_num_field('bytes allocated', 500000000,
- 600000000)),
- # expected value: 390895576 (amd64/Linux):
+ compiler_stats_range_field('bytes allocated', 257175456, 10)),
+ # expected value: 500642456 (amd64/Linux):
if_wordsize(64,
- compiler_stats_num_field('bytes allocated', 1000000000,
- 1200000000))
+ compiler_stats_range_field('bytes allocated', 500642456, 10))
],
compile,[''])
test('T5642',
[ only_ways(['normal']),
- if_wordsize(32,
- compiler_stats_num_field('bytes allocated', 890000000,
- 910000000)),
+ if_wordsize(32, # sample from x86/Linux
+ compiler_stats_range_field('bytes allocated', 1893427932, 10)),
+
+ # sample: 3926235424 (amd64/Linux, 15/2/2012)
if_wordsize(64,
- # expected value: 9019430056 (amd64/Linux):
- compiler_stats_num_field('bytes allocated', 8900000000,
- 9100000000))
+ compiler_stats_range_field('bytes allocated', 3926235424, 10))
],
compile,['-O'])
diff --git a/testsuite/tests/polykinds/Freeman.hs b/testsuite/tests/polykinds/Freeman.hs
new file mode 100644
index 0000000000..ea8aff0f8a
--- /dev/null
+++ b/testsuite/tests/polykinds/Freeman.hs
@@ -0,0 +1,259 @@
+-- From the blog post Fun With XPolyKinds : Polykinded Folds
+-- http://www.typesandotherdistractions.com/2012/02/fun-with-xpolykinds-polykinded-folds.html
+
+{-
+In the following, I will write a polykinded version of the combinators
+fold and unfold, along with three examples: folds for regular
+datatypes (specialized to kind *), folds for nested datatypes
+(specialized to kind * -> *), and folds for mutually recursive data
+types (specialized to the product kind (*,*)). The approach should
+generalise easily enough to things such as types indexed by another
+kind (e.g. by specializing to kind Nat -> *, using the XDataKinds
+extension), or higher order nested datatypes (e.g. by specializing to
+kind (* -> *) -> (* -> *)).
+
+The following will compile in the new GHC 7.4.1 release. We require
+the following GHC extensions:
+-}
+
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module Main where
+
+{- The basic fold and unfold combinators can be written as follows:
+
+fold phi = phi . fmap (fold phi) . out
+unfold psi = in . fmap (unfold psi) . psi
+
+The idea now is to generalize these combinators by working over
+different categories. We can capture the basic operations in a
+category with a typeclass: -}
+
+class Category hom where
+ ident :: hom a a
+ compose :: hom a b -> hom b c -> hom a c
+
+{- A category has two operations: an identity morphism for every
+object, and for every two compatible morphisms, the composition of
+those morphisms.
+
+In earlier versions of GHC, the type hom would have been specialized
+to kind * -> * -> *, but with the new PolyKinds extension, hom is
+polykinded, and the Category typeclass can be instantiated to k -> k
+-> * for any kind k. This means that in addition to all of the
+Category instances that we could have written before, we can now write
+instances of Category for type constructors, type constructor
+constructors, etc.
+
+Here is the instance for the category Hask of Haskell types. Objects
+are Haskell types and morphisms are functions between types. The
+identity is the regular polymorphic identity function id, and
+composition is given by the (flipped) composition operator (.) -}
+
+instance Category (->) where
+ ident = id
+ compose = flip (.)
+
+{- Another example is the category of type constructors and natural
+transformations. A natural transformation is defined as follows: -}
+
+newtype Nat f g = Nat { nu :: (forall a. f a -> g a) }
+
+{- Here is the Category instance for natural transformations. This
+time the type hom is inferred to have kind (* -> *) -> (* -> *) ->
+*. Identity and composition are both defined pointwise. -}
+
+instance Category (Nat :: (* -> *) -> (* -> *) -> *) where
+ ident = Nat id
+ compose f g = Nat (nu g . nu f)
+
+{- Let's define a type class which will capture the idea of a fixed point
+in a category. This generalizes the idea of recursive types in Hask: -}
+
+class Rec hom f t where
+ _in :: hom (f t) t
+ out :: hom t (f t)
+
+{- The class Rec defines two morphisms: _in, which is the constructor of
+the fixed point type t, and out, its destructor.
+
+The final piece is the definition of a higher order functor, which
+generalizes the typeclass Functor: -}
+
+class HFunctor hom f where
+ hmap :: hom a b -> hom (f a) (f b)
+
+{- Note the similarity with the type signature of the function fmap ::
+(Functor f) => (a -> b) -> f a -> f b. Indeed, specializing hom to
+(->) in the definition of HFunctor gives back the type signature of
+fmap.
+
+Finally, we can define folds and unfolds in a category. The
+definitions are as before, but with explicit composition, constructors
+and destructors replaced with the equivalent type class methods, and
+hmap in place of fmap: -}
+
+fold :: (Category hom, HFunctor hom f, Rec hom f rec) => hom (f t) t -> hom rec t
+fold phi = compose out (compose (hmap (fold phi)) phi)
+
+unfold :: (Category hom, HFunctor hom f, Rec hom f rec) => hom t (f t) -> hom t rec
+unfold phi = compose phi (compose (hmap (unfold phi)) _in)
+
+-- Now for some examples.
+
+-- The first example is a regular recursive datatype of binary leaf
+-- trees. The functor FTree is the base functor of this recursive type:
+
+data FTree a b = FLeaf a | FBranch b b
+data Tree a = Leaf a | Branch (Tree a) (Tree a)
+
+-- An instance of Rec shows the relationship between the defining functor
+-- and the recursive type itself:
+
+instance Rec (->) (FTree a) (Tree a) where
+ _in (FLeaf a) = Leaf a
+ _in (FBranch a b) = Branch a b
+ out (Leaf a) = FLeaf a
+ out (Branch a b) = FBranch a b
+
+-- FTree is indeed a functor, so it is also a HFunctor:
+
+instance HFunctor (->) (FTree a) where
+ hmap f (FLeaf a) = FLeaf a
+ hmap f (FBranch a b) = FBranch (f a) (f b)
+
+-- These instances are enough to define folds and unfolds for this
+-- type. The following fold calculates the depth of a tree:
+
+depth :: Tree a -> Int
+depth = (fold :: (FTree a Int -> Int) -> Tree a -> Int) phi where
+ phi :: FTree a Int -> Int
+ phi (FLeaf a) = 1
+ phi (FBranch a b) = 1 + max a b
+
+-- The second example is a fold for the nested (or non-regular)
+-- datatype of complete binary leaf trees. The higher order functor
+-- FCTree defines the type constructor CTree as its fixed point:
+
+data FCTree f a = FCLeaf a | FCBranch (f (a, a))
+ -- FCTree :: (* -> *) -> * -> *
+
+data CTree a = CLeaf a | CBranch (CTree (a, a))
+
+-- Again, we define type class instances for HFunctor and Rec:
+
+instance HFunctor Nat FCTree where
+ hmap (f :: Nat (f :: * -> *) (g :: * -> *)) = Nat ff where
+ ff :: forall a. FCTree f a -> FCTree g a
+ ff (FCLeaf a) = FCLeaf a
+ ff (FCBranch a) = FCBranch (nu f a)
+
+instance Rec Nat FCTree CTree where
+ _in = Nat inComplete where
+ inComplete (FCLeaf a) = CLeaf a
+ inComplete (FCBranch a) = CBranch a
+ out = Nat outComplete where
+ outComplete(CLeaf a) = FCLeaf a
+ outComplete(CBranch a) = FCBranch a
+
+-- Morphisms between type constructors are natural transformations, so we
+-- need a type constructor to act as the target of the fold. For our
+-- purposes, a constant functor will do:
+
+data K a b = K a -- K :: forall k. * -> k -> *
+
+
+-- And finally, the following fold calculates the depth of a complete binary leaf tree:
+
+cdepth :: CTree a -> Int
+cdepth c = let (K d) = nu (fold (Nat phi)) c in d where
+ phi :: FCTree (K Int) a -> K Int a
+ phi (FCLeaf a) = K 1
+ phi (FCBranch (K n)) = K (n + 1)
+
+{- The final example is a fold for the pair of mutually recursive
+datatype of lists of even and odd lengths. The fold will take a list
+of even length and produce a list of pairs.
+
+We cannot express type constructors in Haskell whose return kind is
+anything other than *, so we cheat a little and emulate the product
+kind using an arrow kind Choice -> *, where Choice is a two point
+kind, lifted using the XDataKinds extension: -}
+
+data Choice = Fst | Snd
+
+-- A morphism of pairs of types is just a pair of morphisms. For
+-- technical reasons, we represent this using a Church-style encoding,
+-- along with helper methods, as follows:
+
+newtype PHom h1 h2 p1 p2 = PHom { runPHom :: forall r. (h1 (p1 Fst) (p2 Fst) -> h2 (p1 Snd) (p2 Snd) -> r) -> r }
+
+mkPHom f g = PHom (\h -> h f g)
+fstPHom p = runPHom p (\f -> \g -> f)
+sndPHom p = runPHom p (\f -> \g -> g)
+
+-- Now, PHom allows us to take two categories and form the product category:
+
+instance (Category h1, Category h2) => Category (PHom h1 h2) where
+ ident = mkPHom ident ident
+ compose p1 p2 = mkPHom (compose (fstPHom p1) (fstPHom p2)) (compose (sndPHom p1) (sndPHom p2))
+
+-- We can define the types of lists of even and odd length as
+-- follows. Note that the kind annotation indicates the appearance of the
+-- kind Choice -> *:
+
+data FAlt :: * -> (Choice -> *) -> Choice -> * where
+ FZero :: FAlt a p Fst
+ FSucc1 :: a -> (p Snd) -> FAlt a p Fst
+ FSucc2 :: a -> (p Fst) -> FAlt a p Snd
+
+data Alt :: * -> Choice -> * where
+ Zero :: Alt a Fst
+ Succ1 :: a -> Alt a Snd -> Alt a Fst
+ Succ2 :: a -> Alt a Fst -> Alt a Snd
+
+deriving instance Show a => Show (Alt a b)
+
+-- Again, we need to define instances of Rec and HFunctor:
+
+instance Rec (PHom (->) (->)) (FAlt a) (Alt a) where
+ _in = mkPHom f g where
+ f FZero = Zero
+ f (FSucc1 a b) = Succ1 a b
+ g (FSucc2 a b) = Succ2 a b
+ out = mkPHom f g where
+ f Zero = FZero
+ f (Succ1 a b) = FSucc1 a b
+ g (Succ2 a b) = FSucc2 a b
+
+instance HFunctor (PHom (->) (->)) (FAlt a) where
+ hmap p = mkPHom hf hg where
+ hf FZero = FZero
+ hf (FSucc1 a x) = FSucc1 a (sndPHom p x)
+ hg (FSucc2 a x) = FSucc2 a (fstPHom p x)
+
+-- As before, we create a target type for our fold, and this time a type synonym as well:
+
+data K2 :: * -> * -> Choice -> * where
+ K21 :: a -> K2 a b Fst
+ K22 :: b -> K2 a b Snd
+
+type PairUpResult a = K2 [(a, a)] (a, [(a, a)])
+
+-- At last, here is the fold pairUp, taking even length lists to lists of pairs:
+
+pairUp :: Alt a Fst -> [(a, a)]
+pairUp xs = let (K21 xss) = (fstPHom (fold (mkPHom phi psi))) xs in xss
+ where
+ phi FZero = K21 []
+ phi (FSucc1 x1 (K22 (x2, xss))) = K21 ((x1, x2):xss)
+ psi (FSucc2 x (K21 xss)) = K22 (x, xss)
+
+main = print (Succ1 (0::Int) $ Succ2 1 $ Succ1 2 $ Succ2 3 $ Succ1 4 $ Succ2 5 Zero)
diff --git a/testsuite/tests/polykinds/Freeman.stdout b/testsuite/tests/polykinds/Freeman.stdout
new file mode 100644
index 0000000000..691a9d3e9b
--- /dev/null
+++ b/testsuite/tests/polykinds/Freeman.stdout
@@ -0,0 +1 @@
+Succ1 0 (Succ2 1 (Succ1 2 (Succ2 3 (Succ1 4 (Succ2 5 Zero)))))
diff --git a/testsuite/tests/polykinds/MonoidsFD.hs b/testsuite/tests/polykinds/MonoidsFD.hs
new file mode 100644
index 0000000000..8bfb1637c1
--- /dev/null
+++ b/testsuite/tests/polykinds/MonoidsFD.hs
@@ -0,0 +1,106 @@
+-- From a blog post: http://www.jonmsterling.com/posts/2012-01-12-unifying-monoids-and-monads-with-polymorphic-kinds.html
+
+-------------------- FUNCTIONAL DEPENDENCY VERSION ----------------
+
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE UnicodeSyntax #-}
+
+module Main where
+import Control.Monad (Monad(..), join)
+import Data.Monoid (Monoid(..))
+
+-- First we define the type class Monoidy:
+
+class Monoidy (~>) comp id m | m (~>) → comp id where
+ munit :: id ~> m
+ mjoin :: m `comp` m ~> m
+
+-- We use functional dependencies to help the typechecker understand that
+-- m and ~> uniquely determine comp (times) and id.
+--
+-- This kind of type class would not have been possible in previous
+-- versions of GHC; with the new kind system, however, we can abstract
+-- over kinds!2 Now, let’s create types for the additive and
+-- multiplicative monoids over the natural numbers:
+
+newtype Sum a = Sum a deriving Show
+newtype Product a = Product a deriving Show
+instance Num a ⇒ Monoidy (→) (,) () (Sum a) where
+ munit _ = Sum 0
+ mjoin (Sum x, Sum y) = Sum $ x + y
+instance Num a ⇒ Monoidy (→) (,) () (Product a) where
+ munit _ = Product 1
+ mjoin (Product x, Product y) = Product $ x * y
+
+-- It will be slightly more complicated to make a monadic instance with
+-- Monoidy. First, we need to define the identity functor, a type for
+-- natural transformations, and a type for functor composition:
+
+data Id α = Id { runId :: α } deriving Functor
+
+-- A natural transformation (Λ f g α. (f α) → (g α)) may be encoded in Haskell as follows:
+
+data NT f g = NT { runNT :: ∀ α. f α → g α }
+
+-- Functor composition (Λ f g α. f (g α)) is encoded as follows:
+
+data FC f g α = FC { runFC :: f (g α) }
+
+-- Now, let us define some type T which should be a monad:
+
+data Wrapper a = Wrapper { runWrapper :: a } deriving (Show, Functor)
+instance Monoidy NT FC Id Wrapper where
+ munit = NT $ Wrapper . runId
+ mjoin = NT $ runWrapper . runFC
+
+-- With these defined, we can use them as follows:
+
+test1 = do { print (mjoin (munit (), Sum 2))
+ -- Sum 2
+ ; print (mjoin (Product 2, Product 3))
+ -- Product 6
+ ; print (runNT mjoin $ FC $ Wrapper (Wrapper "hello, world"))
+ -- Wrapper {runWrapper = "hello, world" }
+ }
+
+-- We can even provide a special binary operator for the appropriate monoids as follows:
+
+(<+>) :: Monoidy (→) (,) () m ⇒ m → m → m
+(<+>) = curry mjoin
+
+test2 = print (Sum 1 <+> Sum 2 <+> Sum 4) -- Sum 7
+
+-- Now, all the extra wrapping that Haskell requires for encoding this is
+-- rather cumbersome in actual use. So, we can give traditional Monad and
+-- Monoid instances for instances of Monoidy:
+
+instance Monoidy (→) (,) () m ⇒ Monoid m where
+ mempty = munit ()
+ mappend = curry mjoin
+
+-- instance (Functor m, Monoidy NT FC Id m) ⇒ Monad m where
+instance Monad Wrapper where
+ return x = runNT munit $ Id x
+ x >>= f = runNT mjoin $ FC (f `fmap` x)
+
+-- And so the following works:
+
+test3
+ = do { print (mappend mempty (Sum 2))
+ -- Sum 2
+ ; print (mappend (Product 2) (Product 3))
+ -- Product 6
+ ; print (join $ Wrapper $ Wrapper "hello")
+ -- Wrapper {runWrapper = "hello" }
+ ; print (Wrapper "hello, world" >>= return)
+ -- Wrapper {runWrapper = "hello, world" }
+ }
+
+main = test1 >> test2 >> test3
diff --git a/testsuite/tests/polykinds/MonoidsFD.stdout b/testsuite/tests/polykinds/MonoidsFD.stdout
new file mode 100644
index 0000000000..8d96f6d428
--- /dev/null
+++ b/testsuite/tests/polykinds/MonoidsFD.stdout
@@ -0,0 +1,8 @@
+Sum 2
+Product 6
+Wrapper {runWrapper = "hello, world"}
+Sum 7
+Sum 2
+Product 6
+Wrapper {runWrapper = "hello"}
+Wrapper {runWrapper = "hello, world"}
diff --git a/testsuite/tests/polykinds/MonoidsTF.hs b/testsuite/tests/polykinds/MonoidsTF.hs
new file mode 100644
index 0000000000..f0dc2be536
--- /dev/null
+++ b/testsuite/tests/polykinds/MonoidsTF.hs
@@ -0,0 +1,116 @@
+-- From a blog post: http://www.jonmsterling.com/posts/2012-01-12-unifying-monoids-and-monads-with-polymorphic-kinds.html
+
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE UnicodeSyntax #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Main where
+import Control.Monad (Monad(..), join)
+import Data.Monoid (Monoid(..))
+
+-- First we define the type class Monoidy:
+
+class Monoidy ((~>) :: k0 -> k1 -> *) (m :: k1) where
+ type MComp (~>) m :: k1 -> k1 -> k0
+ type MId (~>) m :: k0
+ munit :: MId (~>) m ~> m
+ mjoin :: MComp (~>) m m m ~> m
+
+-- We use functional dependencies to help the typechecker understand that
+-- m and ~> uniquely determine comp (times) and id.
+
+-- This kind of type class would not have been possible in previous
+-- versions of GHC; with the new kind system, however, we can abstract
+-- over kinds!2 Now, let’s create types for the additive and
+-- multiplicative monoids over the natural numbers:
+
+newtype Sum a = Sum a deriving Show
+newtype Product a = Product a deriving Show
+instance Num a ⇒ Monoidy (→) (Sum a) where
+ type MComp (→) (Sum a) = (,)
+ type MId (→) (Sum a) = ()
+ munit _ = Sum 0
+ mjoin (Sum x, Sum y) = Sum $ x + y
+
+instance Num a ⇒ Monoidy (→) (Product a) where
+ type MComp (→) (Product a) = (,)
+ type MId (→) (Product a) = ()
+ munit _ = Product 1
+ mjoin (Product x, Product y) = Product $ x * y
+
+-- It will be slightly more complicated to make a monadic instance with
+-- Monoidy. First, we need to define the identity functor, a type for
+-- natural transformations, and a type for functor composition:
+
+data Id α = Id { runId :: α } deriving Functor
+
+-- A natural transformation (Λ f g α. (f α) → (g α)) may be encoded in Haskell as follows:
+
+data NT f g = NT { runNT :: ∀ α. f α → g α }
+
+-- Functor composition (Λ f g α. f (g α)) is encoded as follows:
+
+data FC f g α = FC { runFC :: f (g α) }
+
+-- Now, let us define some type T which should be a monad:
+
+data Wrapper a = Wrapper { runWrapper :: a } deriving (Show, Functor)
+instance Monoidy NT Wrapper where
+ type MComp NT Wrapper = FC
+ type MId NT Wrapper = Id
+ munit = NT $ Wrapper . runId
+ mjoin = NT $ runWrapper . runFC
+
+
+-- With these defined, we can use them as follows:
+
+test1 = do { print (mjoin (munit (), Sum 2))
+ -- Sum 2
+ ; print (mjoin (Product 2, Product 3))
+ -- Product 6
+ ; print (runNT mjoin $ FC $ Wrapper (Wrapper "hello, world"))
+ -- Wrapper {runWrapper = "hello, world" }
+ }
+
+-- We can even provide a special binary operator for the appropriate monoids as follows:
+
+(<+>) :: (Monoidy (→) m, MId (→) m ~ (), MComp (→) m ~ (,))
+ ⇒ m → m → m
+(<+>) = curry mjoin
+
+test2 = print (Sum 1 <+> Sum 2 <+> Sum 4) -- Sum 7
+
+-- Now, all the extra wrapping that Haskell requires for encoding this is
+-- rather cumbersome in actual use. So, we can give traditional Monad and
+-- Monoid instances for instances of Monoidy:
+
+instance (MId (→) m ~ (), MComp (→) m ~ (,), Monoidy (→) m)
+ ⇒ Monoid m where
+ mempty = munit ()
+ mappend = curry mjoin
+
+instance Monad Wrapper where
+ return x = runNT munit $ Id x
+ x >>= f = runNT mjoin $ FC (f `fmap` x)
+
+-- And so the following works:
+
+test3
+ = do { print (mappend mempty (Sum 2))
+ -- Sum 2
+ ; print (mappend (Product 2) (Product 3))
+ -- Product 6
+ ; print (join $ Wrapper $ Wrapper "hello")
+ -- Wrapper {runWrapper = "hello" }
+ ; print (Wrapper "hello, world" >>= return)
+ -- Wrapper {runWrapper = "hello, world" }
+ }
+
+main = test1 >> test2 >> test3
diff --git a/testsuite/tests/polykinds/MonoidsTF.stdout b/testsuite/tests/polykinds/MonoidsTF.stdout
new file mode 100644
index 0000000000..8d96f6d428
--- /dev/null
+++ b/testsuite/tests/polykinds/MonoidsTF.stdout
@@ -0,0 +1,8 @@
+Sum 2
+Product 6
+Wrapper {runWrapper = "hello, world"}
+Sum 7
+Sum 2
+Product 6
+Wrapper {runWrapper = "hello"}
+Wrapper {runWrapper = "hello, world"}
diff --git a/testsuite/tests/polykinds/PolyKinds02.stderr b/testsuite/tests/polykinds/PolyKinds02.stderr
index 3c61552662..2ee85b5e2b 100644
--- a/testsuite/tests/polykinds/PolyKinds02.stderr
+++ b/testsuite/tests/polykinds/PolyKinds02.stderr
@@ -1,6 +1,6 @@
PolyKinds02.hs:13:16:
Kind mis-match
- The second argument of `Vec' should have kind `Nat',
+ The second argument of `Vec' should have kind 'Nat,
but `Nat' has kind `*'
In the type signature for `vec': vec :: Vec Nat Nat
diff --git a/testsuite/tests/polykinds/PolyKinds06.stderr b/testsuite/tests/polykinds/PolyKinds06.stderr
index 151e636cb1..b2de4bc596 100644
--- a/testsuite/tests/polykinds/PolyKinds06.stderr
+++ b/testsuite/tests/polykinds/PolyKinds06.stderr
@@ -1,4 +1,6 @@
-PolyKinds06.hs:9:11:
- Promoted kind `A' used in a mutually recursive group
- In the kind `A -> *'
+PolyKinds06.hs:10:11:
+ Promoted kind `A1' used in a mutually recursive group
+ In the type `B A1'
+ In the definition of data constructor `B1'
+ In the data type declaration for `B'
diff --git a/testsuite/tests/polykinds/PolyKinds07.stderr b/testsuite/tests/polykinds/PolyKinds07.stderr
index 77fd295fa3..2063af0645 100644
--- a/testsuite/tests/polykinds/PolyKinds07.stderr
+++ b/testsuite/tests/polykinds/PolyKinds07.stderr
@@ -1,6 +1,6 @@
PolyKinds07.hs:10:11:
- Opaque thing `A1' used as a type
+ Promoted kind `A1' used in a mutually recursive group
In the type `B A1'
In the definition of data constructor `B1'
In the data type declaration for `B'
diff --git a/testsuite/tests/polykinds/PolyKinds12.hs b/testsuite/tests/polykinds/PolyKinds12.hs
index 4d18551cb9..4c1cc4df5c 100644
--- a/testsuite/tests/polykinds/PolyKinds12.hs
+++ b/testsuite/tests/polykinds/PolyKinds12.hs
@@ -2,14 +2,10 @@
module PolyKinds12 where
-type family If1 b t f
+type family If1 (b::Bool) (t::k) (f::k) :: k
type instance If1 True t f = t
type instance If1 False t f = f
-type family If2 (b :: Bool) t f
-type instance If2 True t f = t
-type instance If2 False t f = f
-
data SBool b where
STrue :: SBool True
SFalse :: SBool False
@@ -18,15 +14,13 @@ test1 :: SBool b -> If1 b Int Char
test1 STrue = 42
test1 SFalse = 'H'
-test2 :: SBool b -> If2 b Int Char
+test2 :: SBool b -> If1 b Int Char
test2 STrue = 42
test2 SFalse = 'H'
type family Apply f x
type instance Apply f x = f x
--- Does not work because we do not abstract the return kind of type families
--- Currently If1 returns kind *, which is too restrictive
higher1v1 :: SBool b -> (If1 b Maybe []) Char
higher1v1 STrue = Just 'H'
higher1v1 SFalse = "Hello"
@@ -35,6 +29,6 @@ higher1v2 :: SBool b -> Apply (If1 b Maybe []) Char
higher1v2 STrue = Just 'H'
higher1v2 SFalse = "Hello"
--- higher2 :: SBool b -> (If2 b Maybe []) Int
--- higher2 STrue = Just 42
--- higher2 SFalse = "Hello"
+higher2 :: SBool b -> If1 b Maybe [] Int
+higher2 STrue = Just 42
+higher2 SFalse = [45]
diff --git a/testsuite/tests/polykinds/PolyKinds13.hs b/testsuite/tests/polykinds/PolyKinds13.hs
index 315c62a998..a754683324 100644
--- a/testsuite/tests/polykinds/PolyKinds13.hs
+++ b/testsuite/tests/polykinds/PolyKinds13.hs
@@ -16,11 +16,14 @@ instance Functor Proxy where
data TypeRep = TypeRep
class MyTypeable t where
+-- MyTypeable :: forall k. k -> Constraint
myTypeOf :: Proxy t -> TypeRep
myTypeOf _ = TypeRep
data Apply f t = Apply (f t)
+-- Apply :: forall k. (k -> *) -> k -> *
instance MyTypeable Apply
+-- df :: forall k. MyTypeable ((k -> *) -> k -> *) (Apply k)
instance MyTypeable Int
instance MyTypeable Maybe
diff --git a/testsuite/tests/polykinds/T5717.hs b/testsuite/tests/polykinds/T5717.hs
new file mode 100644
index 0000000000..5dd7ac4b58
--- /dev/null
+++ b/testsuite/tests/polykinds/T5717.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE PolyKinds #-}
+
+module T5717 where
+
+
+data TypeRep = TypeRep
+
+data Proxy t = Proxy
+
+typeRep :: Proxy a -> TypeRep
+typeRep Proxy = TypeRep
+
+-- This one works fine:
+typeOf :: forall a. a -> TypeRep
+typeOf _ = typeRep (Proxy :: Proxy a)
+
+-- But this one panics!
+typeOf1 :: forall t a. t a -> TypeRep
+typeOf1 _ = typeRep (Proxy :: Proxy t)
diff --git a/testsuite/tests/polykinds/T5770.hs b/testsuite/tests/polykinds/T5770.hs
new file mode 100644
index 0000000000..132a1538a8
--- /dev/null
+++ b/testsuite/tests/polykinds/T5770.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE TypeFamilies,
+ PolyKinds,
+ ScopedTypeVariables
+ #-}
+
+module T5770 where
+
+convert :: a -> b
+convert = convert
+
+type family Foo a
+type instance Foo Int = Bool
+
+barT5770 :: forall a b c dummya. (b -> c) -> ((Foo a) -> c)
+barT5770 f = (convert f :: (Foo a) -> c)
+
+barT5769 :: forall b a. b -> (Foo a)
+barT5769 f = (convert f :: (Foo a))
+
+barT5768 :: forall b a. b -> (Foo a)
+barT5768 f = (convert f :: (Foo a))
diff --git a/testsuite/tests/polykinds/T5771.hs b/testsuite/tests/polykinds/T5771.hs
new file mode 100644
index 0000000000..00d760439a
--- /dev/null
+++ b/testsuite/tests/polykinds/T5771.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE DataKinds, PolyKinds, GADTs, TypeOperators #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module T5771 where
+
+class IndexedMonad m where
+ unit :: a -> m i i a
+ bind :: m i j a -> (a -> m j k b) -> m i k b
+
+newtype IndexedIO i j a = IndexedIO {runIndexedIO :: IO a}
+
+-- i and j are both *; instance is accepted
+instance IndexedMonad IndexedIO where
+ unit = IndexedIO . return
+ bind m k = IndexedIO $ runIndexedIO m >>= runIndexedIO . k
+infixl 1 `bind`
+
+data HList xs where
+ N :: HList '[]
+ (:>) :: a -> HList as -> HList (a ': as)
+infixr 5 :>
+
+newtype HLState xs ys a = HLState {runHLState :: HList xs -> (a, HList ys)}
+
+-- i and j are now [*]; rejected with the MPTCs message
+instance IndexedMonad HLState where
+ unit x = HLState $ \s -> (x, s)
+ bind (HLState f) k = HLState $ \xs ->
+ case f xs of (a, ys) -> runHLState (k a) ys
diff --git a/testsuite/tests/polykinds/T5798.hs b/testsuite/tests/polykinds/T5798.hs
new file mode 100644
index 0000000000..68f543b1c2
--- /dev/null
+++ b/testsuite/tests/polykinds/T5798.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE PolyKinds #-}
+
+module T5798 where
+
+data Proxy t = ProxyC
+
+test :: Proxy '[Int, Bool]
+test = ProxyC
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 2604925a21..bf863dd1ea 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -15,4 +15,13 @@ test('PolyKinds04', normal, compile_fail, [''])
test('PolyKinds06', normal, compile_fail, [''])
test('PolyKinds07', normal, compile_fail, [''])
-test('PolyKinds12', expect_fail, compile, [''])
+test('PolyKinds12', normal, compile, [''])
+
+test('T5798', normal, compile, [''])
+test('T5770', normal, compile, [''])
+test('T5771', normal, compile, [''])
+test('T5717', normal, compile, [''])
+
+test('Freeman', normal, compile_and_run, [''])
+test('MonoidsTF', normal, compile_and_run, [''])
+test('MonoidsFD', normal, compile_and_run, [''])
diff --git a/testsuite/tests/rename/should_fail/T5211.stderr b/testsuite/tests/rename/should_fail/T5211.stderr
index a33a02750c..b99cc04d97 100644
--- a/testsuite/tests/rename/should_fail/T5211.stderr
+++ b/testsuite/tests/rename/should_fail/T5211.stderr
@@ -1,5 +1,5 @@
-
-T5211.hs:5:1:
- Warning: The import of `Foreign.Storable' is redundant
- except perhaps to import instances from `Foreign.Storable'
- To import instances alone, use: import Foreign.Storable()
+
+T5211.hs:5:1: Warning:
+ The qualified import of `Foreign.Storable' is redundant
+ except perhaps to import instances from `Foreign.Storable'
+ To import instances alone, use: import Foreign.Storable()
diff --git a/testsuite/tests/rename/should_fail/rnfail055.stderr b/testsuite/tests/rename/should_fail/rnfail055.stderr
index d1a8ac1d04..56e6086cd2 100644
--- a/testsuite/tests/rename/should_fail/rnfail055.stderr
+++ b/testsuite/tests/rename/should_fail/rnfail055.stderr
@@ -23,10 +23,12 @@ RnFail055.hs-boot:8:6:
RnFail055.hs-boot:12:6:
Type constructor `T1' has conflicting definitions in the module and its hs-boot file
Main module: data T1 a b
+ No C type associated
RecFlag Recursive
= T1 :: forall a b. [b] -> [a] -> T1 a b Stricts: _ _
FamilyInstance: none
Boot file: data T1 a b
+ No C type associated
RecFlag NonRecursive
= T1 :: forall a b. [a] -> [b] -> T1 a b Stricts: _ _
FamilyInstance: none
@@ -34,10 +36,12 @@ RnFail055.hs-boot:12:6:
RnFail055.hs-boot:14:16:
Type constructor `T2' has conflicting definitions in the module and its hs-boot file
Main module: data Eq b => T2 a b
+ No C type associated
RecFlag Recursive
= T2 :: forall a b. a -> T2 a b Stricts: _
FamilyInstance: none
Boot file: data Eq a => T2 a b
+ No C type associated
RecFlag NonRecursive
= T2 :: forall a b. a -> T2 a b Stricts: _
FamilyInstance: none
@@ -51,10 +55,12 @@ RnFail055.hs-boot:17:12:
RnFail055.hs-boot:21:6:
Type constructor `T5' has conflicting definitions in the module and its hs-boot file
Main module: data T5 a
+ No C type associated
RecFlag Recursive
= T5 :: forall a. a -> T5 a Stricts: _ Fields: field5
FamilyInstance: none
Boot file: data T5 a
+ No C type associated
RecFlag NonRecursive
= T5 :: forall a. a -> T5 a Stricts: _
FamilyInstance: none
@@ -62,10 +68,12 @@ RnFail055.hs-boot:21:6:
RnFail055.hs-boot:23:6:
Type constructor `T6' has conflicting definitions in the module and its hs-boot file
Main module: data T6
+ No C type associated
RecFlag Recursive
= T6 :: Int -> T6 Stricts: _
FamilyInstance: none
Boot file: data T6
+ No C type associated
RecFlag NonRecursive
= T6 :: Int -> T6 HasWrapper Stricts: !
FamilyInstance: none
@@ -73,10 +81,12 @@ RnFail055.hs-boot:23:6:
RnFail055.hs-boot:25:6:
Type constructor `T7' has conflicting definitions in the module and its hs-boot file
Main module: data T7 a
+ No C type associated
RecFlag Recursive
= T7 :: forall a a. a -> T7 a Stricts: _
FamilyInstance: none
Boot file: data T7 a
+ No C type associated
RecFlag NonRecursive
= T7 :: forall a b. a -> T7 a Stricts: _
FamilyInstance: none
diff --git a/testsuite/tests/rts/Makefile b/testsuite/tests/rts/Makefile
index 3f931478d8..8f4acc0f9c 100644
--- a/testsuite/tests/rts/Makefile
+++ b/testsuite/tests/rts/Makefile
@@ -35,7 +35,7 @@ exec_signals-prep:
4850:
$(RM) 4850.o 4850.hi 4850$(exeext)
"$(TEST_HC)" $(TEST_HC_OPTS) -v0 -rtsopts -debug -threaded --make 4850
- ./4850 +RTS -s 2>&1 | grep Task | wc -l | tr -d ' '
+ ./4850 +RTS -s 2>&1 | grep TASKS | sed 's/^ *TASKS: *\([0-9]*\).*$$/\1/'
.PHONY: T5423
T5423:
diff --git a/testsuite/tests/safeHaskell/check/Check09.hs b/testsuite/tests/safeHaskell/check/Check09.hs
new file mode 100644
index 0000000000..9d4d03ca12
--- /dev/null
+++ b/testsuite/tests/safeHaskell/check/Check09.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE Safe #-}
+module Check09 where
+
+import Data.ByteString.Char8
+
+b :: ByteString
+b = pack "Hello World"
+
diff --git a/testsuite/tests/safeHaskell/check/Check09.stderr b/testsuite/tests/safeHaskell/check/Check09.stderr
new file mode 100644
index 0000000000..e3b752d554
--- /dev/null
+++ b/testsuite/tests/safeHaskell/check/Check09.stderr
@@ -0,0 +1,3 @@
+
+Check09.hs:4:1:
+ bytestring-0.10.0.0:Data.ByteString.Char8 can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted.
diff --git a/testsuite/tests/safeHaskell/check/Check10.hs b/testsuite/tests/safeHaskell/check/Check10.hs
new file mode 100644
index 0000000000..21fad6aab8
--- /dev/null
+++ b/testsuite/tests/safeHaskell/check/Check10.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE Safe #-}
+module Check10 where
+
+import Data.ByteString.Char8
+
+b :: ByteString
+b = pack "Hello World"
+
diff --git a/testsuite/tests/safeHaskell/check/all.T b/testsuite/tests/safeHaskell/check/all.T
index 41d8edf1a8..4cef8f8cc3 100644
--- a/testsuite/tests/safeHaskell/check/all.T
+++ b/testsuite/tests/safeHaskell/check/all.T
@@ -57,3 +57,10 @@ test('Check08',
extra_clean(['Check08_A.hi', 'Check08_A.o', 'Check08_B.hi', 'Check08_B.o']),
multimod_compile_fail, ['Check08', ''])
+# check -distrust-all-packages flag works
+test('Check09', normal, compile_fail, ['-fpackage-trust -distrust-all-packages'])
+
+# as above but trust this time
+test('Check10', normal, compile,
+ ['-fpackage-trust -distrust-all-packages -trust bytestring -trust base'])
+
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags28.hs b/testsuite/tests/safeHaskell/flags/SafeFlags28.hs
new file mode 100644
index 0000000000..feb4516110
--- /dev/null
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags28.hs
@@ -0,0 +1,9 @@
+{-# OPTIONS_GHC -trust base, -trust bytestring #-}
+-- | Basic test to see if no safe infer flag compiles
+-- This module would usually infer safely, so it shouldn't be safe now.
+-- We don't actually check that here though, see test '' for that.
+module SafeFlags28 where
+
+f :: Int
+f = 1
+
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags28.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags28.stderr
new file mode 100644
index 0000000000..46dcabb9fd
--- /dev/null
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags28.stderr
@@ -0,0 +1,12 @@
+
+SafeFlags28.hs:1:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: -trust
+
+SafeFlags28.hs:1:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: base,
+
+SafeFlags28.hs:1:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: -trust
+
+SafeFlags28.hs:1:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: bytestring
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags29.hs b/testsuite/tests/safeHaskell/flags/SafeFlags29.hs
new file mode 100644
index 0000000000..389fe48216
--- /dev/null
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags29.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE Safe #-}
+{-# OPTIONS_GHC -trust base -trust bytestring #-}
+-- | Basic test to see if no safe infer flag compiles
+-- This module would usually infer safely, so it shouldn't be safe now.
+-- We don't actually check that here though, see test '' for that.
+module SafeFlags29 where
+
+f :: Int
+f = 1
+
diff --git a/testsuite/tests/safeHaskell/flags/SafeFlags29.stderr b/testsuite/tests/safeHaskell/flags/SafeFlags29.stderr
new file mode 100644
index 0000000000..ee0d13b957
--- /dev/null
+++ b/testsuite/tests/safeHaskell/flags/SafeFlags29.stderr
@@ -0,0 +1,12 @@
+
+SafeFlags29.hs:2:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: -trust
+
+SafeFlags29.hs:2:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: base
+
+SafeFlags29.hs:2:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: -trust
+
+SafeFlags29.hs:2:16:
+ unknown flag in {-# OPTIONS_GHC #-} pragma: bytestring
diff --git a/testsuite/tests/safeHaskell/flags/all.T b/testsuite/tests/safeHaskell/flags/all.T
index 9269f8b842..713439567d 100644
--- a/testsuite/tests/safeHaskell/flags/all.T
+++ b/testsuite/tests/safeHaskell/flags/all.T
@@ -54,6 +54,10 @@ test('SafeFlags26', normal, compile_fail, [''])
# test -fno-safe-infer
test('SafeFlags27', normal, compile, [''])
+# test package flags don't work
+test('SafeFlags28', normal, compile_fail, [''])
+test('SafeFlags29', normal, compile_fail, [''])
+
# test certain flags are still allowed under -XSafe
test('Flags01', normal, compile, ['-XSafe'])
test('Flags02', normal, compile, ['-XSafe'])
diff --git a/testsuite/tests/safeHaskell/ghci/A.hs b/testsuite/tests/safeHaskell/ghci/A.hs
new file mode 100644
index 0000000000..73da27f637
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/A.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE Trustworthy #-}
+module A (a) where
+
+import System.IO.Unsafe
+
+a :: Int
+a = 1
+
+unsafe = unsafePerformIO
+
diff --git a/testsuite/tests/safeHaskell/ghci/B.hs b/testsuite/tests/safeHaskell/ghci/B.hs
new file mode 100644
index 0000000000..58ecfb42f7
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/B.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE Unsafe #-}
+module B where
+
+import System.IO.Unsafe
+
+a :: Int
+a = 1
+
diff --git a/testsuite/tests/safeHaskell/ghci/C.hs b/testsuite/tests/safeHaskell/ghci/C.hs
new file mode 100644
index 0000000000..94959c7c0b
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/C.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE Safe #-}
+module C (a, C(), D(..)) where
+
+a :: Int
+a = 1
+
+b :: Int
+b = 2
+
+data C a = C a Int
+
+data D a = D a Int
+
diff --git a/testsuite/tests/safeHaskell/ghci/D.hs b/testsuite/tests/safeHaskell/ghci/D.hs
new file mode 100644
index 0000000000..2a70c065ab
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/D.hs
@@ -0,0 +1,8 @@
+module D (a) where
+
+a :: Int
+a = 1
+
+b :: Int
+b = 2
+
diff --git a/testsuite/tests/safeHaskell/ghci/E.hs b/testsuite/tests/safeHaskell/ghci/E.hs
new file mode 100644
index 0000000000..4474d46d5f
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/E.hs
@@ -0,0 +1,7 @@
+module E where
+
+import System.IO.Unsafe
+
+a :: Int
+a = 1
+
diff --git a/testsuite/tests/lib/OldException/Makefile b/testsuite/tests/safeHaskell/ghci/Makefile
index 4a268530f1..4a268530f1 100644
--- a/testsuite/tests/lib/OldException/Makefile
+++ b/testsuite/tests/safeHaskell/ghci/Makefile
diff --git a/testsuite/tests/safeHaskell/ghci/P13_A.hs b/testsuite/tests/safeHaskell/ghci/P13_A.hs
new file mode 100644
index 0000000000..1044c83545
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/P13_A.hs
@@ -0,0 +1,9 @@
+{-# LANGUAGE OverlappingInstances, FlexibleInstances #-}
+module P13_A where
+
+class Pos a where { res :: a -> Bool }
+
+instance Pos [a] where { res _ = True }
+
+instance Pos Char where { res _ = True }
+
diff --git a/testsuite/tests/safeHaskell/ghci/all.T b/testsuite/tests/safeHaskell/ghci/all.T
new file mode 100644
index 0000000000..1c878c6759
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/all.T
@@ -0,0 +1,20 @@
+# Test GHCi works with Safe Haskell
+
+test('p1', normal, ghci_script, ['p1.script'])
+test('p2', normal, ghci_script, ['p2.script'])
+test('p3', normal, ghci_script, ['p3.script'])
+test('p4', normal, ghci_script, ['p4.script'])
+test('p5', normal, ghci_script, ['p5.script'])
+test('p6', normal, ghci_script, ['p6.script'])
+test('p7', normal, ghci_script, ['p7.script'])
+test('p8', normal, ghci_script, ['p8.script'])
+test('p9', normal, ghci_script, ['p9.script'])
+test('p10', normal, ghci_script, ['p10.script'])
+test('p11', normal, ghci_script, ['p11.script'])
+test('p12', normal, ghci_script, ['p12.script'])
+test('p13', normal, ghci_script, ['p13.script'])
+test('p14', normal, ghci_script, ['p14.script'])
+test('p15', normal, ghci_script, ['p15.script'])
+test('p16', normal, ghci_script, ['p16.script'])
+test('p17', normal, ghci_script, ['p17.script'])
+
diff --git a/testsuite/tests/safeHaskell/ghci/p1.script b/testsuite/tests/safeHaskell/ghci/p1.script
new file mode 100644
index 0000000000..3c55ad7208
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p1.script
@@ -0,0 +1,8 @@
+-- Test disabled language extensions
+:unset +s
+:set -XSafe
+
+:set -XTemplateHaskell
+
+:set -XGeneralizedNewtypeDeriving
+
diff --git a/testsuite/tests/safeHaskell/ghci/p1.stderr b/testsuite/tests/safeHaskell/ghci/p1.stderr
new file mode 100644
index 0000000000..9446e1df16
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p1.stderr
@@ -0,0 +1,6 @@
+
+<no location info>: Warning:
+ -XTemplateHaskell is not allowed in Safe Haskell; ignoring -XTemplateHaskell
+
+<no location info>: Warning:
+ -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving
diff --git a/testsuite/tests/safeHaskell/ghci/p10.script b/testsuite/tests/safeHaskell/ghci/p10.script
new file mode 100644
index 0000000000..e1cefae496
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p10.script
@@ -0,0 +1,10 @@
+-- Test load works
+:unset +s
+:set -XSafe
+
+:load D
+
+a
+
+b
+
diff --git a/testsuite/tests/safeHaskell/ghci/p10.stderr b/testsuite/tests/safeHaskell/ghci/p10.stderr
new file mode 100644
index 0000000000..768948984e
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p10.stderr
@@ -0,0 +1,2 @@
+
+<interactive>:10:1: Not in scope: `b'
diff --git a/testsuite/tests/safeHaskell/ghci/p10.stdout b/testsuite/tests/safeHaskell/ghci/p10.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p10.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/safeHaskell/ghci/p11.script b/testsuite/tests/safeHaskell/ghci/p11.script
new file mode 100644
index 0000000000..19fb759600
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p11.script
@@ -0,0 +1,6 @@
+-- Test load works
+:unset +s
+:set -XSafe
+
+:load E
+
diff --git a/testsuite/tests/safeHaskell/ghci/p11.stderr b/testsuite/tests/safeHaskell/ghci/p11.stderr
new file mode 100644
index 0000000000..0d33615020
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p11.stderr
@@ -0,0 +1,3 @@
+
+E.hs:3:1:
+ base:System.IO.Unsafe can't be safely imported! The module itself isn't safe.
diff --git a/testsuite/tests/safeHaskell/ghci/p12.script b/testsuite/tests/safeHaskell/ghci/p12.script
new file mode 100644
index 0000000000..486302e8ed
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p12.script
@@ -0,0 +1,10 @@
+-- Test you can't unset options
+:unset +s
+:set -XSafe
+:unset -XSafe
+
+:set -fpackage-trust
+:unset -fpackage-trust
+
+import Data.ByteString
+
diff --git a/testsuite/tests/safeHaskell/ghci/p12.stderr b/testsuite/tests/safeHaskell/ghci/p12.stderr
new file mode 100644
index 0000000000..c97035e7ab
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p12.stderr
@@ -0,0 +1,3 @@
+
+<no location info>:
+ bytestring-0.10.0.0:Data.ByteString can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted.
diff --git a/testsuite/tests/safeHaskell/ghci/p12.stdout b/testsuite/tests/safeHaskell/ghci/p12.stdout
new file mode 100644
index 0000000000..5d16ff7a9f
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p12.stdout
@@ -0,0 +1,2 @@
+don't know how to reverse -XSafe
+Some flags have not been recognized: -fno-package-trust
diff --git a/testsuite/tests/safeHaskell/ghci/p13.script b/testsuite/tests/safeHaskell/ghci/p13.script
new file mode 100644
index 0000000000..4e96c844ed
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p13.script
@@ -0,0 +1,14 @@
+-- Test restricted functionality: Overlapping
+:unset +s
+:set -XSafe
+:set -XOverlappingInstances
+:set -XFlexibleInstances
+
+:l P13_A
+
+instance Pos [Int] where { res _ = error "This curry is poisoned!" }
+
+res [1::Int, 2::Int]
+-- res 'c'
+-- res ['c']
+
diff --git a/testsuite/tests/safeHaskell/ghci/p13.stderr b/testsuite/tests/safeHaskell/ghci/p13.stderr
new file mode 100644
index 0000000000..5e31e43439
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p13.stderr
@@ -0,0 +1,13 @@
+
+<interactive>:12:1:
+ Unsafe overlapping instances for Pos [Int]
+ arising from a use of `res'
+ The matching instance is:
+ instance [overlap ok] [safe] Pos [Int]
+ -- Defined at <interactive>:10:10
+ It is compiled in a Safe module and as such can only
+ overlap instances from the same module, however it
+ overlaps the following instances from different modules:
+ instance [overlap ok] [safe] Pos [a] -- Defined at P13_A.hs:6:10
+ In the expression: res [1 :: Int, 2 :: Int]
+ In an equation for `it': it = res [1 :: Int, 2 :: Int]
diff --git a/testsuite/tests/safeHaskell/ghci/p13.stdout b/testsuite/tests/safeHaskell/ghci/p13.stdout
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p13.stdout
diff --git a/testsuite/tests/safeHaskell/ghci/p14.script b/testsuite/tests/safeHaskell/ghci/p14.script
new file mode 100644
index 0000000000..4802faf940
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p14.script
@@ -0,0 +1,10 @@
+-- Test restricted functionality: RULES
+:unset +s
+:set -XSafe
+
+:set -fenable-rewrite-rules
+
+let f x = x - 1
+
+{-# RULES "id/Int" id = f #-}
+
diff --git a/testsuite/tests/safeHaskell/ghci/p14.stderr b/testsuite/tests/safeHaskell/ghci/p14.stderr
new file mode 100644
index 0000000000..4a66d78f55
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p14.stderr
@@ -0,0 +1,2 @@
+
+<interactive>:10:1: parse error on input `{-# RULES'
diff --git a/testsuite/tests/safeHaskell/ghci/p15.script b/testsuite/tests/safeHaskell/ghci/p15.script
new file mode 100644
index 0000000000..3faeec9df9
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p15.script
@@ -0,0 +1,23 @@
+-- Test restricted functionality: Data.Typeable
+:unset +s
+:set -XSafe
+:set -XDeriveDataTypeable
+:set -XStandaloneDeriving
+
+:m + Data.Typeable
+
+data H = H {h :: String} deriving (Typeable, Show)
+
+data G = G [Int] deriving (Show)
+
+instance Typeable G where { typeOf _ = typeOf (undefined :: H) }
+
+let x = H "Hello"
+let y = G [0]
+
+x
+y
+
+let (Just y_as_H) = (cast y) :: Maybe H
+y_as_H
+
diff --git a/testsuite/tests/safeHaskell/ghci/p15.stderr b/testsuite/tests/safeHaskell/ghci/p15.stderr
new file mode 100644
index 0000000000..883f541c7b
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p15.stderr
@@ -0,0 +1,12 @@
+
+<interactive>:14:10:
+ Can't create hand written instances of Typeable in Safe Haskell! Can only derive them
+
+<interactive>:22:22:
+ No instance for (Typeable G)
+ arising from a use of `cast'
+ Possible fix: add an instance declaration for (Typeable G)
+ In the expression: (cast y) :: Maybe H
+ In a pattern binding: (Just y_as_H) = (cast y) :: Maybe H
+
+<interactive>:23:1: Not in scope: `y_as_H'
diff --git a/testsuite/tests/safeHaskell/ghci/p15.stdout b/testsuite/tests/safeHaskell/ghci/p15.stdout
new file mode 100644
index 0000000000..40b3f68882
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p15.stdout
@@ -0,0 +1,2 @@
+H {h = "Hello"}
+G [0]
diff --git a/testsuite/tests/safeHaskell/ghci/p16.script b/testsuite/tests/safeHaskell/ghci/p16.script
new file mode 100644
index 0000000000..2bcea65c95
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p16.script
@@ -0,0 +1,22 @@
+-- Test restricted functionality: GeneralizedNewtypeDeriving
+:unset +s
+:set -XSafe
+
+:set -XGeneralizedNewtypeDeriving
+
+class Op a where { op :: a -> String }
+
+data T = A | B | C deriving (Show)
+instance Op T where { op _ = "T" }
+
+newtype T1 = T1 T
+instance Op T1 where op _ = "t1"
+
+newtype T2 = T2 T deriving (Op)
+
+let x = T1 A
+let y = T2 A
+
+op x
+op y
+
diff --git a/testsuite/tests/safeHaskell/ghci/p16.stderr b/testsuite/tests/safeHaskell/ghci/p16.stderr
new file mode 100644
index 0000000000..33602c70a5
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p16.stderr
@@ -0,0 +1,15 @@
+
+<no location info>: Warning:
+ -XGeneralizedNewtypeDeriving is not allowed in Safe Haskell; ignoring -XGeneralizedNewtypeDeriving
+
+<interactive>:16:29:
+ Can't make a derived instance of `Op T2':
+ `Op' is not a derivable class
+ Try -XGeneralizedNewtypeDeriving for GHC's newtype-deriving extension
+ In the newtype declaration for `T2'
+
+<interactive>:19:9:
+ Not in scope: data constructor `T2'
+ Perhaps you meant `T1' (line 13)
+
+<interactive>:22:4: Not in scope: `y'
diff --git a/testsuite/tests/safeHaskell/ghci/p16.stdout b/testsuite/tests/safeHaskell/ghci/p16.stdout
new file mode 100644
index 0000000000..233a1e18c7
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p16.stdout
@@ -0,0 +1 @@
+"t1"
diff --git a/testsuite/tests/safeHaskell/ghci/p17.script b/testsuite/tests/safeHaskell/ghci/p17.script
new file mode 100644
index 0000000000..c9821d4e17
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p17.script
@@ -0,0 +1,10 @@
+-- Test bad imports
+:unset +s
+:set -XSafe
+
+-- test trustworthy and package flag
+import Data.ByteString
+
+:set -fpackage-trust
+import Data.ByteString
+
diff --git a/testsuite/tests/safeHaskell/ghci/p17.stderr b/testsuite/tests/safeHaskell/ghci/p17.stderr
new file mode 100644
index 0000000000..c97035e7ab
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p17.stderr
@@ -0,0 +1,3 @@
+
+<no location info>:
+ bytestring-0.10.0.0:Data.ByteString can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted.
diff --git a/testsuite/tests/safeHaskell/ghci/p2.script b/testsuite/tests/safeHaskell/ghci/p2.script
new file mode 100644
index 0000000000..c2191165fd
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p2.script
@@ -0,0 +1,10 @@
+-- Test bad options
+
+:unset +s
+:set -XSafe
+
+-- we actually allow this for now but may want to revist this decision
+:set -trust base
+:set -distrust base
+:set -distrust-all
+
diff --git a/testsuite/tests/safeHaskell/ghci/p2.stderr b/testsuite/tests/safeHaskell/ghci/p2.stderr
new file mode 100644
index 0000000000..342bb05686
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p2.stderr
@@ -0,0 +1,2 @@
+package flags have changed, resetting and loading new packages...
+package flags have changed, resetting and loading new packages...
diff --git a/testsuite/tests/safeHaskell/ghci/p2.stdout b/testsuite/tests/safeHaskell/ghci/p2.stdout
new file mode 100644
index 0000000000..c6efa9ed48
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p2.stdout
@@ -0,0 +1,2 @@
+cannot satisfy -package -all
+ (use -v for more information)
diff --git a/testsuite/tests/safeHaskell/ghci/p3.script b/testsuite/tests/safeHaskell/ghci/p3.script
new file mode 100644
index 0000000000..c2d9061739
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p3.script
@@ -0,0 +1,12 @@
+-- Test bad imports
+:unset +s
+:set -XSafe
+
+import System.IO.Unsafe
+
+-- test trustworthy and package flag
+import Data.ByteString
+
+:set -fpackage-trust
+import Data.ByteString
+
diff --git a/testsuite/tests/safeHaskell/ghci/p3.stderr b/testsuite/tests/safeHaskell/ghci/p3.stderr
new file mode 100644
index 0000000000..62aca4e2c0
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p3.stderr
@@ -0,0 +1,6 @@
+
+<no location info>:
+ base:System.IO.Unsafe can't be safely imported! The module itself isn't safe.
+
+<no location info>:
+ bytestring-0.10.0.0:Data.ByteString can't be safely imported! The package (bytestring-0.10.0.0) the module resides in isn't trusted.
diff --git a/testsuite/tests/safeHaskell/ghci/p3.stdout b/testsuite/tests/safeHaskell/ghci/p3.stdout
new file mode 100644
index 0000000000..268f05e8d9
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p3.stdout
@@ -0,0 +1 @@
+can't import System.IO.Unsafe as it isn't trusted.
diff --git a/testsuite/tests/safeHaskell/ghci/p4.script b/testsuite/tests/safeHaskell/ghci/p4.script
new file mode 100644
index 0000000000..8d78f40679
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p4.script
@@ -0,0 +1,8 @@
+-- Test bad direct calls
+:unset +s
+:set -XSafe
+
+let x = System.IO.Unsafe.unsafePerformIO
+let y = x (putStrLn "Hello" >> return 1)
+y
+
diff --git a/testsuite/tests/safeHaskell/ghci/p4.stderr b/testsuite/tests/safeHaskell/ghci/p4.stderr
new file mode 100644
index 0000000000..8ff4107af8
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p4.stderr
@@ -0,0 +1,6 @@
+
+<interactive>:6:9: Not in scope: `System.IO.Unsafe.unsafePerformIO'
+
+<interactive>:7:9: Not in scope: `x'
+
+<interactive>:8:1: Not in scope: `y'
diff --git a/testsuite/tests/safeHaskell/ghci/p5.script b/testsuite/tests/safeHaskell/ghci/p5.script
new file mode 100644
index 0000000000..cdf6088812
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p5.script
@@ -0,0 +1,13 @@
+-- Test unsetting safe
+:unset +s
+:set -XSafe
+
+:set -XSafe
+:unset -XSafe
+
+:set -XTrustworthy
+:unset -XTrustworthy
+
+:set -XUnsafe
+:unset -XUnsafe
+
diff --git a/testsuite/tests/safeHaskell/ghci/p5.stdout b/testsuite/tests/safeHaskell/ghci/p5.stdout
new file mode 100644
index 0000000000..3f649f7b60
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p5.stdout
@@ -0,0 +1,7 @@
+don't know how to reverse -XSafe
+ghc-stage2: <no location info>: Incompatible Safe Haskell flags! (Safe, Trustworthy)
+Usage: For basic information, try the `--help' option.
+don't know how to reverse -XTrustworthy
+ghc-stage2: <no location info>: Incompatible Safe Haskell flags! (Safe, Unsafe)
+Usage: For basic information, try the `--help' option.
+don't know how to reverse -XUnsafe
diff --git a/testsuite/tests/safeHaskell/ghci/p6.script b/testsuite/tests/safeHaskell/ghci/p6.script
new file mode 100644
index 0000000000..8590fd6449
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p6.script
@@ -0,0 +1,13 @@
+-- Test restricted functionality: FFI
+:unset +s
+:set -XSafe
+
+:set -XForeignFunctionInterface
+
+foreign import ccall "sin" c_sin' :: Double -> IO Double
+x <- c_sin' 1
+x
+
+foreign import ccall "sin" c_sin :: Double -> Double
+c_sin 1
+
diff --git a/testsuite/tests/safeHaskell/ghci/p6.stderr b/testsuite/tests/safeHaskell/ghci/p6.stderr
new file mode 100644
index 0000000000..b32c521b4d
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p6.stderr
@@ -0,0 +1,10 @@
+
+<interactive>:12:1:
+ Unacceptable result type in foreign declaration: Double
+ Safe Haskell is on, all FFI imports must be in the IO monad
+ When checking declaration:
+ foreign import ccall safe "static sin" c_sin :: Double -> Double
+
+<interactive>:13:1:
+ Not in scope: `c_sin'
+ Perhaps you meant c_sin' (line 8)
diff --git a/testsuite/tests/safeHaskell/ghci/p6.stdout b/testsuite/tests/safeHaskell/ghci/p6.stdout
new file mode 100644
index 0000000000..e83a344363
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p6.stdout
@@ -0,0 +1 @@
+0.8414709848078965
diff --git a/testsuite/tests/safeHaskell/ghci/p7.script b/testsuite/tests/safeHaskell/ghci/p7.script
new file mode 100644
index 0000000000..ea4190b0a4
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p7.script
@@ -0,0 +1,6 @@
+-- Test load works
+:unset +s
+:set -XSafe
+
+:load A
+
diff --git a/testsuite/tests/safeHaskell/ghci/p7.stdout b/testsuite/tests/safeHaskell/ghci/p7.stdout
new file mode 100644
index 0000000000..674794fdac
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p7.stdout
@@ -0,0 +1,2 @@
+ghc-stage2: A.hs:1:14-24: Incompatible Safe Haskell flags! (Safe, Trustworthy)
+Usage: For basic information, try the `--help' option.
diff --git a/testsuite/tests/safeHaskell/ghci/p8.script b/testsuite/tests/safeHaskell/ghci/p8.script
new file mode 100644
index 0000000000..7d5101f226
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p8.script
@@ -0,0 +1,6 @@
+-- Test load works
+:unset +s
+:set -XSafe
+
+:load B
+
diff --git a/testsuite/tests/safeHaskell/ghci/p8.stdout b/testsuite/tests/safeHaskell/ghci/p8.stdout
new file mode 100644
index 0000000000..8280f4a6b0
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p8.stdout
@@ -0,0 +1,2 @@
+ghc-stage2: B.hs:1:14-19: Incompatible Safe Haskell flags! (Safe, Unsafe)
+Usage: For basic information, try the `--help' option.
diff --git a/testsuite/tests/safeHaskell/ghci/p9.script b/testsuite/tests/safeHaskell/ghci/p9.script
new file mode 100644
index 0000000000..298944dcae
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p9.script
@@ -0,0 +1,10 @@
+-- Test load works
+:unset +s
+:set -XSafe
+
+:load C
+
+a
+
+b
+
diff --git a/testsuite/tests/safeHaskell/ghci/p9.stderr b/testsuite/tests/safeHaskell/ghci/p9.stderr
new file mode 100644
index 0000000000..768948984e
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p9.stderr
@@ -0,0 +1,2 @@
+
+<interactive>:10:1: Not in scope: `b'
diff --git a/testsuite/tests/safeHaskell/ghci/p9.stdout b/testsuite/tests/safeHaskell/ghci/p9.stdout
new file mode 100644
index 0000000000..d00491fd7e
--- /dev/null
+++ b/testsuite/tests/safeHaskell/ghci/p9.stdout
@@ -0,0 +1 @@
+1
diff --git a/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs b/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs
index 9f253a7807..1442c9b5d0 100644
--- a/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs
+++ b/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.hs
@@ -22,7 +22,6 @@ import Control.Concurrent.QSemN
import Control.Concurrent.SampleVar
import Control.Exception
-import Control.OldException
import Control.Exception.Base
import Control.Monad
diff --git a/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.stderr b/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.stderr
deleted file mode 100644
index 33d90f9881..0000000000
--- a/testsuite/tests/safeHaskell/unsafeLibs/GoodImport03.stderr
+++ /dev/null
@@ -1,4 +0,0 @@
-
-GoodImport03.hs:25:1:
- Warning: Module `Control.OldException' is deprecated:
- Future versions of base will not support the old exceptions style. Please switch to extensible exceptions.
diff --git a/testsuite/tests/simplCore/should_compile/rule2.stderr b/testsuite/tests/simplCore/should_compile/rule2.stderr
index f41296a15f..8279fce14f 100644
--- a/testsuite/tests/simplCore/should_compile/rule2.stderr
+++ b/testsuite/tests/simplCore/should_compile/rule2.stderr
@@ -21,10 +21,10 @@ Total ticks: 11
1 f
1 m
1 a
- 1 m
- 1 a
1 b
1 m
+ 1 m
+ 1 a
8 SimplifierDone 8
diff --git a/testsuite/tests/th/Makefile b/testsuite/tests/th/Makefile
index 97692391c0..0dca106eb2 100644
--- a/testsuite/tests/th/Makefile
+++ b/testsuite/tests/th/Makefile
@@ -26,13 +26,8 @@ TH_Depends:
echo "first run" > TH_Depends_external.txt
'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 TH_Depends
./TH_Depends
-# Remove the executable, as GHC won't relink if the timestamps seem to
-# be the same
- $(RM) TH_Depends TH_Depends.exe
+ sleep 2
echo "second run" > TH_Depends_external.txt
-# Give TH_Depends_external.txt a future date in case it gets the same
-# timestamp again
- touch --date="now + 3 seconds" TH_Depends_external.txt
'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 TH_Depends
./TH_Depends
diff --git a/testsuite/tests/th/T3177a.stderr b/testsuite/tests/th/T3177a.stderr
index 00b0c0d92c..806a1f92a7 100644
--- a/testsuite/tests/th/T3177a.stderr
+++ b/testsuite/tests/th/T3177a.stderr
@@ -7,5 +7,4 @@ T3177a.hs:8:15:
T3177a.hs:11:6:
`Int' is applied to too many type arguments
- In the type signature for `g':
- g :: Int Int
+ In the type signature for `g': g :: Int Int
diff --git a/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc b/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc
index 04d55b4447..17d8e2cf84 100644
--- a/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc
+++ b/testsuite/tests/typecheck/prog001/typecheck.prog001.stderr-ghc
@@ -1,4 +1,5 @@
-
-B.hs:7:10:
- Warning: No explicit method or default declaration for `row'
- In the instance declaration for `Matrix Bool Val'
+
+B.hs:7:10:
+ Warning: No explicit method or default declaration for `row'
+ In the instance declaration for `Matrix Bool Val'
+
diff --git a/testsuite/tests/typecheck/should_compile/FD1.stderr b/testsuite/tests/typecheck/should_compile/FD1.stderr
index 6f98877b84..0bec66931a 100644
--- a/testsuite/tests/typecheck/should_compile/FD1.stderr
+++ b/testsuite/tests/typecheck/should_compile/FD1.stderr
@@ -4,9 +4,9 @@ FD1.hs:16:1:
from the context (E a (Int -> Int))
bound by the type signature for
plus :: E a (Int -> Int) => Int -> a
- at FD1.hs:16:1-16
+ at FD1.hs:15:9-38
`a' is a rigid type variable bound by
the type signature for plus :: E a (Int -> Int) => Int -> a
- at FD1.hs:16:1
+ at FD1.hs:15:12
The equation(s) for `plus' have two arguments,
but its type `Int -> a' has only one
diff --git a/testsuite/tests/typecheck/should_compile/FD2.stderr b/testsuite/tests/typecheck/should_compile/FD2.stderr
index 2b2fee3eb9..392f92723d 100644
--- a/testsuite/tests/typecheck/should_compile/FD2.stderr
+++ b/testsuite/tests/typecheck/should_compile/FD2.stderr
@@ -7,19 +7,19 @@ FD2.hs:26:36:
or from (Elem a e)
bound by the type signature for
foldr1 :: Elem a e => (e -> e -> e) -> a -> e
- at FD2.hs:(22,3)-(26,39)
+ at FD2.hs:21:13-47
or from (Elem a e1)
bound by the type signature for
mf :: Elem a e1 => e1 -> Maybe e1 -> Maybe e1
- at FD2.hs:(25,12)-(26,39)
+ at FD2.hs:24:18-54
`e' is a rigid type variable bound by
the type signature for
foldr1 :: Elem a e => (e -> e -> e) -> a -> e
- at FD2.hs:22:3
+ at FD2.hs:21:20
`e1' is a rigid type variable bound by
the type signature for
mf :: Elem a e1 => e1 -> Maybe e1 -> Maybe e1
- at FD2.hs:25:12
+ at FD2.hs:24:25
In the first argument of `f', namely `x'
In the first argument of `Just', namely `(f x y)'
In the expression: Just (f x y)
diff --git a/testsuite/tests/typecheck/should_compile/FD3.stderr b/testsuite/tests/typecheck/should_compile/FD3.stderr
index 6f6aa8a1a2..9144b5fdb3 100644
--- a/testsuite/tests/typecheck/should_compile/FD3.stderr
+++ b/testsuite/tests/typecheck/should_compile/FD3.stderr
@@ -3,7 +3,7 @@ FD3.hs:15:15:
Couldn't match type `a' with `([Char], a)'
`a' is a rigid type variable bound by
the type signature for translate :: (String, a) -> A a
- at FD3.hs:15:1
+ at FD3.hs:14:23
When using functional dependencies to combine
MkA a a,
arising from the dependency `a -> b'
diff --git a/testsuite/tests/typecheck/should_compile/Makefile b/testsuite/tests/typecheck/should_compile/Makefile
index 9ca0b63590..36e924aeb4 100644
--- a/testsuite/tests/typecheck/should_compile/Makefile
+++ b/testsuite/tests/typecheck/should_compile/Makefile
@@ -24,3 +24,9 @@ tc245:
$(RM) -f tc245.hi tc245.o
'$(TEST_HC)' $(filter-out -fforce-recomp,$(TEST_HC_OPTS)) --make tc245
+# Trac #5792 gave an error on the second compilation,
+# presumably because of the .hi file
+T5792:
+ $(RM) -f T5792.o T5792.hi
+ '$(TEST_HC)' -c T5792.hs
+ '$(TEST_HC)' -c T5792.hs -fforce-recomp
diff --git a/testsuite/tests/typecheck/should_compile/T5792.hs b/testsuite/tests/typecheck/should_compile/T5792.hs
new file mode 100644
index 0000000000..49d0826bcf
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T5792.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}
+
+module T5792 where
+
+
+data T = TT
+type family Compare (m :: T) :: Ordering
+type instance Compare TT = Compare TT
+
+type Compare' a = Compare a
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index a4ad3cfd08..ce6f95e56f 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -371,3 +371,5 @@ test('T5595', normal, compile, [''])
test('T5676', normal, compile, [''])
test('T4310', normal, compile, [''])
+test('T5792',normal,run_command,
+ ['$MAKE -s --no-print-directory T5792'])
diff --git a/testsuite/tests/typecheck/should_compile/tc141.stderr b/testsuite/tests/typecheck/should_compile/tc141.stderr
index 2fdf1fa99c..0d08303345 100644
--- a/testsuite/tests/typecheck/should_compile/tc141.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc141.stderr
@@ -1,6 +1,43 @@
-tc141.hs:11:15: Not in scope: type variable `a'
+tc141.hs:11:12:
+ You cannot bind scoped type variable `a'
+ in a pattern binding signature
+ In the pattern: p :: a
+ In the pattern: (p :: a, q :: a)
+ In a pattern binding: (p :: a, q :: a) = x
-tc141.hs:11:20: Not in scope: type variable `a'
+tc141.hs:11:31:
+ Couldn't match expected type `a1' with actual type `a'
+ `a1' is a rigid type variable bound by
+ an expression type signature: a1 at tc141.hs:11:31
+ `a' is a rigid type variable bound by
+ the inferred type of f :: (a, a) -> (t, a) at tc141.hs:11:1
+ In the expression: q :: a
+ In the expression: (q :: a, p)
+ In the expression: let (p :: a, q :: a) = x in (q :: a, p)
-tc141.hs:13:16: Not in scope: type variable `a'
+tc141.hs:13:13:
+ You cannot bind scoped type variable `a'
+ in a pattern binding signature
+ In the pattern: y :: a
+ In a pattern binding: y :: a = a
+ In the expression:
+ let y :: a = a in
+ let
+ v :: a
+ v = b
+ in v
+
+tc141.hs:15:18:
+ Couldn't match expected type `a1' with actual type `t1'
+ `a1' is a rigid type variable bound by
+ the type signature for v :: a1 at tc141.hs:14:19
+ `t1' is a rigid type variable bound by
+ the inferred type of g :: t -> t1 -> a at tc141.hs:13:1
+ In the expression: b
+ In an equation for `v': v = b
+ In the expression:
+ let
+ v :: a
+ v = b
+ in v
diff --git a/testsuite/tests/typecheck/should_compile/tc231.stderr b/testsuite/tests/typecheck/should_compile/tc231.stderr
index 9647f34fef..6d3be6a45d 100644
--- a/testsuite/tests/typecheck/should_compile/tc231.stderr
+++ b/testsuite/tests/typecheck/should_compile/tc231.stderr
@@ -5,11 +5,13 @@ TYPE SIGNATURES
s :: forall t t1. Q t (Z [Char]) t1 -> Q t (Z [Char]) t1
TYPE CONSTRUCTORS
data Q s a chain
+ No C type associated
RecFlag NonRecursive
= Node :: forall s a chain. s -> a -> chain -> Q s a chain
Stricts: _ _ _
FamilyInstance: none
data Z a
+ No C type associated
RecFlag NonRecursive
= Z :: forall a. a -> Z a Stricts: _
FamilyInstance: none
diff --git a/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr b/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr
index 229b14a15b..24b2149bf5 100644
--- a/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr
+++ b/testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr
@@ -7,7 +7,7 @@ FailDueToGivenOverlapping.hs:27:9:
Matching givens (or their superclasses):
(E [Int])
bound by the type signature for bar :: E [Int] => () -> ()
- at FailDueToGivenOverlapping.hs:27:1-23
+ at FailDueToGivenOverlapping.hs:26:8-26
(The choice depends on the instantiation of `t0')
In the expression: eop [undefined]
In an equation for `bar': bar _ = eop [undefined]
diff --git a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
index f5a49c89d0..f6df41763f 100644
--- a/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
+++ b/testsuite/tests/typecheck/should_fail/FrozenErrorTests.stderr
@@ -1,9 +1,9 @@
-FrozenErrorTests.hs:11:1:
+FrozenErrorTests.hs:10:8:
Couldn't match type `a' with `T a'
`a' is a rigid type variable bound by
the type signature for foo :: a ~ T a => a -> a
- at FrozenErrorTests.hs:11:1
+ at FrozenErrorTests.hs:10:15
Inaccessible code in
the type signature for foo :: a ~ T a => a -> a
diff --git a/testsuite/tests/typecheck/should_fail/IPFail.stderr b/testsuite/tests/typecheck/should_fail/IPFail.stderr
index 7d0d8980af..dbb25d553f 100644
--- a/testsuite/tests/typecheck/should_fail/IPFail.stderr
+++ b/testsuite/tests/typecheck/should_fail/IPFail.stderr
@@ -3,7 +3,7 @@ IPFail.hs:6:18:
Could not deduce (Num Bool) arising from the literal `5'
from the context (?x::Int)
bound by the type signature for f0 :: (?x::Int) => () -> Bool
- at IPFail.hs:6:1-24
+ at IPFail.hs:5:7-31
Possible fix:
add (Num Bool) to the context of
the type signature for f0 :: (?x::Int) => () -> Bool
diff --git a/testsuite/tests/typecheck/should_fail/T1899.stderr b/testsuite/tests/typecheck/should_fail/T1899.stderr
index 5779301745..5a37c8949a 100644
--- a/testsuite/tests/typecheck/should_fail/T1899.stderr
+++ b/testsuite/tests/typecheck/should_fail/T1899.stderr
@@ -3,7 +3,7 @@ T1899.hs:14:36:
Couldn't match type `a' with `Proposition a0'
`a' is a rigid type variable bound by
the type signature for transRHS :: [a] -> Int -> Constraint a
- at T1899.hs:10:2
+ at T1899.hs:9:15
Expected type: [Proposition a0]
Actual type: [a]
In the first argument of `Auxiliary', namely `varSet'
diff --git a/testsuite/tests/typecheck/should_fail/T2538.stderr b/testsuite/tests/typecheck/should_fail/T2538.stderr
index e4e9a7551a..b2d1d3aeb6 100644
--- a/testsuite/tests/typecheck/should_fail/T2538.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2538.stderr
@@ -1,14 +1,14 @@
-
-T2538.hs:6:1:
- Illegal polymorphic or qualified type: Eq a => a -> a
- Perhaps you intended to use -XRankNTypes or -XRank2Types
- In the type signature for `f': f :: (Eq a => a -> a) -> Int
-
-T2538.hs:9:1:
- Illegal polymorphic or qualified type: Eq a => a -> a
- Perhaps you intended to use -XImpredicativeTypes
- In the type signature for `g': g :: [Eq a => a -> a] -> Int
-
-T2538.hs:12:1:
- Illegal polymorphic or qualified type: Eq a => a -> a
- In the type signature for `h': h :: Ix (Eq a => a -> a) => Int
+
+T2538.hs:6:6:
+ Illegal polymorphic or qualified type: Eq a => a -> a
+ Perhaps you intended to use -XRankNTypes or -XRank2Types
+ In the type signature for `f': f :: (Eq a => a -> a) -> Int
+
+T2538.hs:9:6:
+ Illegal polymorphic or qualified type: Eq a => a -> a
+ Perhaps you intended to use -XImpredicativeTypes
+ In the type signature for `g': g :: [Eq a => a -> a] -> Int
+
+T2538.hs:12:6:
+ Illegal polymorphic or qualified type: Eq a => a -> a
+ In the type signature for `h': h :: Ix (Eq a => a -> a) => Int
diff --git a/testsuite/tests/typecheck/should_fail/T2714.stderr b/testsuite/tests/typecheck/should_fail/T2714.stderr
index 18e36fa800..e7f3b4aa92 100644
--- a/testsuite/tests/typecheck/should_fail/T2714.stderr
+++ b/testsuite/tests/typecheck/should_fail/T2714.stderr
@@ -3,7 +3,7 @@ T2714.hs:8:5:
Couldn't match type `a' with `f0 b'
`a' is a rigid type variable bound by
the type signature for f :: ((a -> b) -> b) -> forall c. c -> a
- at T2714.hs:8:1
+ at T2714.hs:7:8
Expected type: ((a -> b) -> b) -> c -> a
Actual type: ((a -> b) -> b) -> f0 (a -> b) -> f0 b
In the expression: ffmap
diff --git a/testsuite/tests/typecheck/should_fail/T3468.stderr b/testsuite/tests/typecheck/should_fail/T3468.stderr
index 45400bc1ea..ac040ba05d 100644
--- a/testsuite/tests/typecheck/should_fail/T3468.stderr
+++ b/testsuite/tests/typecheck/should_fail/T3468.stderr
@@ -2,9 +2,11 @@
T3468.hs-boot:3:6:
Type constructor `Tool' has conflicting definitions in the module and its hs-boot file
Main module: data Tool d
+ No C type associated
RecFlag Recursive
= F :: forall d a r. a -> Tool d Stricts: _
FamilyInstance: none
Boot file: abstract(False) Tool
+ No C type associated
RecFlag NonRecursive
FamilyInstance: none
diff --git a/testsuite/tests/typecheck/should_fail/T5300.stderr b/testsuite/tests/typecheck/should_fail/T5300.stderr
index a051692bc5..272f8b5762 100644
--- a/testsuite/tests/typecheck/should_fail/T5300.stderr
+++ b/testsuite/tests/typecheck/should_fail/T5300.stderr
@@ -5,7 +5,7 @@ T5300.hs:15:9:
bound by the type signature for
f2 :: (Monad m, C1 a1 b1 c1, C2 a2 b2 c2) =>
a1 -> StateT (T b2) m a2
- at T5300.hs:15:1-36
+ at T5300.hs:14:7-69
The type variable `c0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
In the first argument of `(>>=)', namely `f1 fm'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail034.stderr b/testsuite/tests/typecheck/should_fail/tcfail034.stderr
index db8e148eb9..38b04c10c6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail034.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail034.stderr
@@ -3,7 +3,7 @@ tcfail034.hs:17:13:
Could not deduce (Integral a) arising from a use of `mod'
from the context (Num a, Eq a)
bound by the type signature for test :: (Num a, Eq a) => a -> Bool
- at tcfail034.hs:17:1-25
+ at tcfail034.hs:16:7-32
Possible fix:
add (Integral a) to the context of
the type signature for test :: (Num a, Eq a) => a -> Bool
diff --git a/testsuite/tests/typecheck/should_fail/tcfail067.stderr b/testsuite/tests/typecheck/should_fail/tcfail067.stderr
index 513f5e9977..6be6ef494b 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail067.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail067.stderr
@@ -1,6 +1,6 @@
-tcfail067.hs:1:14:
- Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
+tcfail067.hs:1:14: Warning:
+ -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
tcfail067.hs:12:16:
No instance for (Ord a)
@@ -20,7 +20,7 @@ tcfail067.hs:46:12:
from the context (Show a)
bound by the type signature for
showRange :: Show a => SubRange a -> String
- at tcfail067.hs:(46,1)-(47,58)
+ at tcfail067.hs:45:14-43
Possible fix:
add (Ord a) to the context of
the type signature for showRange :: Show a => SubRange a -> String
@@ -59,7 +59,7 @@ tcfail067.hs:74:5:
bound by the type signature for
numSubRangeBinOp :: Num a =>
(a -> a -> a) -> SubRange a -> SubRange a -> SubRange a
- at tcfail067.hs:(73,1)-(76,53)
+ at tcfail067.hs:(71,21)-(72,58)
Possible fix:
add (Ord a) to the context of
the type signature for
diff --git a/testsuite/tests/typecheck/should_fail/tcfail068.stderr b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
index 11d39617db..4b9c8064a7 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail068.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail068.stderr
@@ -4,14 +4,14 @@ tcfail068.hs:14:9:
from the context (Constructed a)
bound by the type signature for
itgen :: Constructed a => (Int, Int) -> a -> IndTree s a
- at tcfail068.hs:(12,1)-(14,31)
+ at tcfail068.hs:11:10-55
`s1' is a rigid type variable bound by
a type expected by the context: GHC.ST.ST s1 (IndTree s a)
at tcfail068.hs:13:9
`s' is a rigid type variable bound by
the type signature for
itgen :: Constructed a => (Int, Int) -> a -> IndTree s a
- at tcfail068.hs:12:1
+ at tcfail068.hs:11:53
Expected type: GHC.ST.ST s1 (IndTree s a)
Actual type: GHC.ST.ST s1 (STArray s1 (Int, Int) a)
In the return type of a call of `newSTArray'
@@ -25,12 +25,12 @@ tcfail068.hs:19:21:
bound by the type signature for
itiap :: Constructed a =>
(Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
- at tcfail068.hs:(17,1)-(21,19)
+ at tcfail068.hs:16:10-75
`s' is a rigid type variable bound by
the type signature for
itiap :: Constructed a =>
(Int, Int) -> (a -> a) -> IndTree s a -> IndTree s a
- at tcfail068.hs:17:1
+ at tcfail068.hs:16:58
`s1' is a rigid type variable bound by
a type expected by the context: GHC.ST.ST s1 (IndTree s a)
at tcfail068.hs:18:9
@@ -48,12 +48,12 @@ tcfail068.hs:24:35:
bound by the type signature for
itrap :: Constructed a =>
((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a
- at tcfail068.hs:(24,1)-(32,41)
+ at tcfail068.hs:23:10-87
`s' is a rigid type variable bound by
the type signature for
itrap :: Constructed a =>
((Int, Int), (Int, Int)) -> (a -> a) -> IndTree s a -> IndTree s a
- at tcfail068.hs:24:1
+ at tcfail068.hs:23:70
`s1' is a rigid type variable bound by
a type expected by the context: GHC.ST.ST s1 (IndTree s a)
at tcfail068.hs:24:29
@@ -75,7 +75,7 @@ tcfail068.hs:36:46:
-> c
-> IndTree s b
-> (c, IndTree s b)
- at tcfail068.hs:(36,1)-(45,66)
+ at tcfail068.hs:(34,15)-(35,62)
`s' is a rigid type variable bound by
the type signature for
itrapstate :: Constructed b =>
@@ -86,7 +86,7 @@ tcfail068.hs:36:46:
-> c
-> IndTree s b
-> (c, IndTree s b)
- at tcfail068.hs:36:1
+ at tcfail068.hs:35:40
`s1' is a rigid type variable bound by
a type expected by the context: GHC.ST.ST s1 (c, IndTree s b)
at tcfail068.hs:36:40
diff --git a/testsuite/tests/typecheck/should_fail/tcfail072.stderr b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
index 4d6bd867b2..052083f237 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail072.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail072.stderr
@@ -4,7 +4,7 @@ tcfail072.hs:23:13:
from the context (Ord p, Ord q)
bound by the type signature for
g :: (Ord p, Ord q) => AB p q -> Bool
- at tcfail072.hs:23:1-15
+ at tcfail072.hs:22:6-38
The type variables `p0', `q0' are ambiguous
Possible fix: add a type signature that fixes these type variable(s)
In the expression: g A
diff --git a/testsuite/tests/typecheck/should_fail/tcfail097.stderr b/testsuite/tests/typecheck/should_fail/tcfail097.stderr
index 967b172bb9..2fabae4b40 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail097.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail097.stderr
@@ -1,6 +1,6 @@
-
-tcfail097.hs:5:1:
- Ambiguous constraint `Eq a'
- At least one of the forall'd type variables mentioned by the constraint
- must be reachable from the type after the '=>'
- In the type signature for `f': f :: Eq a => Int -> Int
+
+tcfail097.hs:5:6:
+ Ambiguous constraint `Eq a'
+ At least one of the forall'd type variables mentioned by the constraint
+ must be reachable from the type after the '=>'
+ In the type signature for `f': f :: Eq a => Int -> Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail101.stderr b/testsuite/tests/typecheck/should_fail/tcfail101.stderr
index 0d82b50750..5cca6de0a3 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail101.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail101.stderr
@@ -1,4 +1,4 @@
-tcfail101.hs:9:1:
+tcfail101.hs:9:6:
Type synonym `A' should have 1 argument, but has been given none
In the type signature for `f': f :: T A
diff --git a/testsuite/tests/typecheck/should_fail/tcfail102.stderr b/testsuite/tests/typecheck/should_fail/tcfail102.stderr
index 792c941081..541bb432fa 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail102.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail102.stderr
@@ -1,18 +1,18 @@
-
-tcfail102.hs:1:14:
- Warning: -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
-
-tcfail102.hs:9:15:
- Could not deduce (Integral (Ratio a)) arising from a use of `p'
- from the context (Integral a)
- bound by the type signature for
- f :: Integral a => P (Ratio a) -> P (Ratio a)
- at tcfail102.hs:9:1-19
- Possible fix:
- add (Integral (Ratio a)) to the context of
- the type signature for
- f :: Integral a => P (Ratio a) -> P (Ratio a)
- or add an instance declaration for (Integral (Ratio a))
- In the `p' field of a record
- In the expression: x {p = p x}
- In an equation for `f': f x = x {p = p x}
+
+tcfail102.hs:1:14: Warning:
+ -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
+
+tcfail102.hs:9:15:
+ Could not deduce (Integral (Ratio a)) arising from a use of `p'
+ from the context (Integral a)
+ bound by the type signature for
+ f :: Integral a => P (Ratio a) -> P (Ratio a)
+ at tcfail102.hs:8:6-45
+ Possible fix:
+ add (Integral (Ratio a)) to the context of
+ the type signature for
+ f :: Integral a => P (Ratio a) -> P (Ratio a)
+ or add an instance declaration for (Integral (Ratio a))
+ In the `p' field of a record
+ In the expression: x {p = p x}
+ In an equation for `f': f x = x {p = p x}
diff --git a/testsuite/tests/typecheck/should_fail/tcfail103.stderr b/testsuite/tests/typecheck/should_fail/tcfail103.stderr
index 7d6e4dfd6c..5a9b1839f6 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail103.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail103.stderr
@@ -2,9 +2,9 @@
tcfail103.hs:15:23:
Couldn't match type `t' with `s'
`t' is a rigid type variable bound by
- the type signature for f :: ST t Int at tcfail103.hs:11:1
+ the type signature for f :: ST t Int at tcfail103.hs:10:8
`s' is a rigid type variable bound by
- the type signature for g :: ST s Int at tcfail103.hs:15:9
+ the type signature for g :: ST s Int at tcfail103.hs:13:17
Expected type: STRef s Int
Actual type: STRef t Int
In the first argument of `readSTRef', namely `v'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail107.stderr b/testsuite/tests/typecheck/should_fail/tcfail107.stderr
index eae3610c1d..92a89b7544 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail107.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail107.stderr
@@ -1,5 +1,5 @@
-tcfail107.hs:13:1:
+tcfail107.hs:13:9:
Type synonym `Const' should have 2 arguments, but has been given 1
In the type signature for `test':
test :: Thing (Const Int) -> Thing (Const Int)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail127.stderr b/testsuite/tests/typecheck/should_fail/tcfail127.stderr
index 8fa64fb204..021120314f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail127.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail127.stderr
@@ -1,5 +1,5 @@
-
-tcfail127.hs:3:1:
- Illegal polymorphic or qualified type: Num a => a -> a
- Perhaps you intended to use -XImpredicativeTypes
- In the type signature for `foo': foo :: IO (Num a => a -> a)
+
+tcfail127.hs:3:8:
+ Illegal polymorphic or qualified type: Num a => a -> a
+ Perhaps you intended to use -XImpredicativeTypes
+ In the type signature for `foo': foo :: IO (Num a => a -> a)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail129.stderr b/testsuite/tests/typecheck/should_fail/tcfail129.stderr
index f9ee8a567d..f6ee765ce4 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail129.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail129.stderr
@@ -1,11 +1,11 @@
-tcfail129.hs:12:8:
+tcfail129.hs:12:21:
Type synonym `Foo' should have 1 argument, but has been given none
In an expression type signature: Bar Foo
In the expression: undefined :: Bar Foo
In an equation for `blah': blah = undefined :: Bar Foo
-tcfail129.hs:17:9:
+tcfail129.hs:17:22:
Type synonym `Foo1' should have 1 argument, but has been given none
In an expression type signature: Bar1 Foo1
In the expression: undefined :: Bar1 Foo1
diff --git a/testsuite/tests/typecheck/should_fail/tcfail131.stderr b/testsuite/tests/typecheck/should_fail/tcfail131.stderr
index 548e063929..9c93a0f916 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail131.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail131.stderr
@@ -1,11 +1,11 @@
-
-tcfail131.hs:7:9:
- Could not deduce (b ~ Integer)
- from the context (Num b)
- bound by the type signature for g :: Num b => b -> b
- at tcfail131.hs:7:3-13
- `b' is a rigid type variable bound by
- the type signature for g :: Num b => b -> b at tcfail131.hs:7:3
- In the return type of a call of `f'
- In the expression: f x x
- In an equation for `g': g x = f x x
+
+tcfail131.hs:7:9:
+ Could not deduce (b ~ Integer)
+ from the context (Num b)
+ bound by the type signature for g :: Num b => b -> b
+ at tcfail131.hs:6:8-22
+ `b' is a rigid type variable bound by
+ the type signature for g :: Num b => b -> b at tcfail131.hs:6:12
+ In the return type of a call of `f'
+ In the expression: f x x
+ In an equation for `g': g x = f x x
diff --git a/testsuite/tests/typecheck/should_fail/tcfail153.stderr b/testsuite/tests/typecheck/should_fail/tcfail153.stderr
index ca0b42b054..e648dc556d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail153.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail153.stderr
@@ -2,7 +2,7 @@
tcfail153.hs:6:9:
Couldn't match expected type `a' with actual type `Bool'
`a' is a rigid type variable bound by
- the type signature for f :: a -> [a] at tcfail153.hs:6:1
+ the type signature for f :: a -> [a] at tcfail153.hs:5:6
In the first argument of `g', namely `x'
In the expression: g x
In an equation for `f':
diff --git a/testsuite/tests/typecheck/should_fail/tcfail162.stderr b/testsuite/tests/typecheck/should_fail/tcfail162.stderr
index 53f0129f48..d1bb892ab0 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail162.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail162.stderr
@@ -1,6 +1,6 @@
tcfail162.hs:10:33:
Expecting one more argument to `ForeignPtr'
- In the type `{-# UNPACK #-} !ForeignPtr'
+ In the type `ForeignPtr'
In the definition of data constructor `Foo'
In the data type declaration for `Foo'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
index 89135d656e..52a627ad9f 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
@@ -23,7 +23,7 @@ tcfail174.hs:16:14:
`a' is a rigid type variable bound by
the type forall a. a -> a at tcfail174.hs:16:14
`b' is a rigid type variable bound by
- the type signature for h2 :: Capture b at tcfail174.hs:16:1
+ the type signature for h2 :: Capture b at tcfail174.hs:15:15
Expected type: Capture (forall x. x -> b)
Actual type: Capture (forall a. a -> a)
In the first argument of `Capture', namely `g'
diff --git a/testsuite/tests/typecheck/should_fail/tcfail175.stderr b/testsuite/tests/typecheck/should_fail/tcfail175.stderr
index 4fe5bfbe41..ded6ea65eb 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail175.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail175.stderr
@@ -3,6 +3,6 @@ tcfail175.hs:11:1:
Couldn't match expected type `a'
with actual type `String -> String -> String'
`a' is a rigid type variable bound by
- the type signature for evalRHS :: Int -> a at tcfail175.hs:11:1
+ the type signature for evalRHS :: Int -> a at tcfail175.hs:10:19
The equation(s) for `evalRHS' have three arguments,
but its type `Int -> a' has only one
diff --git a/testsuite/tests/typecheck/should_fail/tcfail179.stderr b/testsuite/tests/typecheck/should_fail/tcfail179.stderr
index a24d404e15..7a29705723 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail179.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail179.stderr
@@ -2,7 +2,7 @@
tcfail179.hs:14:39:
Couldn't match expected type `s' with actual type `x'
`s' is a rigid type variable bound by
- the type signature for run :: T s -> Int at tcfail179.hs:13:1
+ the type signature for run :: T s -> Int at tcfail179.hs:12:10
`x' is a rigid type variable bound by
a pattern with constructor
T :: forall s x. (s -> (x -> s) -> (x, s, Int)) -> T s,
diff --git a/testsuite/tests/typecheck/should_fail/tcfail196.stderr b/testsuite/tests/typecheck/should_fail/tcfail196.stderr
index 79cc7266eb..ea6f16fd98 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail196.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail196.stderr
@@ -1,5 +1,5 @@
-
-tcfail196.hs:5:1:
- Illegal polymorphic or qualified type: forall a. a
- In the type signature for `bar':
- bar :: Num (forall a. a) => Int -> Int
+
+tcfail196.hs:5:8:
+ Illegal polymorphic or qualified type: forall a. a
+ In the type signature for `bar':
+ bar :: Num (forall a. a) => Int -> Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail197.stderr b/testsuite/tests/typecheck/should_fail/tcfail197.stderr
index 3abe57be7b..464dacb078 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail197.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail197.stderr
@@ -1,6 +1,5 @@
-tcfail197.hs:5:1:
+tcfail197.hs:5:8:
Illegal polymorphic or qualified type: forall a. a
Perhaps you intended to use -XImpredicativeTypes
- In the type signature for `foo':
- foo :: [forall a. a] -> Int
+ In the type signature for `foo': foo :: [forall a. a] -> Int
diff --git a/testsuite/tests/typecheck/should_fail/tcfail201.stderr b/testsuite/tests/typecheck/should_fail/tcfail201.stderr
index f45b899b90..0cb16557f8 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail201.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail201.stderr
@@ -5,7 +5,7 @@ tcfail201.hs:18:28:
the type signature for
gfoldl' :: (forall a1 b. c (a1 -> b) -> a1 -> c b)
-> (forall g. g -> c g) -> a -> c a
- at tcfail201.hs:16:1
+ at tcfail201.hs:15:78
In the pattern: DocParagraph hsDoc
In a case alternative:
(DocParagraph hsDoc) -> z DocParagraph `k` hsDoc
diff --git a/testsuite/tests/typecheck/should_fail/tcfail206.stderr b/testsuite/tests/typecheck/should_fail/tcfail206.stderr
index 76b5c7ebd2..3283089afc 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail206.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail206.stderr
@@ -16,7 +16,7 @@ tcfail206.hs:8:5:
tcfail206.hs:11:5:
Couldn't match type `a' with `Bool'
`a' is a rigid type variable bound by
- the type signature for c :: a -> (a, Bool) at tcfail206.hs:11:1
+ the type signature for c :: a -> (a, Bool) at tcfail206.hs:10:6
Expected type: a -> (a, Bool)
Actual type: a -> (a, a)
In the expression: (True || False,)
@@ -40,7 +40,7 @@ tcfail206.hs:17:5:
tcfail206.hs:20:5:
Couldn't match type `a' with `Bool'
`a' is a rigid type variable bound by
- the type signature for f :: a -> (# a, Bool #) at tcfail206.hs:20:1
+ the type signature for f :: a -> (# a, Bool #) at tcfail206.hs:19:6
Expected type: a -> (# a, Bool #)
Actual type: a -> (# a, a #)
In the expression: (# True || False, #)
diff --git a/testsuite/tests/typecheck/should_fail/tcfail208.stderr b/testsuite/tests/typecheck/should_fail/tcfail208.stderr
index 64200a696d..0a4ce1cd4d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail208.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail208.stderr
@@ -4,7 +4,7 @@ tcfail208.hs:4:19:
from the context (Monad m, Eq a)
bound by the type signature for
f :: (Monad m, Eq a) => a -> m a -> Bool
- at tcfail208.hs:4:1-23
+ at tcfail208.hs:3:6-40
Possible fix:
add (Eq (m a)) to the context of
the type signature for f :: (Monad m, Eq a) => a -> m a -> Bool
diff --git a/testsuite/tests/typecheck/should_fail/tcfail209.stderr b/testsuite/tests/typecheck/should_fail/tcfail209.stderr
index ba90b2d163..b5329ff6dc 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail209.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail209.stderr
@@ -1,10 +1,10 @@
-tcfail209.hs:5:1:
+tcfail209.hs:5:6:
Illegal irreducible constraint Showish a
(Use -XConstraintKinds to permit this)
In the type signature for `f': f :: Showish a => a -> a
-tcfail209.hs:8:1:
+tcfail209.hs:8:6:
Illegal tuple constraint (Show a, Num a)
(Use -XConstraintKinds to permit this)
In the type signature for `g':
diff --git a/testsuite/tests/typecheck/should_run/tcrun041.hs b/testsuite/tests/typecheck/should_run/tcrun041.hs
index dbdebf7687..6342fcd0e2 100644
--- a/testsuite/tests/typecheck/should_run/tcrun041.hs
+++ b/testsuite/tests/typecheck/should_run/tcrun041.hs
@@ -25,7 +25,6 @@ h = (# ,1, #)
unchanged :: a -> (# Int #)
unchanged _binding = (# 1 #)
-
main = do
print (a 1, b False, c "Hello", c 1337, d "Yeah" "Baby")
case e 1 of { (# x1, x2 #) ->