ghc/tests/array/should_run/arr015.hs

   1 -- !!! Array test
   2 -- This one fails in Hugs (Feb 2001)
   3
   4 module Main where
   5
   6 import Array
   7
   8 -- All in main is only to show the strange behaviour.
   9 --
  10 -- arrS is the array that foo (NB (1.0,1)) shows in Hugs.
  11 -- But (foo (NB (1.0,1)))==arrS is False.
  12
  13 -- If I write NB (f,p) -> hCMt [(p,listArray ((1,1),(1,1)) [f])] instead of line 16
  14 -- the bug disappears. That is also the reason why I have to keep the data declaration RD.
  15 -- If I put the type signature of line 18 in scope the bug also disappears.
  16 -- If I write hCMt po_arL = (accumArray (\a _-> a) ZM ((1,1),(1,2)) []) //
  17 --                          (map (\(po,ar) -> ((1,po),M ar)) po_arL)
  18 -- instead of line 19 and 20 it also vanishes.
  19
  20 data CM a = ZM | M (Array (Int,Int) a)  deriving (Show,Eq)
  21
  22 data RD =    NB !(Double,Int)
  23
  24 main  = do
  25   let arr = foo (NB (1.0,1))
  26         -- arr = { (1,1) -> M { (1,1) -> 1.0 }, (1,2) -> ZM }
  27
  28         -- All these should return True
  29   putStr ("arr==arrS "++show (arr==arrS)++"\n")
  30   putStr ("arrS==arr "++show (arrS==arr)++"\n")
  31   putStr ("bnds arr arrS "++show ((bounds arr)==(bounds arrS))++"\n")
  32   putStr ("bnds +id arr arrS "++show (((bounds.id) arr)==((bounds) arrS))++"\n")
  33   putStr ("id +bnds arr arrS "++show (((id.bounds) arr)==((bounds) arrS))++"\n")
  34
  35
  36 foo :: RD -> Array (Int,Int) (CM Double)
  37 foo rd = case rd of
  38     NB (f,p) -> h where h = hCMt [(p,listArray ((1,1),(1,1)) [f])]
  39                         -- h = { (1,p) -> M { (1,1) -> f }, other -> ZM }
  40    where
  41    --h0CMt :: Array (Int, Int) (CM Double)
  42    -- h0CMt = { (1,1) -> ZM, (1,2) -> ZM }
  43    h0CMt = accumArray (\a _-> a) ZM ((1,1),(1,2)) []
  44
  45    hCMt prs = h0CMt // (map (\(po,ar) -> ((1,po),M ar)) prs)
  46                         -- [ (1,p), M { (1,1) -> f } ]
  47
  48
  49 arrS :: Array (Int,Int) (CM Double)
  50 arrS = listArray ((1,1),(1,2)) [M (listArray ((1,1),(1,1)) [1.0]),ZM]