summaryrefslogtreecommitdiff
path: root/testsuite/tests/array
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/array')
-rw-r--r--testsuite/tests/array/Makefile3
-rw-r--r--testsuite/tests/array/should_run/Makefile3
-rw-r--r--testsuite/tests/array/should_run/all.T25
-rw-r--r--testsuite/tests/array/should_run/arr001.hs9
-rw-r--r--testsuite/tests/array/should_run/arr001.stdout1
-rw-r--r--testsuite/tests/array/should_run/arr002.hs23
-rw-r--r--testsuite/tests/array/should_run/arr002.stdout3
-rw-r--r--testsuite/tests/array/should_run/arr003.hs16
-rw-r--r--testsuite/tests/array/should_run/arr003.stderr1
-rw-r--r--testsuite/tests/array/should_run/arr003.stderr-hugs1
-rw-r--r--testsuite/tests/array/should_run/arr004.hs15
-rw-r--r--testsuite/tests/array/should_run/arr004.stderr1
-rw-r--r--testsuite/tests/array/should_run/arr004.stderr-hugs1
-rw-r--r--testsuite/tests/array/should_run/arr005.hs16
-rw-r--r--testsuite/tests/array/should_run/arr005.stdout1
-rw-r--r--testsuite/tests/array/should_run/arr006.hs11
-rw-r--r--testsuite/tests/array/should_run/arr006.stdout1
-rw-r--r--testsuite/tests/array/should_run/arr007.hs11
-rw-r--r--testsuite/tests/array/should_run/arr007.stderr1
-rw-r--r--testsuite/tests/array/should_run/arr007.stderr-hugs1
-rw-r--r--testsuite/tests/array/should_run/arr008.hs14
-rw-r--r--testsuite/tests/array/should_run/arr008.stderr1
-rw-r--r--testsuite/tests/array/should_run/arr008.stderr-hugs1
-rw-r--r--testsuite/tests/array/should_run/arr008.stdout1
-rw-r--r--testsuite/tests/array/should_run/arr008.stdout-hugs2
-rw-r--r--testsuite/tests/array/should_run/arr009.hs17
-rw-r--r--testsuite/tests/array/should_run/arr009.stdout2
-rw-r--r--testsuite/tests/array/should_run/arr010.hs18
-rw-r--r--testsuite/tests/array/should_run/arr010.stdout1
-rw-r--r--testsuite/tests/array/should_run/arr011.hs20
-rw-r--r--testsuite/tests/array/should_run/arr011.stdout2
-rw-r--r--testsuite/tests/array/should_run/arr012.hs19
-rw-r--r--testsuite/tests/array/should_run/arr012.stdout3
-rw-r--r--testsuite/tests/array/should_run/arr013.hs17
-rw-r--r--testsuite/tests/array/should_run/arr013.stdout1
-rw-r--r--testsuite/tests/array/should_run/arr014.hs26
-rw-r--r--testsuite/tests/array/should_run/arr014.stdout0
-rw-r--r--testsuite/tests/array/should_run/arr015.hs50
-rw-r--r--testsuite/tests/array/should_run/arr015.stdout5
-rw-r--r--testsuite/tests/array/should_run/arr016.hs511
-rw-r--r--testsuite/tests/array/should_run/arr016.stdout8
-rw-r--r--testsuite/tests/array/should_run/arr017.hs30
-rw-r--r--testsuite/tests/array/should_run/arr017.stdout1
-rw-r--r--testsuite/tests/array/should_run/arr018.hs16
-rw-r--r--testsuite/tests/array/should_run/arr018.stdout2
-rw-r--r--testsuite/tests/array/should_run/arr019.hs27
-rw-r--r--testsuite/tests/array/should_run/arr019.stdout14
47 files changed, 953 insertions, 0 deletions
diff --git a/testsuite/tests/array/Makefile b/testsuite/tests/array/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/array/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/array/should_run/Makefile b/testsuite/tests/array/should_run/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/array/should_run/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/array/should_run/all.T b/testsuite/tests/array/should_run/all.T
new file mode 100644
index 0000000000..8b1ab2dd4d
--- /dev/null
+++ b/testsuite/tests/array/should_run/all.T
@@ -0,0 +1,25 @@
+
+# Args to compile_and_run are:
+# extra compile flags
+# extra run flags
+# expected process return value, if not zero
+
+test('arr001', skip_if_fast, compile_and_run, [''])
+test('arr002', skip_if_fast, compile_and_run, [''])
+test('arr003', compose(skip_if_fast,exit_code(1)), compile_and_run, [''])
+test('arr004', compose(skip_if_fast,exit_code(1)), compile_and_run, [''])
+test('arr005', skip_if_fast, compile_and_run, [''])
+test('arr006', skip_if_fast, compile_and_run, [''])
+test('arr007', compose(skip_if_fast,exit_code(1)), compile_and_run, [''])
+test('arr008', compose(skip_if_fast,exit_code(1)), compile_and_run, [''])
+test('arr009', skip_if_fast, compile_and_run, [''])
+test('arr010', skip_if_fast, compile_and_run, [''])
+test('arr011', skip_if_fast, compile_and_run, [''])
+test('arr012', skip_if_fast, compile_and_run, [''])
+test('arr013', skip_if_fast, compile_and_run, [''])
+test('arr014', skip_if_fast, compile_and_run, [''])
+test('arr015', skip_if_fast, compile_and_run, [''])
+test('arr016', reqlib('random'), compile_and_run, [''])
+test('arr017', skip_if_fast, compile_and_run, [''])
+test('arr018', skip_if_fast, compile_and_run, [''])
+test('arr019', normal, compile_and_run, [''])
diff --git a/testsuite/tests/array/should_run/arr001.hs b/testsuite/tests/array/should_run/arr001.hs
new file mode 100644
index 0000000000..325ce1bc09
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr001.hs
@@ -0,0 +1,9 @@
+-- !!! Simple array creation
+
+import Data.Array
+
+main =
+ let a1 = array (1,3) (zip [2,3,1] ['a'..'d']) in
+ print a1
+
+-- Result:
diff --git a/testsuite/tests/array/should_run/arr001.stdout b/testsuite/tests/array/should_run/arr001.stdout
new file mode 100644
index 0000000000..5d4420352e
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr001.stdout
@@ -0,0 +1 @@
+array (1,3) [(1,'c'),(2,'a'),(3,'b')]
diff --git a/testsuite/tests/array/should_run/arr002.hs b/testsuite/tests/array/should_run/arr002.hs
new file mode 100644
index 0000000000..a26a60281c
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr002.hs
@@ -0,0 +1,23 @@
+-- !!! Array creation, (index,value) list with duplicates.
+--
+-- Haskell library report 1.3 (and earlier) specifies
+-- that `array' values created with lists containing dups,
+-- are undefined ( _|_ ).
+--
+-- GHC-2.02 (and earlier) does not flag this as such, the
+-- last (index,value) is instead used.
+--
+-- The report also specifies `array' is spine strict in
+-- the (index,value) list argument and to check the
+-- validity of the index values upon creation, it also
+-- strict for the indices. To test this, we do (a!1)
+-- twice, expecting to see the same value..
+--
+import Data.Array
+
+main =
+ let a1 = array (1,3) (zip (1:[1..3]) ['a'..'d']) in
+ print (a1!1) >>
+ print a1 >>
+ print (a1!1)
+
diff --git a/testsuite/tests/array/should_run/arr002.stdout b/testsuite/tests/array/should_run/arr002.stdout
new file mode 100644
index 0000000000..ca55f16bbc
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr002.stdout
@@ -0,0 +1,3 @@
+'b'
+array (1,3) [(1,'b'),(2,'c'),(3,'d')]
+'b'
diff --git a/testsuite/tests/array/should_run/arr003.hs b/testsuite/tests/array/should_run/arr003.hs
new file mode 100644
index 0000000000..8f156ab6d9
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr003.hs
@@ -0,0 +1,16 @@
+-- !!! Array creation, (index,value) list with out of bound index.
+--
+-- Haskell library report 1.3 (and earlier) specifies
+-- that `array' values created with lists containing out-of-bounds indices,
+-- are undefined ( _|_ ).
+--
+-- GHC implementation of `array' catches this (or, rather,
+-- `index' does) - the argument list to `array' is defined
+-- to have its spine be evaluated - so the indexing below
+-- should cause a failure.
+--
+import Data.Array
+
+main =
+ let a1 = array (1::Int,3) (zip ([1..4]) ['a'..'d']) in
+ print (a1!2)
diff --git a/testsuite/tests/array/should_run/arr003.stderr b/testsuite/tests/array/should_run/arr003.stderr
new file mode 100644
index 0000000000..8f3945286b
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr003.stderr
@@ -0,0 +1 @@
+arr003: Ix{Int}.index: Index (4) out of range ((1,3))
diff --git a/testsuite/tests/array/should_run/arr003.stderr-hugs b/testsuite/tests/array/should_run/arr003.stderr-hugs
new file mode 100644
index 0000000000..0f838fa8cd
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr003.stderr-hugs
@@ -0,0 +1 @@
+arr003: Ix.index: index out of range
diff --git a/testsuite/tests/array/should_run/arr004.hs b/testsuite/tests/array/should_run/arr004.hs
new file mode 100644
index 0000000000..0d7e5b445f
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr004.hs
@@ -0,0 +1,15 @@
+-- !!! Array - accessing undefined element
+--
+-- Sample Haskell implementation in the 1.3 Lib report defines
+-- this as being undefined/error.
+
+import Data.Array
+
+main =
+ let a1 = array (1,3) (zip ([1,2]) ['a'..'d']) in
+ print (a1!3)
+
+-- output: Fail: (Array.!): undefined array element
+
+
+
diff --git a/testsuite/tests/array/should_run/arr004.stderr b/testsuite/tests/array/should_run/arr004.stderr
new file mode 100644
index 0000000000..b69cbf5b62
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr004.stderr
@@ -0,0 +1 @@
+arr004: (Array.!): undefined array element
diff --git a/testsuite/tests/array/should_run/arr004.stderr-hugs b/testsuite/tests/array/should_run/arr004.stderr-hugs
new file mode 100644
index 0000000000..2d1decd612
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr004.stderr-hugs
@@ -0,0 +1 @@
+arr004: undefined array element
diff --git a/testsuite/tests/array/should_run/arr005.hs b/testsuite/tests/array/should_run/arr005.hs
new file mode 100644
index 0000000000..274f8bb1c1
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr005.hs
@@ -0,0 +1,16 @@
+-- !!! Array - recurrences
+--
+-- array does not evaluate the elements.
+--
+import Data.Array
+
+main =
+ let
+ a1 = array (1,100) ((1,1::Integer):[(i,i*a1!(i-1))|i<-[2..100]])
+ in
+ print a1
+
+--
+
+
+
diff --git a/testsuite/tests/array/should_run/arr005.stdout b/testsuite/tests/array/should_run/arr005.stdout
new file mode 100644
index 0000000000..5048dd0479
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr005.stdout
@@ -0,0 +1 @@
+array (1,100) [(1,1),(2,2),(3,6),(4,24),(5,120),(6,720),(7,5040),(8,40320),(9,362880),(10,3628800),(11,39916800),(12,479001600),(13,6227020800),(14,87178291200),(15,1307674368000),(16,20922789888000),(17,355687428096000),(18,6402373705728000),(19,121645100408832000),(20,2432902008176640000),(21,51090942171709440000),(22,1124000727777607680000),(23,25852016738884976640000),(24,620448401733239439360000),(25,15511210043330985984000000),(26,403291461126605635584000000),(27,10888869450418352160768000000),(28,304888344611713860501504000000),(29,8841761993739701954543616000000),(30,265252859812191058636308480000000),(31,8222838654177922817725562880000000),(32,263130836933693530167218012160000000),(33,8683317618811886495518194401280000000),(34,295232799039604140847618609643520000000),(35,10333147966386144929666651337523200000000),(36,371993326789901217467999448150835200000000),(37,13763753091226345046315979581580902400000000),(38,523022617466601111760007224100074291200000000),(39,20397882081197443358640281739902897356800000000),(40,815915283247897734345611269596115894272000000000),(41,33452526613163807108170062053440751665152000000000),(42,1405006117752879898543142606244511569936384000000000),(43,60415263063373835637355132068513997507264512000000000),(44,2658271574788448768043625811014615890319638528000000000),(45,119622220865480194561963161495657715064383733760000000000),(46,5502622159812088949850305428800254892961651752960000000000),(47,258623241511168180642964355153611979969197632389120000000000),(48,12413915592536072670862289047373375038521486354677760000000000),(49,608281864034267560872252163321295376887552831379210240000000000),(50,30414093201713378043612608166064768844377641568960512000000000000),(51,1551118753287382280224243016469303211063259720016986112000000000000),(52,80658175170943878571660636856403766975289505440883277824000000000000),(53,4274883284060025564298013753389399649690343788366813724672000000000000),(54,230843697339241380472092742683027581083278564571807941132288000000000000),(55,12696403353658275925965100847566516959580321051449436762275840000000000000),(56,710998587804863451854045647463724949736497978881168458687447040000000000000),(57,40526919504877216755680601905432322134980384796226602145184481280000000000000),(58,2350561331282878571829474910515074683828862318181142924420699914240000000000000),(59,138683118545689835737939019720389406345902876772687432540821294940160000000000000),(60,8320987112741390144276341183223364380754172606361245952449277696409600000000000000),(61,507580213877224798800856812176625227226004528988036003099405939480985600000000000000),(62,31469973260387937525653122354950764088012280797258232192163168247821107200000000000000),(63,1982608315404440064116146708361898137544773690227268628106279599612729753600000000000000),(64,126886932185884164103433389335161480802865516174545192198801894375214704230400000000000000),(65,8247650592082470666723170306785496252186258551345437492922123134388955774976000000000000000),(66,544344939077443064003729240247842752644293064388798874532860126869671081148416000000000000000),(67,36471110918188685288249859096605464427167635314049524593701628500267962436943872000000000000000),(68,2480035542436830599600990418569171581047399201355367672371710738018221445712183296000000000000000),(69,171122452428141311372468338881272839092270544893520369393648040923257279754140647424000000000000000),(70,11978571669969891796072783721689098736458938142546425857555362864628009582789845319680000000000000000),(71,850478588567862317521167644239926010288584608120796235886430763388588680378079017697280000000000000000),(72,61234458376886086861524070385274672740778091784697328983823014963978384987221689274204160000000000000000),(73,4470115461512684340891257138125051110076800700282905015819080092370422104067183317016903680000000000000000),(74,330788544151938641225953028221253782145683251820934971170611926835411235700971565459250872320000000000000000),(75,24809140811395398091946477116594033660926243886570122837795894512655842677572867409443815424000000000000000000),(76,1885494701666050254987932260861146558230394535379329335672487982961844043495537923117729972224000000000000000000),(77,145183092028285869634070784086308284983740379224208358846781574688061991349156420080065207861248000000000000000000),(78,11324281178206297831457521158732046228731749579488251990048962825668835325234200766245086213177344000000000000000000),(79,894618213078297528685144171539831652069808216779571907213868063227837990693501860533361810841010176000000000000000000),(80,71569457046263802294811533723186532165584657342365752577109445058227039255480148842668944867280814080000000000000000000),(81,5797126020747367985879734231578109105412357244731625958745865049716390179693892056256184534249745940480000000000000000000),(82,475364333701284174842138206989404946643813294067993328617160934076743994734899148613007131808479167119360000000000000000000),(83,39455239697206586511897471180120610571436503407643446275224357528369751562996629334879591940103770870906880000000000000000000),(84,3314240134565353266999387579130131288000666286242049487118846032383059131291716864129885722968716753156177920000000000000000000),(85,281710411438055027694947944226061159480056634330574206405101912752560026159795933451040286452340924018275123200000000000000000000),(86,24227095383672732381765523203441259715284870552429381750838764496720162249742450276789464634901319465571660595200000000000000000000),(87,2107757298379527717213600518699389595229783738061356212322972511214654115727593174080683423236414793504734471782400000000000000000000),(88,185482642257398439114796845645546284380220968949399346684421580986889562184028199319100141244804501828416633516851200000000000000000000),(89,16507955160908461081216919262453619309839666236496541854913520707833171034378509739399912570787600662729080382999756800000000000000000000),(90,1485715964481761497309522733620825737885569961284688766942216863704985393094065876545992131370884059645617234469978112000000000000000000000),(91,135200152767840296255166568759495142147586866476906677791741734597153670771559994765685283954750449427751168336768008192000000000000000000000),(92,12438414054641307255475324325873553077577991715875414356840239582938137710983519518443046123837041347353107486982656753664000000000000000000000),(93,1156772507081641574759205162306240436214753229576413535186142281213246807121467315215203289516844845303838996289387078090752000000000000000000000),(94,108736615665674308027365285256786601004186803580182872307497374434045199869417927630229109214583415458560865651202385340530688000000000000000000000),(95,10329978488239059262599702099394727095397746340117372869212250571234293987594703124871765375385424468563282236864226607350415360000000000000000000000),(96,991677934870949689209571401541893801158183648651267795444376054838492222809091499987689476037000748982075094738965754305639874560000000000000000000000),(97,96192759682482119853328425949563698712343813919172976158104477319333745612481875498805879175589072651261284189679678167647067832320000000000000000000000),(98,9426890448883247745626185743057242473809693764078951663494238777294707070023223798882976159207729119823605850588608460429412647567360000000000000000000000),(99,933262154439441526816992388562667004907159682643816214685929638952175999932299156089414639761565182862536979208272237582511852109168640000000000000000000000),(100,93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000)]
diff --git a/testsuite/tests/array/should_run/arr006.hs b/testsuite/tests/array/should_run/arr006.hs
new file mode 100644
index 0000000000..52d21c6f3d
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr006.hs
@@ -0,0 +1,11 @@
+-- !!! Array - empty arrays
+--
+-- print a couple of them to try to expose empty arrays
+-- to a GC or two.
+import Data.Array
+
+main =
+ let
+ a1 = array (1,0) []
+ in
+ print (take 300 $ repeat (a1 :: Array Int Int))
diff --git a/testsuite/tests/array/should_run/arr006.stdout b/testsuite/tests/array/should_run/arr006.stdout
new file mode 100644
index 0000000000..289deeec07
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr006.stdout
@@ -0,0 +1 @@
+[array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) [],array (1,0) []]
diff --git a/testsuite/tests/array/should_run/arr007.hs b/testsuite/tests/array/should_run/arr007.hs
new file mode 100644
index 0000000000..d4461d8d5e
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr007.hs
@@ -0,0 +1,11 @@
+-- !!! Array - accessing empty arrays
+--
+-- empty arrays are legal, but indexing them is undefined!
+--
+import Data.Array
+
+main =
+ let
+ a1 = array (1::Int,0) [(1,'a')]
+ in
+ print (a1!0)
diff --git a/testsuite/tests/array/should_run/arr007.stderr b/testsuite/tests/array/should_run/arr007.stderr
new file mode 100644
index 0000000000..feaa5d8363
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr007.stderr
@@ -0,0 +1 @@
+arr007: Ix{Int}.index: Index (1) out of range ((1,0))
diff --git a/testsuite/tests/array/should_run/arr007.stderr-hugs b/testsuite/tests/array/should_run/arr007.stderr-hugs
new file mode 100644
index 0000000000..aa4c83b32e
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr007.stderr-hugs
@@ -0,0 +1 @@
+arr007: Ix.index: index out of range
diff --git a/testsuite/tests/array/should_run/arr008.hs b/testsuite/tests/array/should_run/arr008.hs
new file mode 100644
index 0000000000..14152c5a9d
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr008.hs
@@ -0,0 +1,14 @@
+-- !!! Array - out-of-range (index,value) pairs
+--
+-- supplying a list containing one or more pairs
+-- with out-of-range index is undefined.
+--
+--
+import Data.Array
+
+main =
+ let
+ a1 = array (1::Int,0) []
+ a2 = array (0::Int,1) (zip [0..] ['a'..'z'])
+ in
+ print (a1::Array Int Int) >> print a2
diff --git a/testsuite/tests/array/should_run/arr008.stderr b/testsuite/tests/array/should_run/arr008.stderr
new file mode 100644
index 0000000000..f926f7288c
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr008.stderr
@@ -0,0 +1 @@
+arr008: Ix{Int}.index: Index (2) out of range ((0,1))
diff --git a/testsuite/tests/array/should_run/arr008.stderr-hugs b/testsuite/tests/array/should_run/arr008.stderr-hugs
new file mode 100644
index 0000000000..4de58dad3b
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr008.stderr-hugs
@@ -0,0 +1 @@
+arr008: Ix.index: index out of range
diff --git a/testsuite/tests/array/should_run/arr008.stdout b/testsuite/tests/array/should_run/arr008.stdout
new file mode 100644
index 0000000000..825444d25b
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr008.stdout
@@ -0,0 +1 @@
+array (1,0) []
diff --git a/testsuite/tests/array/should_run/arr008.stdout-hugs b/testsuite/tests/array/should_run/arr008.stdout-hugs
new file mode 100644
index 0000000000..bbad9774f5
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr008.stdout-hugs
@@ -0,0 +1,2 @@
+array (1,0) []
+array \ No newline at end of file
diff --git a/testsuite/tests/array/should_run/arr009.hs b/testsuite/tests/array/should_run/arr009.hs
new file mode 100644
index 0000000000..290147d0a0
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr009.hs
@@ -0,0 +1,17 @@
+-- !!! Array - derived ops
+--
+-- testing the well-behavedness of
+-- derived ops for empty and non-empty arrays
+--
+import Data.Array
+
+main =
+ let
+ a1 = array (1,0) ([]::[(Int,Int)])
+ a2 = array (1,26) (zip [1..] ['a'..'z'])
+
+ dump a = (bounds a, indices a, elems a, assocs a)
+ in
+ print (dump a1) >>
+ print (dump a2)
+
diff --git a/testsuite/tests/array/should_run/arr009.stdout b/testsuite/tests/array/should_run/arr009.stdout
new file mode 100644
index 0000000000..5816fd7906
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr009.stdout
@@ -0,0 +1,2 @@
+((1,0),[],[],[])
+((1,26),[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26],"abcdefghijklmnopqrstuvwxyz",[(1,'a'),(2,'b'),(3,'c'),(4,'d'),(5,'e'),(6,'f'),(7,'g'),(8,'h'),(9,'i'),(10,'j'),(11,'k'),(12,'l'),(13,'m'),(14,'n'),(15,'o'),(16,'p'),(17,'q'),(18,'r'),(19,'s'),(20,'t'),(21,'u'),(22,'v'),(23,'w'),(24,'x'),(25,'y'),(26,'z')])
diff --git a/testsuite/tests/array/should_run/arr010.hs b/testsuite/tests/array/should_run/arr010.hs
new file mode 100644
index 0000000000..d5b7f38c1c
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr010.hs
@@ -0,0 +1,18 @@
+-- !!! Array - accumulated arrays
+--
+--
+module Main(main) where
+
+import Data.Array
+import Data.Ix
+
+hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
+hist bnds is = accumArray (+) 0 bnds [(i,1) | i <- is , inRange bnds i]
+
+main =
+ let
+ a1 = hist (0,10) (concat $ take 2 $ repeat [1..20])
+ in
+ print a1
+
+
diff --git a/testsuite/tests/array/should_run/arr010.stdout b/testsuite/tests/array/should_run/arr010.stdout
new file mode 100644
index 0000000000..cc8297ea19
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr010.stdout
@@ -0,0 +1 @@
+array (0,10) [(0,0),(1,2),(2,2),(3,2),(4,2),(5,2),(6,2),(7,2),(8,2),(9,2),(10,2)]
diff --git a/testsuite/tests/array/should_run/arr011.hs b/testsuite/tests/array/should_run/arr011.hs
new file mode 100644
index 0000000000..1516b0e866
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr011.hs
@@ -0,0 +1,20 @@
+-- !!! Array - array difference operator
+--
+--
+module Main(main) where
+
+import Data.Array
+import Data.Ix
+
+hist :: (Ix a, Num b) => (a,a) -> [a] -> Array a b
+hist bnds is = accumArray (+) 0 bnds [(i,1) | i <- is , inRange bnds i]
+
+main =
+ let
+ a1 = hist (0,10) (concat $ take 2 $ repeat [1..20])
+ in
+ print a1 >>
+ print (a1 // [ (i,0) | i<-[0..10], odd i])
+
+
+
diff --git a/testsuite/tests/array/should_run/arr011.stdout b/testsuite/tests/array/should_run/arr011.stdout
new file mode 100644
index 0000000000..9491d9c780
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr011.stdout
@@ -0,0 +1,2 @@
+array (0,10) [(0,0),(1,2),(2,2),(3,2),(4,2),(5,2),(6,2),(7,2),(8,2),(9,2),(10,2)]
+array (0,10) [(0,0),(1,0),(2,2),(3,0),(4,2),(5,0),(6,2),(7,0),(8,2),(9,0),(10,2)]
diff --git a/testsuite/tests/array/should_run/arr012.hs b/testsuite/tests/array/should_run/arr012.hs
new file mode 100644
index 0000000000..231d625812
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr012.hs
@@ -0,0 +1,19 @@
+-- !!! Array map operations
+--
+--
+module Main(main) where
+
+import Data.Array
+import Data.Char
+
+main =
+ let
+ a1 = array (0,10) (zip [0..10] ['a'..'z'])
+ in
+ print a1 >>
+ print (fmap (toUpper) a1) >>
+ print (ixmap (3,8) (+1) a1)
+
+
+
+
diff --git a/testsuite/tests/array/should_run/arr012.stdout b/testsuite/tests/array/should_run/arr012.stdout
new file mode 100644
index 0000000000..b8c8fda13a
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr012.stdout
@@ -0,0 +1,3 @@
+array (0,10) [(0,'a'),(1,'b'),(2,'c'),(3,'d'),(4,'e'),(5,'f'),(6,'g'),(7,'h'),(8,'i'),(9,'j'),(10,'k')]
+array (0,10) [(0,'A'),(1,'B'),(2,'C'),(3,'D'),(4,'E'),(5,'F'),(6,'G'),(7,'H'),(8,'I'),(9,'J'),(10,'K')]
+array (3,8) [(3,'e'),(4,'f'),(5,'g'),(6,'h'),(7,'i'),(8,'j')]
diff --git a/testsuite/tests/array/should_run/arr013.hs b/testsuite/tests/array/should_run/arr013.hs
new file mode 100644
index 0000000000..f9e63aa5ba
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr013.hs
@@ -0,0 +1,17 @@
+import Data.Ratio -- 1.3
+import Data.Array -- 1.3
+infix 1 =:
+(=:) a b = (a,b)
+
+main = putStr (shows sub_b "\n")
+ where
+ sub_b :: Array Int Double
+ sub_b = ixmap (102, 113) id b
+
+ b :: Array Int Double
+ b = fmap ( \ r -> fromRational r / pi )
+ (ixmap (101,200) (\ i -> toInteger i - 100) a)
+
+ a :: Array Integer (Ratio Integer)
+ a = array (1,100) ((1 =: 1) : [i =: fromInteger i * a!(i-1)
+ | i <- [2..100]])
diff --git a/testsuite/tests/array/should_run/arr013.stdout b/testsuite/tests/array/should_run/arr013.stdout
new file mode 100644
index 0000000000..4d9bf4f505
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr013.stdout
@@ -0,0 +1 @@
+array (102,113) [(102,0.6366197723675814),(103,1.909859317102744),(104,7.639437268410976),(105,38.197186342054884),(106,229.1831180523293),(107,1604.281826366305),(108,12834.25461093044),(109,115508.29149837396),(110,1155082.9149837396),(111,1.2705912064821135e7),(112,1.5247094477785364e8),(113,1.9821222821120973e9)]
diff --git a/testsuite/tests/array/should_run/arr014.hs b/testsuite/tests/array/should_run/arr014.hs
new file mode 100644
index 0000000000..59541c09ff
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr014.hs
@@ -0,0 +1,26 @@
+-- !!! multi-dimensional arrays
+
+module Main ( main ) where
+import Control.Monad.ST
+import Data.Array.ST
+
+type TwoD s = STArray s Int (STArray s Int Int)
+
+setup :: ST s (TwoD s)
+setup = let isz = 10
+ imax = isz - 1
+ osz = 2
+ omax = osz - 1 in
+ do
+ -- gives : undefined reference to `IOBase_error_closure'
+-- x <- newArray (0, omax) (error "uninitialised")
+ dmy <- newArray (0, imax) 0
+ x <- newArray (0, omax) dmy
+ as <- (sequence . replicate osz) (newArray (0, imax) 6)
+ mapM_ (\(i,v) -> writeArray x i v) (zip [0..omax] as)
+ return x
+
+main :: IO ()
+main = do
+ a <- stToIO setup
+ return ()
diff --git a/testsuite/tests/array/should_run/arr014.stdout b/testsuite/tests/array/should_run/arr014.stdout
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr014.stdout
diff --git a/testsuite/tests/array/should_run/arr015.hs b/testsuite/tests/array/should_run/arr015.hs
new file mode 100644
index 0000000000..4a6e8c431a
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr015.hs
@@ -0,0 +1,50 @@
+-- !!! Array test
+-- This one fails in Hugs (Feb 2001)
+
+module Main where
+
+import Data.Array
+
+-- All in main is only to show the strange behaviour.
+--
+-- arrS is the array that foo (NB (1.0,1)) shows in Hugs.
+-- But (foo (NB (1.0,1)))==arrS is False.
+
+-- If I write NB (f,p) -> hCMt [(p,listArray ((1,1),(1,1)) [f])] instead of line 16
+-- the bug disappears. That is also the reason why I have to keep the data declaration RD.
+-- If I put the type signature of line 18 in scope the bug also disappears.
+-- If I write hCMt po_arL = (accumArray (\a _-> a) ZM ((1,1),(1,2)) []) //
+-- (map (\(po,ar) -> ((1,po),M ar)) po_arL)
+-- instead of line 19 and 20 it also vanishes.
+
+data CM a = ZM | M (Array (Int,Int) a) deriving (Show,Eq)
+
+data RD = NB !(Double,Int)
+
+main = do
+ let arr = foo (NB (1.0,1))
+ -- arr = { (1,1) -> M { (1,1) -> 1.0 }, (1,2) -> ZM }
+
+ -- All these should return True
+ putStr ("arr==arrS "++show (arr==arrS)++"\n")
+ putStr ("arrS==arr "++show (arrS==arr)++"\n")
+ putStr ("bnds arr arrS "++show ((bounds arr)==(bounds arrS))++"\n")
+ putStr ("bnds +id arr arrS "++show (((bounds.id) arr)==((bounds) arrS))++"\n")
+ putStr ("id +bnds arr arrS "++show (((id.bounds) arr)==((bounds) arrS))++"\n")
+
+
+foo :: RD -> Array (Int,Int) (CM Double)
+foo rd = case rd of
+ NB (f,p) -> h where h = hCMt [(p,listArray ((1,1),(1,1)) [f])]
+ -- h = { (1,p) -> M { (1,1) -> f }, other -> ZM }
+ where
+ --h0CMt :: Array (Int, Int) (CM Double)
+ -- h0CMt = { (1,1) -> ZM, (1,2) -> ZM }
+ h0CMt = accumArray (\a _-> a) ZM ((1,1),(1,2)) []
+
+ hCMt prs = h0CMt // (map (\(po,ar) -> ((1,po),M ar)) prs)
+ -- [ (1,p), M { (1,1) -> f } ]
+
+
+arrS :: Array (Int,Int) (CM Double)
+arrS = listArray ((1,1),(1,2)) [M (listArray ((1,1),(1,1)) [1.0]),ZM]
diff --git a/testsuite/tests/array/should_run/arr015.stdout b/testsuite/tests/array/should_run/arr015.stdout
new file mode 100644
index 0000000000..be8c55085c
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr015.stdout
@@ -0,0 +1,5 @@
+arr==arrS True
+arrS==arr True
+bnds arr arrS True
+bnds +id arr arrS True
+id +bnds arr arrS True
diff --git a/testsuite/tests/array/should_run/arr016.hs b/testsuite/tests/array/should_run/arr016.hs
new file mode 100644
index 0000000000..055e6602be
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr016.hs
@@ -0,0 +1,511 @@
+{-# LANGUAGE ScopedTypeVariables, DatatypeContexts #-}
+
+module Main where
+
+{-
+ - This is a test framework for Arrays, using QuickCheck
+ -
+ -}
+
+import qualified Data.Array as Array
+import Data.List
+import Control.Monad ( liftM2, liftM3, liftM4 )
+import System.Random
+
+
+import Data.Ix
+import Data.List( (\\) )
+
+infixl 9 !, //
+infixr 0 ==>
+infix 1 `classify`
+
+prop_array =
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) ->
+ Array.array b vs
+ `same_arr`
+ array b vs
+prop_listArray =
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (vector (length [fst b..snd b]))
+ $ \ (vs :: [Bool]) ->
+ Array.listArray b vs == Array.array b (zipWith (\ a b -> (a,b))
+ (Array.range b) vs)
+
+prop_indices =
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) ->
+ let arr = Array.array b vs
+ in Array.indices arr == ((Array.range . Array.bounds) arr)
+
+prop_elems =
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) ->
+ let arr = Array.array b vs
+ in Array.elems arr == [arr Array.! i | i <- Array.indices arr]
+
+prop_assocs =
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) ->
+ let arr = Array.array b vs
+ in Array.assocs arr == [(i, arr Array.! i) | i <- Array.indices arr]
+
+prop_slashslash =
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) ->
+ let arr = Array.array b vs
+ us = []
+ in arr Array.// us == Array.array (Array.bounds arr)
+ ([(i,arr Array.! i)
+ | i <- Array.indices arr \\ [i | (i,_) <- us]]
+ ++ us)
+prop_accum =
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) ->
+
+ forAll (genIVPs b 10) $ \ (us :: [(Int,Int)]) ->
+ forAll (choose (0,length us))
+ $ \ n ->
+ let us' = take n us in
+ forAll arbitrary $ \ (fn :: Int -> Int -> Int) ->
+ let arr = Array.array b vs
+ in Array.accum fn arr us'
+ == foldl (\a (i,v) -> a Array.// [(i,fn (a Array.! i) v)]) arr us'
+
+prop_accumArray =
+ forAll arbitrary $ \ (f :: Int -> Int -> Int) ->
+ forAll arbitrary $ \ (z :: Int) ->
+ forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (vs :: [(Int,Int)]) ->
+ Array.accumArray f z b vs == Array.accum f
+ (Array.array b [(i,z) | i <- Array.range b]) vs
+
+
+same_arr :: (Eq b) => Array.Array Int b -> Array Int b -> Bool
+same_arr a1 a2 = a == c && b == d
+ && all (\ n -> (a1 Array.! n) == (a2 ! n)) [a..b]
+ where (a,b) = Array.bounds a1 :: (Int,Int)
+ (c,d) = bounds a2 :: (Int,Int)
+
+genBounds :: Gen (Int,Int)
+genBounds = do m <- choose (0,20)
+ n <- choose (minBound,maxBound-m)
+ return (n,n+m-1)
+
+genIVP :: Arbitrary a => (Int,Int) -> Gen (Int,a)
+genIVP b = do { i <- choose b
+ ; v <- arbitrary
+ ; return (i,v)
+ }
+
+genIVPs :: Arbitrary a => (Int,Int) -> Int -> Gen [(Int,a)]
+genIVPs b@(low,high) s
+ = do { let is = [low..high]
+ ; vs <- vector (length is)
+ ; shuffle s (zip is vs)
+ }
+
+prop_id = forAll genBounds $ \ (b :: (Int,Int)) ->
+ forAll (genIVPs b 10) $ \ (ivps :: [(Int,Int)]) ->
+ label (show (ivps :: [(Int,Int)])) True
+
+-- rift takes a list, split it (using an Int argument),
+-- and then rifts together the split lists into one.
+-- Think: rifting a pack of cards.
+rift :: Int -> [a] -> [a]
+rift n xs = comb (drop n xs) (take n xs)
+ where
+ comb (a:as) (b:bs) = a : b : comb as bs
+ comb (a:as) [] = a : as
+ comb [] (b:bs) = b : bs
+ comb [] [] = []
+
+
+-- suffle makes n random rifts. Typically after
+-- log n rifts, the list is in a pretty random order.
+-- (where n is the number of elements in the list)
+
+shuffle :: Int -> [a] -> Gen [a]
+shuffle 0 m = return m
+shuffle n m = do { r <- choose (1,length m)
+ ; shuffle (n-1) (rift r m)
+ }
+prop_shuffle =
+ forAll (shuffle 10 [1..10::Int]) $ \ lst ->
+ label (show lst) True
+
+------------------------------------------------------------------------------
+
+main = do test prop_array
+ test prop_listArray
+ test prop_indices
+ test prop_elems
+ test prop_assocs
+ test prop_slashslash
+ test prop_accum
+ test prop_accumArray
+
+
+instance Show (a -> b) where { show _ = "<FN>" }
+
+------------------------------------------------------------------------------
+
+data (Ix a) => Array a b = MkArray (a,a) (a -> b) deriving ()
+
+array :: (Ix a) => (a,a) -> [(a,b)] -> Array a b
+array b ivs =
+ if and [inRange b i | (i,_) <- ivs]
+ then MkArray b
+ (\j -> case [v | (i,v) <- ivs, i == j] of
+ [v] -> v
+ [] -> error "Array.!: \
+ \undefined array element"
+ _ -> error "Array.!: \
+ \multiply defined array element")
+ else error "Array.array: out-of-range array association"
+
+listArray :: (Ix a) => (a,a) -> [b] -> Array a b
+listArray b vs = array b (zipWith (\ a b -> (a,b)) (range b) vs)
+
+(!) :: (Ix a) => Array a b -> a -> b
+(!) (MkArray _ f) = f
+
+bounds :: (Ix a) => Array a b -> (a,a)
+bounds (MkArray b _) = b
+
+indices :: (Ix a) => Array a b -> [a]
+indices = range . bounds
+
+elems :: (Ix a) => Array a b -> [b]
+elems a = [a!i | i <- indices a]
+
+assocs :: (Ix a) => Array a b -> [(a,b)]
+assocs a = [(i, a!i) | i <- indices a]
+
+(//) :: (Ix a) => Array a b -> [(a,b)] -> Array a b
+a // us = array (bounds a)
+ ([(i,a!i) | i <- indices a \\ [i | (i,_) <- us]]
+ ++ us)
+
+accum :: (Ix a) => (b -> c -> b) -> Array a b -> [(a,c)]
+ -> Array a b
+accum f = foldl (\a (i,v) -> a // [(i,f (a!i) v)])
+
+accumArray :: (Ix a) => (b -> c -> b) -> b -> (a,a) -> [(a,c)]
+ -> Array a b
+accumArray f z b = accum f (array b [(i,z) | i <- range b])
+
+ixmap :: (Ix a, Ix b) => (a,a) -> (a -> b) -> Array b c
+ -> Array a c
+ixmap b f a = array b [(i, a ! f i) | i <- range b]
+
+instance (Ix a) => Functor (Array a) where
+ fmap fn (MkArray b f) = MkArray b (fn . f)
+
+instance (Ix a, Eq b) => Eq (Array a b) where
+ a == a' = assocs a == assocs a'
+
+instance (Ix a, Ord b) => Ord (Array a b) where
+ a <= a' = assocs a <= assocs a'
+
+instance (Ix a, Show a, Show b) => Show (Array a b) where
+ showsPrec p a = showParen (p > 9) (
+ showString "array " .
+ shows (bounds a) . showChar ' ' .
+ shows (assocs a) )
+
+instance (Ix a, Read a, Read b) => Read (Array a b) where
+ readsPrec p = readParen (p > 9)
+ (\r -> [(array b as, u) | ("array",s) <- lex r,
+ (b,t) <- reads s,
+ (as,u) <- reads t ])
+--------------------------------------------------------------------
+
+-- QuickCheck v.0.2
+-- DRAFT implementation; last update 000104.
+-- Koen Claessen, John Hughes.
+-- This file represents work in progress, and might change at a later date.
+
+
+--------------------------------------------------------------------
+-- Generator
+
+newtype Gen a
+ = Gen (Int -> StdGen -> a)
+
+sized :: (Int -> Gen a) -> Gen a
+sized fgen = Gen (\n r -> let Gen m = fgen n in m n r)
+
+resize :: Int -> Gen a -> Gen a
+resize n (Gen m) = Gen (\_ r -> m n r)
+
+rand :: Gen StdGen
+rand = Gen (\n r -> r)
+
+promote :: (a -> Gen b) -> Gen (a -> b)
+promote f = Gen (\n r -> \a -> let Gen m = f a in m n r)
+
+variant :: Int -> Gen a -> Gen a
+variant v (Gen m) = Gen (\n r -> m n (rands r !! (v+1)))
+ where
+ rands r0 = r1 : rands r2 where (r1, r2) = split r0
+
+generate :: Int -> StdGen -> Gen a -> a
+generate n rnd (Gen m) = m size rnd'
+ where
+ (size, rnd') = randomR (0, n) rnd
+
+instance Functor Gen where
+ fmap f m = m >>= return . f
+
+instance Monad Gen where
+ return a = Gen (\n r -> a)
+ Gen m >>= k =
+ Gen (\n r0 -> let (r1,r2) = split r0
+ Gen m' = k (m n r1)
+ in m' n r2)
+
+-- derived
+
+--choose :: Random a => (a, a) -> Gen a
+choose bounds = ((fst . randomR bounds) `fmap` rand)
+
+elements :: [a] -> Gen a
+elements xs = (xs !!) `fmap` choose (0, length xs - 1)
+
+vector :: Arbitrary a => Int -> Gen [a]
+vector n = sequence [ arbitrary | i <- [1..n] ]
+
+oneof :: [Gen a] -> Gen a
+oneof gens = elements gens >>= id
+
+frequency :: [(Int, Gen a)] -> Gen a
+frequency xs = choose (1, tot) >>= (`pick` xs)
+ where
+ tot = sum (map fst xs)
+
+ pick n ((k,x):xs)
+ | n <= k = x
+ | otherwise = pick (n-k) xs
+
+-- general monadic
+
+two :: Monad m => m a -> m (a, a)
+two m = liftM2 (,) m m
+
+three :: Monad m => m a -> m (a, a, a)
+three m = liftM3 (,,) m m m
+
+four :: Monad m => m a -> m (a, a, a, a)
+four m = liftM4 (,,,) m m m m
+
+--------------------------------------------------------------------
+-- Arbitrary
+
+class Arbitrary a where
+ arbitrary :: Gen a
+ coarbitrary :: a -> Gen b -> Gen b
+
+instance Arbitrary () where
+ arbitrary = return ()
+ coarbitrary _ = variant 0
+
+instance Arbitrary Bool where
+ arbitrary = elements [True, False]
+ coarbitrary b = if b then variant 0 else variant 1
+
+instance Arbitrary Int where
+ arbitrary = sized $ \n -> choose (-n,n)
+ coarbitrary n = variant (if n >= 0 then 2*n else 2*(-n) + 1)
+
+instance Arbitrary Integer where
+ arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n)
+ coarbitrary n = variant (fromInteger (if n >= 0 then 2*n else 2*(-n) + 1))
+
+instance Arbitrary Float where
+ arbitrary = liftM3 fraction arbitrary arbitrary arbitrary
+ coarbitrary x = coarbitrary (decodeFloat x)
+
+instance Arbitrary Double where
+ arbitrary = liftM3 fraction arbitrary arbitrary arbitrary
+ coarbitrary x = coarbitrary (decodeFloat x)
+
+fraction a b c = fromInteger a + (fromInteger b / (abs (fromInteger c) + 1))
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (a, b) where
+ arbitrary = liftM2 (,) arbitrary arbitrary
+ coarbitrary (a, b) = coarbitrary a . coarbitrary b
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (a, b, c) where
+ arbitrary = liftM3 (,,) arbitrary arbitrary arbitrary
+ coarbitrary (a, b, c) = coarbitrary a . coarbitrary b . coarbitrary c
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
+ => Arbitrary (a, b, c, d)
+ where
+ arbitrary = liftM4 (,,,) arbitrary arbitrary arbitrary arbitrary
+ coarbitrary (a, b, c, d) =
+ coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d
+
+instance Arbitrary a => Arbitrary [a] where
+ arbitrary = sized (\n -> choose (0,n) >>= vector)
+ coarbitrary [] = variant 0
+ coarbitrary (a:as) = coarbitrary a . variant 1 . coarbitrary as
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (a -> b) where
+ arbitrary = promote (`coarbitrary` arbitrary)
+ coarbitrary f gen = arbitrary >>= ((`coarbitrary` gen) . f)
+
+--------------------------------------------------------------------
+-- Testable
+
+data Result
+ = Result { ok :: Maybe Bool, stamp :: [String], arguments :: [String] }
+
+nothing :: Result
+nothing = Result{ ok = Nothing, stamp = [], arguments = [] }
+
+newtype Property
+ = Prop (Gen Result)
+
+result :: Result -> Property
+result res = Prop (return res)
+
+evaluate :: Testable a => a -> Gen Result
+evaluate a = gen where Prop gen = property a
+
+class Testable a where
+ property :: a -> Property
+
+instance Testable () where
+ property _ = result nothing
+
+instance Testable Bool where
+ property b = result (nothing{ ok = Just b })
+
+instance Testable Result where
+ property res = result res
+
+instance Testable Property where
+ property prop = prop
+
+instance (Arbitrary a, Show a, Testable b) => Testable (a -> b) where
+ property f = forAll arbitrary f
+
+forAll :: (Show a, Testable b) => Gen a -> (a -> b) -> Property
+forAll gen body = Prop $
+ do a <- gen
+ res <- evaluate (body a)
+ return (argument a res)
+ where
+ argument a res = res{ arguments = show a : arguments res }
+
+(==>) :: Testable a => Bool -> a -> Property
+True ==> a = property a
+False ==> a = property ()
+
+label :: Testable a => String -> a -> Property
+label s a = Prop (add `fmap` evaluate a)
+ where
+ add res = res{ stamp = s : stamp res }
+
+classify :: Testable a => Bool -> String -> a -> Property
+classify True name = label name
+classify False _ = property
+
+trivial :: Testable a => Bool -> a -> Property
+trivial = (`classify` "trivial")
+
+collect :: (Show a, Testable b) => a -> b -> Property
+collect v = label (show v)
+
+--------------------------------------------------------------------
+-- Testing
+
+data Config = Config
+ { configMaxTest :: Int
+ , configMaxFail :: Int
+ , configSize :: Int -> Int
+ , configEvery :: Int -> [String] -> String
+ }
+
+quick :: Config
+quick = Config
+ { configMaxTest = 100
+ , configMaxFail = 1000
+ , configSize = (+ 3) . (`div` 2)
+ , configEvery = \n args -> let s = show n in s ++ ","
+ }
+
+verbose :: Config
+verbose = quick
+ { configEvery = \n args -> show n ++ ":\n" ++ unlines args
+ }
+
+test, quickCheck, verboseCheck :: Testable a => a -> IO ()
+test = check quick
+quickCheck = check quick
+verboseCheck = check verbose
+
+check :: Testable a => Config -> a -> IO ()
+check config a =
+ do rnd <- newStdGen
+ tests config (evaluate a) rnd 0 0 []
+
+tests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()
+tests config gen rnd0 ntest nfail stamps
+ | ntest == configMaxTest config = do done "OK, passed" ntest stamps
+ | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps
+ | otherwise =
+ do putStr (configEvery config ntest (arguments result))
+ case ok result of
+ Nothing ->
+ tests config gen rnd1 ntest (nfail+1) stamps
+ Just True ->
+ tests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
+ Just False ->
+ putStr ( "Falsifiable, after "
+ ++ show ntest
+ ++ " tests:\n"
+ ++ unlines (arguments result)
+ )
+ 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) ++ "%"
+
+--------------------------------------------------------------------
+-- the end.
+
+{-
+instance Observable StdGen where { observer = observeBase }
+
+instance Observable a => Observable (Gen a) where
+ observer (Gen a) = send "Gen" (return (Gen) << a)
+
+-} \ No newline at end of file
diff --git a/testsuite/tests/array/should_run/arr016.stdout b/testsuite/tests/array/should_run/arr016.stdout
new file mode 100644
index 0000000000..1e7413dfb1
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr016.stdout
@@ -0,0 +1,8 @@
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
+0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,OK, passed 100 tests.
diff --git a/testsuite/tests/array/should_run/arr017.hs b/testsuite/tests/array/should_run/arr017.hs
new file mode 100644
index 0000000000..18314b8e28
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr017.hs
@@ -0,0 +1,30 @@
+-- Caused a crash in GHC 6.4 when optimising, due to inlining of runST too early.
+
+-- Spectral Norm benchmark
+
+import Data.Array
+import System.Environment (getArgs)
+
+main = do
+ --[arg] <- getArgs
+ --let n = (read arg) - 1
+ let n = 80
+ let init = listArray (0,n) (repeat 1.0)
+ let (v:u:rest) = drop 19 $ iterate (eval_AtA_times_u n) init
+ let vBv = sum [(u!i)*(v!i) |i<-[0..n]]
+ let vv = sum [(v!i)*(v!i) |i<-[0..n]]
+ print $ sqrt (vBv/vv)
+
+eval_AtA_times_u n u = eval_At_times_u n v
+ where v = eval_A_times_u n u
+
+eval_A x y = 1.0/((i+j)*(i+j+1)/2+i+1)
+ where i = fromIntegral x
+ j = fromIntegral y
+
+eval_A_times_u n u = accumArray (+) 0 (0,n)
+ [(i,(eval_A i j) * u!j)|i<-[0..n], j<-[0..n]]
+
+eval_At_times_u n u = accumArray (+) 0 (0,n)
+ [(i,(eval_A j i) * u!j)|i<-[0..n], j<-[0..n]]
+
diff --git a/testsuite/tests/array/should_run/arr017.stdout b/testsuite/tests/array/should_run/arr017.stdout
new file mode 100644
index 0000000000..12e7cb0720
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr017.stdout
@@ -0,0 +1 @@
+1.2742165080678525
diff --git a/testsuite/tests/array/should_run/arr018.hs b/testsuite/tests/array/should_run/arr018.hs
new file mode 100644
index 0000000000..27896aae39
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr018.hs
@@ -0,0 +1,16 @@
+-- test for #1131
+import Control.Monad.ST
+import Data.Array.ST
+import Data.Array
+import System.Mem
+
+tickle :: Int
+tickle = runST (do {
+ x <- newArray_ (0,100) ;
+ (readArray :: STUArray s Int Int -> Int -> ST s Int) x 3
+ })
+
+main :: IO ()
+main = do print $ length (replicate 100000 'a')
+ performGC
+ print tickle
diff --git a/testsuite/tests/array/should_run/arr018.stdout b/testsuite/tests/array/should_run/arr018.stdout
new file mode 100644
index 0000000000..08ca4fc84f
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr018.stdout
@@ -0,0 +1,2 @@
+100000
+0
diff --git a/testsuite/tests/array/should_run/arr019.hs b/testsuite/tests/array/should_run/arr019.hs
new file mode 100644
index 0000000000..9992dd2315
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr019.hs
@@ -0,0 +1,27 @@
+
+-- Test for trac #2158
+
+import Data.Array
+
+data Pos = Pos Integer Integer
+ deriving (Show, Eq, Ord, Ix)
+
+myBounds :: (Pos, Pos)
+myBounds = (Pos 0 0, Pos 2 3)
+
+main :: IO ()
+main = do print $ range myBounds
+ print $ index myBounds (Pos 0 0)
+ print $ index myBounds (Pos 0 1)
+ print $ index myBounds (Pos 0 2)
+ print $ index myBounds (Pos 0 3)
+ print $ index myBounds (Pos 1 0)
+ print $ index myBounds (Pos 1 1)
+ print $ index myBounds (Pos 1 2)
+ print $ index myBounds (Pos 1 3)
+ print $ index myBounds (Pos 2 0)
+ print $ index myBounds (Pos 2 1)
+ print $ index myBounds (Pos 2 2)
+ print $ index myBounds (Pos 2 3)
+ print $ listArray myBounds [(123 :: Integer) ..]
+
diff --git a/testsuite/tests/array/should_run/arr019.stdout b/testsuite/tests/array/should_run/arr019.stdout
new file mode 100644
index 0000000000..f99db4ec8d
--- /dev/null
+++ b/testsuite/tests/array/should_run/arr019.stdout
@@ -0,0 +1,14 @@
+[Pos 0 0,Pos 0 1,Pos 0 2,Pos 0 3,Pos 1 0,Pos 1 1,Pos 1 2,Pos 1 3,Pos 2 0,Pos 2 1,Pos 2 2,Pos 2 3]
+0
+1
+2
+3
+4
+5
+6
+7
+8
+9
+10
+11
+array (Pos 0 0,Pos 2 3) [(Pos 0 0,123),(Pos 0 1,124),(Pos 0 2,125),(Pos 0 3,126),(Pos 1 0,127),(Pos 1 1,128),(Pos 1 2,129),(Pos 1 3,130),(Pos 2 0,131),(Pos 2 1,132),(Pos 2 2,133),(Pos 2 3,134)]