diff options
Diffstat (limited to 'testsuite/tests')
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 #) -> |