diff options
Diffstat (limited to 'testsuite')
99 files changed, 1860 insertions, 0 deletions
diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/all.T b/testsuite/tests/ghc-regress/codeGen/should_run/all.T new file mode 100644 index 0000000000..c6672b7bfb --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/all.T @@ -0,0 +1,58 @@ + +include ($confdir ++ "/../vanilla-test.T") + +-- Args to vt are: extra compile flags +-- extra run flags +-- expected process return value, if not zero + +test "cg001" { vt("", "", "") } +test "cg002" { vt("", "", "") } +test "cg003" { vt("", "", "") } +test "cg004" { vt("", "", "") } +test "cg005" { vt("", "", "") } +test "cg006" { vt("", "", "") } +test "cg007" { vt("", "", "") } +test "cg008" { vt("", "", "") } +test "cg009" { vt("", "", "") } +test "cg010" { vt("", "", "") } +test "cg011" { vt("", "", "") } +test "cg012" { vt("-fglasgow-exts", "", "") } +test "cg013" { vt("", "", "") } +test "cg014" { vt("", "", "") } +test "cg015" { vt("-fglasgow-exts", "", "") } +test "cg016" { vt("", "", "1") } +test "cg017" { vt("", "", "") } +test "cg018" { vt("-fglasgow-exts", "", "") } +test "cg019" { vt("", "", "") } +test "cg020" { vt("", "", "") } +test "cg021" { vt("", "", "") } +test "cg022" { vt("", "", "") } +test "cg023" { vt("", "", "") } +test "cg024" { vt("", "", "") } +test "cg025" { vt("-package lang -package text", "", "1") } +test "cg026" { vt("-package lang -fglasgow-exts -fvia-C", "", "") } +test "cg027" { vt("", "", "") } +test "cg028" { vt("", "", "") } +test "cg029" { vt("-package lang -fglasgow-exts", "", "") } +test "cg030" { vt("-package lang -fglasgow-exts", "", "") } +test "cg031" { vt("-fglasgow-exts", "", "") } +test "cg032" { vt("-fglasgow-exts", "", "") } +test "cg033" { vt("-fglasgow-exts", "", "") } +test "cg034" { vt("", "", "") } +test "cg035" { vt("-package lang -fglasgow-exts", "", "") } +test "cg036" { vt("", "", "") } +test "cg037" { vt("", "", "") } +test "cg038" { vt("", "", "") } +test "cg039" { vt("", "", "") } +test "cg040" { vt("", "", "") } +test "cg041" { vt("", "", "") } +test "cg042" { vt("-package lang -fglasgow-exts", "", "") } +test "cg043" { vt("", "", "") } +test "cg044" { vt("-package lang", "", "" ) } + +-- tmp, until we fix the problems with seq#... +test "cg045" { vt( "-O", "", "1") } +test "cg046" { vt("", "", "") } +test "cg047" { vt("", "", "") } +test "cg048" { vt("", "", "") } +test "cg049" { vt( "-funbox-strict-fields", "", "") } diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg001.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg001.hs new file mode 100644 index 0000000000..5482f13127 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg001.hs @@ -0,0 +1,6 @@ +-- !! cg001: main = -42 -- take 1 + +main = print ( f () ) + where + f :: a -> Int + f x = -42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg001.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg001.stdout new file mode 100644 index 0000000000..6a0e60d48b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg001.stdout @@ -0,0 +1 @@ +-42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg002.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg002.hs new file mode 100644 index 0000000000..dddaabd66f --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg002.hs @@ -0,0 +1,12 @@ +main = print ((f id2) (10 + thirty_two)) + where + f x = g x + where + g x = h x + where + h x = x + + thirty_two :: Int + thirty_two = 32 + +id2 x = x diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg002.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg002.stdout new file mode 100644 index 0000000000..d81cc0710e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg002.stdout @@ -0,0 +1 @@ +42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg003.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg003.hs new file mode 100644 index 0000000000..47b2d9e7bf --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg003.hs @@ -0,0 +1,11 @@ +main = print (id2 (id2 id2) (42::Int)) +-- where +-- id2 = s k k + +-- id2 x = s k k x + +id2 = s k k + +s x y z = x z (y z) + +k x y = x diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg003.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg003.stdout new file mode 100644 index 0000000000..d81cc0710e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg003.stdout @@ -0,0 +1 @@ +42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg004.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg004.hs new file mode 100644 index 0000000000..1f4a2737c3 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg004.hs @@ -0,0 +1 @@ +main = print (length ([9,8,7,6,5,4,3,2,1] :: [Int])) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg004.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg004.stdout new file mode 100644 index 0000000000..ec635144f6 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg004.stdout @@ -0,0 +1 @@ +9 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg005.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg005.hs new file mode 100644 index 0000000000..4159d4c882 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg005.hs @@ -0,0 +1,6 @@ +-- !! answer: 65532 + +main = print foo + +foo :: Int +foo = ((1 + 2 + 32767 - 4) * 6) --later? `div` 3 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg005.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg005.stdout new file mode 100644 index 0000000000..12bd33f964 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg005.stdout @@ -0,0 +1 @@ +196596 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg006.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg006.hs new file mode 100644 index 0000000000..609c3c2b4b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg006.hs @@ -0,0 +1,6 @@ +main = print (length thirteen_ones) + where + thirteen_ones = take (13::Int) ones + + ones :: [Int] + ones = 1 : ones diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg006.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg006.stdout new file mode 100644 index 0000000000..b1bd38b62a --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg006.stdout @@ -0,0 +1 @@ +13 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg007.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg007.hs new file mode 100644 index 0000000000..317b921a42 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg007.hs @@ -0,0 +1,14 @@ +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +main = print (height our_tree) + where + our_tree :: Tree Int + our_tree = + Branch (Branch (Leaf 1) (Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1))) + (Branch (Leaf 1) (Leaf 1)) + + +height :: Tree a -> Int + +height (Leaf _) = 1 +height (Branch t1 t2) = 1 + max (height t1) (height t2) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg007.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg007.stdout new file mode 100644 index 0000000000..7ed6ff82de --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg007.stdout @@ -0,0 +1 @@ +5 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg008.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg008.hs new file mode 100644 index 0000000000..1713b4834e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg008.hs @@ -0,0 +1,12 @@ +main = print (length comp_list) + where + comp_list :: [(Int,Int)] + comp_list = [ (elem1,elem2) + | elem1 <- given_list, + elem2 <- given_list, + elem1 >= (4::Int), + elem2 < (3::Int) + ] + + given_list :: [Int] + given_list = [1,2,3,4,5,6,7,8,9] diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg008.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg008.stdout new file mode 100644 index 0000000000..48082f72f0 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg008.stdout @@ -0,0 +1 @@ +12 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg009.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg009.hs new file mode 100644 index 0000000000..de03fc42cd --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg009.hs @@ -0,0 +1,7 @@ +main = print (length take_list) + where + take_list :: [Int] + take_list = takeWhile (\ x -> x < 6) given_list + + given_list :: [Int] + given_list = [1,2,3,4,5,6,7,8,9] diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg009.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg009.stdout new file mode 100644 index 0000000000..7ed6ff82de --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg009.stdout @@ -0,0 +1 @@ +5 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg010.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg010.hs new file mode 100644 index 0000000000..ccc323d4cf --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg010.hs @@ -0,0 +1,5 @@ +main = print a + where + a :: Int + b :: Int + (a, b) = (3 + 4, 5 + 6) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg010.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg010.stdout new file mode 100644 index 0000000000..7f8f011eb7 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg010.stdout @@ -0,0 +1 @@ +7 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg011.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg011.hs new file mode 100644 index 0000000000..c687e50272 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg011.hs @@ -0,0 +1,29 @@ +-- !!! simple overloading example + +class Foo a where + foo :: a -> a -> Bool + +class (Foo a) => Bar a where + bar :: a -> a -> Bool + +instance Foo Int where + foo a b = a /= b + +instance Foo Bool where + foo a b = a /= b + +instance Bar Int where + bar a b = a < b + +instance Bar Bool where + bar a b = a < b + +foO = if bar (2::Int) (3::Int) then + if bar False True then + (42::Int) + else + (888::Int) + else + (999::Int) + +main = print foO diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg011.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg011.stdout new file mode 100644 index 0000000000..d81cc0710e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg011.stdout @@ -0,0 +1 @@ +42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg012.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg012.hs new file mode 100644 index 0000000000..9159f295ff --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg012.hs @@ -0,0 +1,38 @@ +-- !!! move arguments around on the stacks, mainly the B stack + +import PrelBase ( Float#, Double#, Int#, Int(..) ) + + +main = print foo + +foo = I# + ( f 1.1## + 2.1# + True + 3.1## + 4.1# + 5.1## + 6.1## + 42# -- the answer! + 7.1# + 8.1# ) + where + f :: Double# -> Float# -> Bool -> Double# -> Float# + -> Double# -> Double# -> Int# -> Float# -> Float# + -> Int# + f b1 s2 t b3 s4 b5 b6 i42 s7 s8 + -- evens, then odds + = g s2 b3 b5 i42 s8 b1 t s4 b6 s7 + + g :: Float# -> Double# -> Double# -> Int# -> Float# + -> Double# -> Bool -> Float# -> Double# -> Float# + -> Int# + g s2 b3 b5 i42 s8 b1 t s4 b6 s7 + -- powers of 2 backwards, then others forwards + = h s7 b6 t b5 s2 b3 i42 s8 b1 s4 + + h :: Float# -> Double# -> Bool -> Double# -> Float# + -> Double# -> Int# -> Float# -> Double# -> Float# + -> Int# + h s7 b6 t b5 s2 b3 i42 s8 b1 s4 + = i42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg012.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg012.stdout new file mode 100644 index 0000000000..d81cc0710e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg012.stdout @@ -0,0 +1 @@ +42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg013.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg013.hs new file mode 100644 index 0000000000..4d2f06de6c --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg013.hs @@ -0,0 +1,78 @@ +{- +From: Kevin Hammond <kh> +To: partain +Subject: Nasty Overloading +Date: Wed, 23 Oct 91 16:19:46 BST +-} +module Main where + +class Foo a where + o1 :: a -> a -> Bool + o2 :: a -> Int + +-- o2 :: Int + -- Lennart: The type of method o2 does not contain the variable a + -- (and it must according to line 1 page 29 of the manual). + +class Foo tyvar => Bar tyvar where + o3 :: a -> tyvar -> tyvar + +-- class (Eq a, Foo a) => Baz a where +class (Ord a, Foo a) => Baz a where + o4 :: a -> a -> (String,String,String,a) + +instance (Ord a, Foo a) => Foo [a] where + o2 x = 100 + o1 a b = a < b || o1 (head a) (head b) + +-- instance Bar [a] where +instance (Ord a, Foo a) => Bar [a] where + o3 x l = [] + -- + -- Lennart: I guess the instance declaration + -- instance Bar [w] where + -- o3 x l = [] + -- is wrong because to be a Bar you have to be a Foo. For [w] to + -- be a Foo, w has to be Ord and Foo. But w is not Ord or Foo in + -- this instance declaration so it must be wrong. (Page 31, line + -- 7: The context c' must imply ...) + +instance Baz a => Baz [a] where + o4 [] [] = ("Nil", "Nil", "Nil", []) + o4 l1 l2 = + (if o1 l1 l2 then "Y" else "N", + if l1 == l2 then "Y" else "N", +-- if o4 (head l1) (head l2) then "Y" else "N", + case o4 (head l1) (head l2) of + (_,_,_,l3) -> if (o1 (head l1) l3) then "Y" else "N", + l1 ++ l2 ) + +instance Foo Int where + o2 x = x + o1 i j = i == j + +instance Bar Int where + o3 _ j = j + 1 + +instance Baz Int where +-- o4 i j = i > j + o4 i j = (if i>j then "Y" else "Z", "p", "q", i+j) +--simpl:o4 i j = ("Z", "p", "q", i+j) + +{- also works w/ glhc! -} + +main = if o4 [1,2,3] [1,3,2::Int] /= ("Y","N","Y",[1,2,3,1,3,2]) then + (print "43\n") + else (print "144\n") + +{- works: glhc +main = case o4 [1,2,3] [1,3,2::Int] of + (s1,s2,s3,x) -> print s1 + +main = case o4 ([]::[Int]) ([]::[Int]) of + (s1,s2,s3,x) -> print s1 +-} + +{- simple main: breaks nhc, works w/ glhc +main = case o4 (3::Int) (4::Int) of (s1,s2,s3,x) -> print s1 +-} diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg013.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg013.stdout new file mode 100644 index 0000000000..a865e6b929 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg013.stdout @@ -0,0 +1 @@ +"43\n" diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg014.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg014.hs new file mode 100644 index 0000000000..a01c1017ad --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg014.hs @@ -0,0 +1,3 @@ +-- !! cg014: main = -42 -- twice: in Float and Double + +main = print ((show ( (-42) :: Float )) ++ " " ++ (show ( (-42) :: Double )) ++ "\n") diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg014.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg014.stdout new file mode 100644 index 0000000000..6f6cbc5cba --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg014.stdout @@ -0,0 +1 @@ +"-42.0 -42.0\n" diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg015.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg015.hs new file mode 100644 index 0000000000..faa99b8f3b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg015.hs @@ -0,0 +1,25 @@ +module Main ( main ) where + +import PrelBase + +data CList = CNil | CCons Int# CList + +mk :: Int# -> CList +mk n = if (n ==# 0#) + then CNil + else CCons 1# (mk (n -# 1#)) + +clen :: CList -> Int# +clen CNil = 0# +clen (CCons _ cl) = 1# +# (clen cl) + +main = case (clen list4) of + len4 -> + case (len4 +# len4) of + 8# -> finish 65# -- 'A' + _ -> finish 66# -- 'B' + where + list4 = mk 4# + +finish :: Int# -> IO () +finish n = _ccall_ putchar (C# (chr# n)) >> return () diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg015.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg015.stdout new file mode 100644 index 0000000000..8c7e5a667f --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg015.stdout @@ -0,0 +1 @@ +A
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg016.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg016.hs new file mode 100644 index 0000000000..ba5dd04fea --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg016.hs @@ -0,0 +1,9 @@ +-- !!! tests calls of `error' (that make calls of `error'...) +-- +main = error ("1st call to error\n"++( + error ("2nd call to error\n"++( + error ("3rd call to error\n"++( + error ("4th call to error\n"++( + error ("5th call to error\n"++( + error ("6th call to error" + ))))))))))) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg016.stderr b/testsuite/tests/ghc-regress/codeGen/should_run/cg016.stderr new file mode 100644 index 0000000000..2d16aa5acd --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg016.stderr @@ -0,0 +1,2 @@ + +Fail: 6th call to error diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg016.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg016.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg016.stdout diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg017.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg017.hs new file mode 100644 index 0000000000..275eb9b31b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg017.hs @@ -0,0 +1,33 @@ +-- !!! test of cyclic default methods +-- +class Foo a where + op1 :: Fractional b => a -> b -> Bool + op2 :: Fractional b => a -> b -> Bool + op3 :: Fractional b => a -> b -> Bool + op4 :: Fractional b => a -> b -> Bool + op5 :: Fractional b => a -> b -> Bool + op6 :: Fractional b => a -> b -> Bool + + -- each depends on the next: + op1 a b = not (op2 a b) + op2 a b = not (op3 a b) + op3 a b = not (op4 a b) + op4 a b = not (op5 a b) + op5 a b = not (op6 a b) + op6 a b = not (op1 a b) + +-- now some instance decls to break the cycle: +instance Foo Int where + op1 a b = a == 42 + +instance Foo Char where + op1 a b = a == 'c' + +instance Foo a => Foo [a] where + op1 a b = null a + +-- try it: +main = do + putStr (show (op2 (3::Int) 3.14159)) + putStr (show (op2 'X' 3.14159)) + putStr (show (op2 ([]::[Char])3.14159)) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg017.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg017.stdout new file mode 100644 index 0000000000..c5b23b39d2 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg017.stdout @@ -0,0 +1 @@ +TrueTrueFalse
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg018.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg018.hs new file mode 100644 index 0000000000..da7b0523dd --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg018.hs @@ -0,0 +1,24 @@ +-- !!! test of datatype with many unboxed fields +-- +import PrelGHC( Float# ) +import PrelFloat + +main = print (selectee1 + selectee2) + +data Tfo = Tfo Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# + +yyy = (Tfo (-0.0018#) (-0.8207#) (0.5714#) + (0.2679#) (-0.5509#) (-0.7904#) + (0.9634#) (0.1517#) (0.2209#) + (0.0073#) (8.4030#) (0.6232#)) + +xxx = (Tfo (-0.8143#) (-0.5091#) (-0.2788#) + (-0.0433#) (-0.4257#) (0.9038#) + (-0.5788#) (0.7480#) (0.3246#) + (1.5227#) (6.9114#) (-7.0765#)) + +selectee1 = F# (case xxx of + Tfo _ _ _ _ _ _ _ x _ _ _ _ -> x) + +selectee2 = F# (case xxx of + Tfo _ _ y _ _ _ _ _ _ _ _ _ -> y) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg018.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg018.stdout new file mode 100644 index 0000000000..805ee30112 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg018.stdout @@ -0,0 +1 @@ +0.46920002 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg019.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg019.hs new file mode 100644 index 0000000000..242ea3b4df --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg019.hs @@ -0,0 +1,3 @@ +-- !!! printing of floating-pt numbers +-- +main = print (1.234e5 :: Float) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg019.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg019.stdout new file mode 100644 index 0000000000..9ed4dbb21c --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg019.stdout @@ -0,0 +1 @@ +123400.0 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg020.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg020.hs new file mode 100644 index 0000000000..9f4b7c64e1 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg020.hs @@ -0,0 +1,3 @@ +-- !!! reading/showing of Ints/Integers +-- +main = print ((read "-1") :: Integer) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg020.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg020.stdout new file mode 100644 index 0000000000..3a2e3f4984 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg020.stdout @@ -0,0 +1 @@ +-1 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg021.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg021.hs new file mode 100644 index 0000000000..190f8dd155 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg021.hs @@ -0,0 +1,60 @@ +-- !!! Tests garbage collection in the branch of a case +-- !!! alternative where the constructor is returned in the heap. + +{- This is also a rather stressful test for another reason. + The mutual recursion between munch and f causes lots of + closures to be built, of the form (munch n s), for some n and s. + Now, all of these closures are entered and each has as its value + the result delivere by the next; so the result is that there is + a massive chain of identical updates. + + As it turns out, they are mostly garbage, so the GC could eliminate + them (though this isn't implemented at present), but that isn't + necessarily the case. + + The only correct solution is to spot that the updates are all + updating with the same value (update frames stacked on top of each + other), and update all but one with indirections to the last + remaining one. This could be done by GC, or at the moment the + frame is pushed. + + Incidentally, hbc won't have this particular problem, because it + updates immediately. + + NOTE: [March 97] Now that stack squeezing happens when GC happens, + the stack is squished at GC. So this program uses a small stack + in a small heap (eg 4m heap 2m stack), but in a big heap (no GC) + it needs a much bigger stack (10m)! It would be better to try GC/stack + squeezing on stack oflo. +-} + +module Main where + +main = munch 100000 (inf 3) + +data Stream a + = MkStream a a a a a a a a a (Stream a) + | Empty + +inf :: Int -> Stream Int +inf n = MkStream n n n n n n n n n (inf n) + +munch :: Int -> Stream a -> IO () + +munch n Empty = return () -- error "this never happens!\n" + -- this first equation mks it non-strict in "n" + -- (NB: call the "error" makes it strict) + +munch 0 _ = putStr "I succeeded!\n" +munch n s = case (f n s) of + (True, rest) -> rest + (False, _) -> error "this never happens either\n" + +--f :: Int -> Stream a -> (Bool, [Request]) + +f n (MkStream _ _ _ _ _ _ _ _ _ rest) + = -- garbage collection *HERE*, please! + -- (forced by the closure for n-1) + (True, munch (n - 1) rest) + +-- munch and f are mutually recursive, just to be nasty diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg021.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg021.stdout new file mode 100644 index 0000000000..17203effa1 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg021.stdout @@ -0,0 +1 @@ +I succeeded! diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg022.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg022.hs new file mode 100644 index 0000000000..e69675431c --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg022.hs @@ -0,0 +1,10 @@ +-- !!! tests stack stubbing: if "f" doesn't stub "ns", +-- !!! the program has a space leak. + +module Main where + +main = f (putStr "a") + (take 1000000 (repeat True)) + (putStr "b") + +f a ns b = if last ns then a else b diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg022.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg022.stdout new file mode 100644 index 0000000000..2e65efe2a1 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg022.stdout @@ -0,0 +1 @@ +a
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg023.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg023.stdout new file mode 100644 index 0000000000..c1f22fbc23 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg023.stdout @@ -0,0 +1 @@ +False
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg024.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg024.hs new file mode 100644 index 0000000000..7a695474e5 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg024.hs @@ -0,0 +1,8 @@ +-- !!! test super-dictionary grabification +-- + +main = putStr (show (is_one (1.2::Double))) + +is_one :: RealFloat a => a -> Bool + +is_one x = x == 1.0 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg024.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg024.stdout new file mode 100644 index 0000000000..c1f22fbc23 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg024.stdout @@ -0,0 +1 @@ +False
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg025.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg025.hs new file mode 100644 index 0000000000..dae4827ae9 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg025.hs @@ -0,0 +1,23 @@ +-- !!! test various I/O Requests +-- +-- +import IO +import System +import IOExts (trace) +import RegexString +import Maybe + +main = do + prog <- getProgName + let Just (name:_) = matchRegex (mkRegex ".*(cg025.bin)") prog + hPutStr stderr (shows name "\n") + args <- getArgs + hPutStr stderr (shows args "\n") + path <- getEnv "PATH" + hPutStr stderr ("GOT PATH\n") + stdin_txt <- getContents + putStr stdin_txt + file_cts <- readFile (head args) + hPutStr stderr file_cts + trace "hello, trace" $ + catch (getEnv "__WURBLE__" >> return ()) (\ e -> error "hello, error") diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg025.stderr b/testsuite/tests/ghc-regress/codeGen/should_run/cg025.stderr new file mode 100644 index 0000000000..1a835f129e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg025.stderr @@ -0,0 +1,29 @@ +"cg025.bin" +["cg025.hs"] +GOT PATH +-- !!! test various I/O Requests +-- +-- +import IO +import System +import IOExts (trace) +import RegexString +import Maybe + +main = do + prog <- getProgName + let Just (name:_) = matchRegex (mkRegex ".*(cg025.bin)") prog + hPutStr stderr (shows name "\n") + args <- getArgs + hPutStr stderr (shows args "\n") + path <- getEnv "PATH" + hPutStr stderr ("GOT PATH\n") + stdin_txt <- getContents + putStr stdin_txt + file_cts <- readFile (head args) + hPutStr stderr file_cts + trace "hello, trace" $ + catch (getEnv "__WURBLE__" >> return ()) (\ e -> error "hello, error") +hello, trace + +Fail: hello, error diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg025.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg025.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg025.stdout diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg026.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg026.hs new file mode 100644 index 0000000000..6a6bb24c45 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg026.hs @@ -0,0 +1,250 @@ +-- !!! simple tests of primitive arrays +-- +module Main ( main ) where + +import PrelBase +import Addr +import ST +import ST +import MutableArray +import ByteArray +import Int( fromInt ) + +import Ratio +import Array + +main = putStr + (test_chars ++ "\n" ++ + test_ints ++ "\n" ++ + test_addrs ++ "\n" ++ + test_floats ++ "\n" ++ + test_doubles ++ "\n" ++ + test_ptrs ++ "\n") + + +-- Arr# Char# ------------------------------------------- +-- (main effort is in packString#) + +test_chars :: String +test_chars + = let arr# = f 1000 + in + shows (lookup_range arr# 42# 416#) "\n" + where + f :: Int -> ByteArray Int + + f size@(I# size#) + = runST ( + -- allocate an array of the specified size + newCharArray (0, (size-1)) >>= \ arr# -> + + -- fill in all elements; elem i has "i" put in it + fill_in arr# 0# (size# -# 1#) >> + + -- freeze the puppy: + freezeByteArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then return () + else writeCharArray arr_in# (I# first#) ((chr (I# first#))) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [Char] + lookup_range arr from# to# + = if (from# ># to#) + then [] + else (indexCharArray arr (I# from#)) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# Int# ------------------------------------------- + +test_ints :: String +test_ints + = let arr# = f 1000 + in + shows (lookup_range arr# 42# 416#) "\n" + where + f :: Int -> ByteArray Int + + f size@(I# size#) + = runST ( + -- allocate an array of the specified size + newIntArray (0, (size-1)) >>= \ arr# -> + + -- fill in all elements; elem i has i^2 put in it + fill_in arr# 0# (size# -# 1#) >> + + -- freeze the puppy: + freezeByteArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then return () + else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [Int] + lookup_range arr from# to# + = if (from# ># to#) + then [] + else (indexIntArray arr (I# from#)) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# Addr# ------------------------------------------- + +test_addrs :: String +test_addrs + = let arr# = f 1000 + in + shows (lookup_range arr# 42# 416#) "\n" + where + f :: Int -> ByteArray Int + + f size@(I# size#) + = runST ( + -- allocate an array of the specified size + newAddrArray (0, (size-1)) >>= \ arr# -> + + -- fill in all elements; elem i has i^2 put in it + fill_in arr# 0# (size# -# 1#) >> + + -- freeze the puppy: + freezeByteArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then return () + else writeAddrArray arr_in# (I# first#) + (A# (int2Addr# (first# *# first#))) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ] + lookup_range arr from# to# + = let + a2i (A# a#) = I# (addr2Int# a#) + in + if (from# ># to#) + then [] + else (a2i (indexAddrArray arr (I# from#))) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# Float# ------------------------------------------- + +test_floats :: String +test_floats + = let arr# = f 1000 + in + shows (lookup_range arr# 42# 416#) "\n" + where + f :: Int -> ByteArray Int + + f size@(I# size#) + = runST ( + -- allocate an array of the specified size + newFloatArray (0, (size-1)) >>= \ arr# -> + + -- fill in all elements; elem i has "i * pi" put in it + fill_in arr# 0# (size# -# 1#) >> + + -- freeze the puppy: + freezeByteArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then return () +{- else let e = ((fromInt (I# first#)) * pi) + in trace (show e) $ writeFloatArray arr_in# (I# first#) e >> + fill_in arr_in# (first# +# 1#) last# +-} + else writeFloatArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [Float] + lookup_range arr from# to# + = if (from# ># to#) + then [] + else (indexFloatArray arr (I# from#)) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# Double# ------------------------------------------- + +test_doubles :: String +test_doubles + = let arr# = f 1000 + in + shows (lookup_range arr# 42# 416#) "\n" + where + f :: Int -> ByteArray Int + + f size@(I# size#) + = runST ( + -- allocate an array of the specified size + newDoubleArray (0, (size-1)) >>= \ arr# -> + + -- fill in all elements; elem i has "i * pi" put in it + fill_in arr# 0# (size# -# 1#) >> + + -- freeze the puppy: + freezeByteArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then return () + else writeDoubleArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [Double] + lookup_range arr from# to# + = if (from# ># to#) + then [] + else (indexDoubleArray arr (I# from#)) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# (Ratio Int) (ptrs) --------------------------------- +-- just like Int# test + +test_ptrs :: String +test_ptrs + = let arr# = f 1000 + in + shows (lookup_range arr# 42 416) "\n" + where + f :: Int -> Array Int (Ratio Int) + + f size + = runST ( + newSTArray (1, size) (3 % 5) >>= \ arr# -> + -- don't fill in the whole thing + fill_in arr# 1 400 >> + freezeSTArray arr# + ) + + fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s () + + fill_in arr_in# first last + = if (first > last) + then return () + else writeSTArray arr_in# first (fromInt (first * first)) >> + fill_in arr_in# (first + 1) last + + lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int] + lookup_range array from too + = if (from > too) + then [] + else (array ! from) : (lookup_range array (from + 1) too) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg026.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg026.stdout new file mode 100644 index 0000000000..cb76dde367 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg026.stdout @@ -0,0 +1,12 @@ +"*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255\NUL\SOH\STX\ETX\EOT\ENQ\ACK\a\b\t\n\v\f\r\SO\SI\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\EM\SUB\ESC\FS\GS\RS\US !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159\160" + +[1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,16641,16900,17161,17424,17689,17956,18225,18496,18769,19044,19321,19600,19881,20164,20449,20736,21025,21316,21609,21904,22201,22500,22801,23104,23409,23716,24025,24336,24649,24964,25281,25600,25921,26244,26569,26896,27225,27556,27889,28224,28561,28900,29241,29584,29929,30276,30625,30976,31329,31684,32041,32400,32761,33124,33489,33856,34225,34596,34969,35344,35721,36100,36481,36864,37249,37636,38025,38416,38809,39204,39601,40000,40401,40804,41209,41616,42025,42436,42849,43264,43681,44100,44521,44944,45369,45796,46225,46656,47089,47524,47961,48400,48841,49284,49729,50176,50625,51076,51529,51984,52441,52900,53361,53824,54289,54756,55225,55696,56169,56644,57121,57600,58081,58564,59049,59536,60025,60516,61009,61504,62001,62500,63001,63504,64009,64516,65025,65536,66049,66564,67081,67600,68121,68644,69169,69696,70225,70756,71289,71824,72361,72900,73441,73984,74529,75076,75625,76176,76729,77284,77841,78400,78961,79524,80089,80656,81225,81796,82369,82944,83521,84100,84681,85264,85849,86436,87025,87616,88209,88804,89401,90000,90601,91204,91809,92416,93025,93636,94249,94864,95481,96100,96721,97344,97969,98596,99225,99856,100489,101124,101761,102400,103041,103684,104329,104976,105625,106276,106929,107584,108241,108900,109561,110224,110889,111556,112225,112896,113569,114244,114921,115600,116281,116964,117649,118336,119025,119716,120409,121104,121801,122500,123201,123904,124609,125316,126025,126736,127449,128164,128881,129600,130321,131044,131769,132496,133225,133956,134689,135424,136161,136900,137641,138384,139129,139876,140625,141376,142129,142884,143641,144400,145161,145924,146689,147456,148225,148996,149769,150544,151321,152100,152881,153664,154449,155236,156025,156816,157609,158404,159201,160000,160801,161604,162409,163216,164025,164836,165649,166464,167281,168100,168921,169744,170569,171396,172225,173056] + +[1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,16641,16900,17161,17424,17689,17956,18225,18496,18769,19044,19321,19600,19881,20164,20449,20736,21025,21316,21609,21904,22201,22500,22801,23104,23409,23716,24025,24336,24649,24964,25281,25600,25921,26244,26569,26896,27225,27556,27889,28224,28561,28900,29241,29584,29929,30276,30625,30976,31329,31684,32041,32400,32761,33124,33489,33856,34225,34596,34969,35344,35721,36100,36481,36864,37249,37636,38025,38416,38809,39204,39601,40000,40401,40804,41209,41616,42025,42436,42849,43264,43681,44100,44521,44944,45369,45796,46225,46656,47089,47524,47961,48400,48841,49284,49729,50176,50625,51076,51529,51984,52441,52900,53361,53824,54289,54756,55225,55696,56169,56644,57121,57600,58081,58564,59049,59536,60025,60516,61009,61504,62001,62500,63001,63504,64009,64516,65025,65536,66049,66564,67081,67600,68121,68644,69169,69696,70225,70756,71289,71824,72361,72900,73441,73984,74529,75076,75625,76176,76729,77284,77841,78400,78961,79524,80089,80656,81225,81796,82369,82944,83521,84100,84681,85264,85849,86436,87025,87616,88209,88804,89401,90000,90601,91204,91809,92416,93025,93636,94249,94864,95481,96100,96721,97344,97969,98596,99225,99856,100489,101124,101761,102400,103041,103684,104329,104976,105625,106276,106929,107584,108241,108900,109561,110224,110889,111556,112225,112896,113569,114244,114921,115600,116281,116964,117649,118336,119025,119716,120409,121104,121801,122500,123201,123904,124609,125316,126025,126736,127449,128164,128881,129600,130321,131044,131769,132496,133225,133956,134689,135424,136161,136900,137641,138384,139129,139876,140625,141376,142129,142884,143641,144400,145161,145924,146689,147456,148225,148996,149769,150544,151321,152100,152881,153664,154449,155236,156025,156816,157609,158404,159201,160000,160801,161604,162409,163216,164025,164836,165649,166464,167281,168100,168921,169744,170569,171396,172225,173056] + +[131.9469,135.08849,138.23009,141.37167,144.51326,147.65486,150.79645,153.93805,157.07964,160.22124,163.36282,166.50441,169.64601,172.7876,175.9292,179.07079,182.21237,185.35397,188.49556,191.63716,194.77875,197.92035,201.06194,204.20352,207.34512,210.48671,213.62831,216.7699,219.9115,223.05309,226.19467,229.33627,232.47786,235.61946,238.76105,241.90263,245.04424,248.18582,251.32742,254.46901,257.6106,260.7522,263.8938,267.03537,270.17697,273.31857,276.46017,279.60175,282.74335,285.88495,289.02652,292.16812,295.30972,298.45132,301.5929,304.7345,307.8761,311.01767,314.15927,317.30087,320.44247,323.58405,326.72565,329.86725,333.00882,336.15042,339.29202,342.4336,345.5752,348.7168,351.8584,354.99997,358.14157,361.28317,364.42474,367.56635,370.70795,373.84955,376.99112,380.13272,383.27432,386.4159,389.5575,392.6991,395.8407,398.98227,402.12387,405.26547,408.40704,411.54865,414.69025,417.83185,420.97342,424.11502,427.25662,430.3982,433.5398,436.6814,439.823,442.96457,446.10617,449.24777,452.38934,455.53094,458.67255,461.81415,464.95572,468.09732,471.23892,474.3805,477.5221,480.6637,483.80527,486.94687,490.08847,493.23007,496.37164,499.51324,502.65485,505.79642,508.93802,512.0796,515.2212,518.3628,521.5044,524.646,527.7876,530.9292,534.07074,537.21234,540.35394,543.49554,546.63715,549.77875,552.92035,556.0619,559.2035,562.3451,565.4867,568.6283,571.7699,574.9115,578.05304,581.19464,584.33624,587.47784,590.61945,593.76105,596.90265,600.0442,603.1858,606.3274,609.469,612.6106,615.7522,618.8938,622.03534,625.17694,628.31854,631.46014,634.60175,637.74335,640.88495,644.0265,647.1681,650.3097,653.4513,656.5929,659.7345,662.8761,666.01764,669.15924,672.30084,675.44244,678.58405,681.72565,684.8672,688.0088,691.1504,694.292,697.4336,700.5752,703.7168,706.85834,709.99994,713.14154,716.28314,719.42474,722.56635,725.70795,728.8495,731.9911,735.1327,738.2743,741.4159,744.5575,747.6991,750.84064,753.98224,757.12384,760.26544,763.40704,766.54865,769.69025,772.8318,775.9734,779.115,782.2566,785.3982,788.5398,791.6814,794.82294,797.96454,801.10614,804.24774,807.38934,810.53094,813.67255,816.8141,819.9557,823.0973,826.2389,829.3805,832.5221,835.6637,838.80524,841.94684,845.08844,848.23004,851.37164,854.51324,857.65485,860.7964,863.938,867.0796,870.2212,873.3628,876.5044,879.646,882.78754,885.92914,889.07074,892.21234,895.35394,898.49554,901.63715,904.7787,907.9203,911.0619,914.2035,917.3451,920.4867,923.6283,926.76984,929.91144,933.05304,936.19464,939.33624,942.47784,945.6194,948.761,951.9026,955.0442,958.1858,961.3274,964.469,967.61053,970.75214,973.89374,977.03534,980.17694,983.31854,986.46014,989.6017,992.7433,995.8849,999.0265,1002.1681,1005.3097,1008.4513,1011.59283,1014.73444,1017.87604,1021.01764,1024.1592,1027.3008,1030.4424,1033.584,1036.7256,1039.8672,1043.0088,1046.1504,1049.292,1052.4336,1055.5752,1058.7168,1061.8584,1065.0,1068.1415,1071.2831,1074.4247,1077.5663,1080.7079,1083.8495,1086.9911,1090.1327,1093.2743,1096.4159,1099.5575,1102.6991,1105.8407,1108.9822,1112.1238,1115.2654,1118.407,1121.5486,1124.6902,1127.8318,1130.9734,1134.115,1137.2566,1140.3982,1143.5398,1146.6814,1149.823,1152.9645,1156.1061,1159.2477,1162.3893,1165.5309,1168.6725,1171.8141,1174.9557,1178.0973,1181.2389,1184.3805,1187.5221,1190.6637,1193.8053,1196.9468,1200.0884,1203.23,1206.3716,1209.5132,1212.6548,1215.7964,1218.938,1222.0796,1225.2212,1228.3628,1231.5044,1234.646,1237.7876,1240.9291,1244.0707,1247.2123,1250.3539,1253.4955,1256.6371,1259.7787,1262.9203,1266.0619,1269.2035,1272.3451,1275.4867,1278.6283,1281.7699,1284.9114,1288.053,1291.1946,1294.3362,1297.4778,1300.6194,1303.761,1306.9026] + +[131.94689145077132,135.0884841043611,138.23007675795088,141.3716694115407,144.51326206513048,147.6548547187203,150.79644737231007,153.93804002589985,157.07963267948966,160.22122533307945,163.36281798666926,166.50441064025904,169.64600329384882,172.78759594743863,175.92918860102841,179.0707812546182,182.212373908208,185.3539665617978,188.49555921538757,191.63715186897738,194.77874452256717,197.92033717615698,201.06192982974676,204.20352248333654,207.34511513692635,210.48670779051614,213.62830044410595,216.76989309769573,219.9114857512855,223.05307840487532,226.1946710584651,229.3362637120549,232.4778563656447,235.61944901923448,238.76104167282426,241.90263432641407,245.04422698000386,248.18581963359367,251.32741228718345,254.46900494077323,257.610597594363,260.75219024795285,263.89378290154264,267.0353755551324,270.1769682087222,273.318560862312,276.46015351590177,279.6017461694916,282.7433388230814,285.88493147667117,289.02652413026095,292.16811678385073,295.3097094374406,298.45130209103036,301.59289474462014,304.7344873982099,307.8760800517997,311.01767270538954,314.1592653589793,317.3008580125691,320.4424506661589,323.5840433197487,326.7256359733385,329.8672286269283,333.0088212805181,336.15041393410786,339.29200658769764,342.4335992412874,345.57519189487726,348.71678454846705,351.85837720205683,354.9999698556466,358.1415625092364,361.28315516282623,364.424747816416,367.5663404700058,370.7079331235956,373.84952577718536,376.99111843077515,380.132711084365,383.27430373795477,386.41589639154455,389.55748904513433,392.6990816987241,395.84067435231395,398.98226700590374,402.1238596594935,405.2654523130833,408.4070449666731,411.5486376202629,414.6902302738527,417.8318229274425,420.97341558103227,424.11500823462205,427.2566008882119,430.3981935418017,433.53978619539146,436.68137884898124,439.822971502571,442.9645641561608,446.10615680975064,449.2477494633404,452.3893421169302,455.53093477052,458.6725274241098,461.8141200776996,464.9557127312894,468.0973053848792,471.23889803846896,474.38049069205874,477.5220833456485,480.66367599923836,483.80526865282815,486.94686130641793,490.0884539600077,493.2300466135975,496.37163926718733,499.5132319207771,502.6548245743669,505.7964172279567,508.93800988154646,512.0796025351362,515.221195188726,518.3627878423158,521.5043804959057,524.6459731494955,527.7875658030853,530.929158456675,534.0707511102648,537.2123437638546,540.3539364174444,543.4955290710342,546.637121724624,549.7787143782137,552.9203070318035,556.0618996853934,559.2034923389832,562.345084992573,565.4866776461628,568.6282702997526,571.7698629533423,574.9114556069321,578.0530482605219,581.1946409141117,584.3362335677015,587.4778262212914,590.6194188748811,593.7610115284709,596.9026041820607,600.0441968356505,603.1857894892403,606.3273821428301,609.4689747964198,612.6105674500096,615.7521601035994,618.8937527571892,622.0353454107791,625.1769380643689,628.3185307179587,631.4601233715484,634.6017160251382,637.743308678728,640.8849013323178,644.0264939859076,647.1680866394973,650.3096792930871,653.451271946677,656.5928646002668,659.7344572538566,662.8760499074464,666.0176425610362,669.1592352146259,672.3008278682157,675.4424205218055,678.5840131753953,681.7256058289851,684.8671984825748,688.0087911361647,691.1503837897545,694.2919764433443,697.4335690969341,700.5751617505239,703.7167544041137,706.8583470577034,709.9999397112932,713.141532364883,716.2831250184728,719.4247176720626,722.5663103256525,725.7079029792422,728.849495632832,731.9910882864218,735.1326809400116,738.2742735936014,741.4158662471912,744.557458900781,747.6990515543707,750.8406442079605,753.9822368615503,757.1238295151402,760.26542216873,763.4070148223198,766.5486074759095,769.6902001294993,772.8317927830891,775.9733854366789,779.1149780902687,782.2565707438584,785.3981633974482,788.5397560510381,791.6813487046279,794.8229413582177,797.9645340118075,801.1061266653973,804.247719318987,807.3893119725768,810.5309046261666,813.6724972797564,816.8140899333462,819.955682586936,823.0972752405258,826.2388678941156,829.3804605477054,832.5220532012952,835.663645854885,838.8052385084748,841.9468311620645,845.0884238156543,848.2300164692441,851.3716091228339,854.5132017764238,857.6547944300136,860.7963870836033,863.9379797371931,867.0795723907829,870.2211650443727,873.3627576979625,876.5043503515523,879.645943005142,882.7875356587318,885.9291283123216,889.0707209659115,892.2123136195013,895.3539062730911,898.4954989266809,901.6370915802706,904.7786842338604,907.9202768874502,911.06186954104,914.2034621946298,917.3450548482195,920.4866475018093,923.6282401553992,926.769832808989,929.9114254625788,933.0530181161686,936.1946107697584,939.3362034233481,942.4777960769379,945.6193887305277,948.7609813841175,951.9025740377073,955.044166691297,958.185759344887,961.3273519984767,964.4689446520665,967.6105373056563,970.7521299592461,973.8937226128359,977.0353152664256,980.1769079200154,983.3185005736052,986.460093227195,989.6016858807849,992.7432785343747,995.8848711879644,999.0264638415542,1002.168056495144,1005.3096491487338,1008.4512418023236,1011.5928344559134,1014.7344271095031,1017.8760197630929,1021.0176124166827,1024.1592050702725,1027.3007977238624,1030.442390377452,1033.583983031042,1036.7255756846316,1039.8671683382215,1043.0087609918114,1046.150353645401,1049.291946298991,1052.4335389525806,1055.5751316061705,1058.7167242597602,1061.85831691335,1064.9999095669398,1068.1415022205297,1071.2830948741193,1074.4246875277092,1077.5662801812991,1080.7078728348888,1083.8494654884787,1086.9910581420684,1090.1326507956583,1093.274243449248,1096.4158361028378,1099.5574287564275,1102.6990214100174,1105.840614063607,1108.982206717197,1112.1237993707869,1115.2653920243765,1118.4069846779664,1121.548577331556,1124.690169985146,1127.8317626387357,1130.9733552923256,1134.1149479459152,1137.2565405995051,1140.398133253095,1143.5397259066847,1146.6813185602746,1149.8229112138642,1152.9645038674541,1156.1060965210438,1159.2476891746337,1162.3892818282234,1165.5308744818133,1168.672467135403,1171.8140597889928,1174.9556524425827,1178.0972450961724,1181.2388377497623,1184.380430403352,1187.5220230569419,1190.6636157105315,1193.8052083641214,1196.946801017711,1200.088393671301,1203.2299863248907,1206.3715789784806,1209.5131716320705,1212.6547642856601,1215.79635693925,1218.9379495928397,1222.0795422464296,1225.2211349000193,1228.3627275536091,1231.5043202071988,1234.6459128607887,1237.7875055143784,1240.9290981679683,1244.0706908215582,1247.2122834751478,1250.3538761287377,1253.4954687823274,1256.6370614359173,1259.778654089507,1262.9202467430969,1266.0618393966865,1269.2034320502764,1272.345024703866,1275.486617357456,1278.628210011046,1281.7698026646356,1284.9113953182255,1288.0529879718151,1291.194580625405,1294.3361732789947,1297.4777659325846,1300.6193585861743,1303.7609512397642,1306.902543893354] + +[1764 % 1,1849 % 1,1936 % 1,2025 % 1,2116 % 1,2209 % 1,2304 % 1,2401 % 1,2500 % 1,2601 % 1,2704 % 1,2809 % 1,2916 % 1,3025 % 1,3136 % 1,3249 % 1,3364 % 1,3481 % 1,3600 % 1,3721 % 1,3844 % 1,3969 % 1,4096 % 1,4225 % 1,4356 % 1,4489 % 1,4624 % 1,4761 % 1,4900 % 1,5041 % 1,5184 % 1,5329 % 1,5476 % 1,5625 % 1,5776 % 1,5929 % 1,6084 % 1,6241 % 1,6400 % 1,6561 % 1,6724 % 1,6889 % 1,7056 % 1,7225 % 1,7396 % 1,7569 % 1,7744 % 1,7921 % 1,8100 % 1,8281 % 1,8464 % 1,8649 % 1,8836 % 1,9025 % 1,9216 % 1,9409 % 1,9604 % 1,9801 % 1,10000 % 1,10201 % 1,10404 % 1,10609 % 1,10816 % 1,11025 % 1,11236 % 1,11449 % 1,11664 % 1,11881 % 1,12100 % 1,12321 % 1,12544 % 1,12769 % 1,12996 % 1,13225 % 1,13456 % 1,13689 % 1,13924 % 1,14161 % 1,14400 % 1,14641 % 1,14884 % 1,15129 % 1,15376 % 1,15625 % 1,15876 % 1,16129 % 1,16384 % 1,16641 % 1,16900 % 1,17161 % 1,17424 % 1,17689 % 1,17956 % 1,18225 % 1,18496 % 1,18769 % 1,19044 % 1,19321 % 1,19600 % 1,19881 % 1,20164 % 1,20449 % 1,20736 % 1,21025 % 1,21316 % 1,21609 % 1,21904 % 1,22201 % 1,22500 % 1,22801 % 1,23104 % 1,23409 % 1,23716 % 1,24025 % 1,24336 % 1,24649 % 1,24964 % 1,25281 % 1,25600 % 1,25921 % 1,26244 % 1,26569 % 1,26896 % 1,27225 % 1,27556 % 1,27889 % 1,28224 % 1,28561 % 1,28900 % 1,29241 % 1,29584 % 1,29929 % 1,30276 % 1,30625 % 1,30976 % 1,31329 % 1,31684 % 1,32041 % 1,32400 % 1,32761 % 1,33124 % 1,33489 % 1,33856 % 1,34225 % 1,34596 % 1,34969 % 1,35344 % 1,35721 % 1,36100 % 1,36481 % 1,36864 % 1,37249 % 1,37636 % 1,38025 % 1,38416 % 1,38809 % 1,39204 % 1,39601 % 1,40000 % 1,40401 % 1,40804 % 1,41209 % 1,41616 % 1,42025 % 1,42436 % 1,42849 % 1,43264 % 1,43681 % 1,44100 % 1,44521 % 1,44944 % 1,45369 % 1,45796 % 1,46225 % 1,46656 % 1,47089 % 1,47524 % 1,47961 % 1,48400 % 1,48841 % 1,49284 % 1,49729 % 1,50176 % 1,50625 % 1,51076 % 1,51529 % 1,51984 % 1,52441 % 1,52900 % 1,53361 % 1,53824 % 1,54289 % 1,54756 % 1,55225 % 1,55696 % 1,56169 % 1,56644 % 1,57121 % 1,57600 % 1,58081 % 1,58564 % 1,59049 % 1,59536 % 1,60025 % 1,60516 % 1,61009 % 1,61504 % 1,62001 % 1,62500 % 1,63001 % 1,63504 % 1,64009 % 1,64516 % 1,65025 % 1,65536 % 1,66049 % 1,66564 % 1,67081 % 1,67600 % 1,68121 % 1,68644 % 1,69169 % 1,69696 % 1,70225 % 1,70756 % 1,71289 % 1,71824 % 1,72361 % 1,72900 % 1,73441 % 1,73984 % 1,74529 % 1,75076 % 1,75625 % 1,76176 % 1,76729 % 1,77284 % 1,77841 % 1,78400 % 1,78961 % 1,79524 % 1,80089 % 1,80656 % 1,81225 % 1,81796 % 1,82369 % 1,82944 % 1,83521 % 1,84100 % 1,84681 % 1,85264 % 1,85849 % 1,86436 % 1,87025 % 1,87616 % 1,88209 % 1,88804 % 1,89401 % 1,90000 % 1,90601 % 1,91204 % 1,91809 % 1,92416 % 1,93025 % 1,93636 % 1,94249 % 1,94864 % 1,95481 % 1,96100 % 1,96721 % 1,97344 % 1,97969 % 1,98596 % 1,99225 % 1,99856 % 1,100489 % 1,101124 % 1,101761 % 1,102400 % 1,103041 % 1,103684 % 1,104329 % 1,104976 % 1,105625 % 1,106276 % 1,106929 % 1,107584 % 1,108241 % 1,108900 % 1,109561 % 1,110224 % 1,110889 % 1,111556 % 1,112225 % 1,112896 % 1,113569 % 1,114244 % 1,114921 % 1,115600 % 1,116281 % 1,116964 % 1,117649 % 1,118336 % 1,119025 % 1,119716 % 1,120409 % 1,121104 % 1,121801 % 1,122500 % 1,123201 % 1,123904 % 1,124609 % 1,125316 % 1,126025 % 1,126736 % 1,127449 % 1,128164 % 1,128881 % 1,129600 % 1,130321 % 1,131044 % 1,131769 % 1,132496 % 1,133225 % 1,133956 % 1,134689 % 1,135424 % 1,136161 % 1,136900 % 1,137641 % 1,138384 % 1,139129 % 1,139876 % 1,140625 % 1,141376 % 1,142129 % 1,142884 % 1,143641 % 1,144400 % 1,145161 % 1,145924 % 1,146689 % 1,147456 % 1,148225 % 1,148996 % 1,149769 % 1,150544 % 1,151321 % 1,152100 % 1,152881 % 1,153664 % 1,154449 % 1,155236 % 1,156025 % 1,156816 % 1,157609 % 1,158404 % 1,159201 % 1,160000 % 1,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5,3 % 5] + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg027.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg027.hs new file mode 100644 index 0000000000..646d05c38b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg027.hs @@ -0,0 +1,13 @@ +-- !!! simple test of 0-method classes +-- + +class (Num a, Integral a) => Foo a + +main = putStr (shows (f ((fromInteger 21)::Int) + ((fromInteger 37))) "\n") + +instance Foo Int + +f :: Foo a => a -> a -> Integer + +f a b = toInteger (a + b) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg027.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg027.stdout new file mode 100644 index 0000000000..8c61d23e12 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg027.stdout @@ -0,0 +1 @@ +58 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg028.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg028.hs new file mode 100644 index 0000000000..3fa877cdb8 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg028.hs @@ -0,0 +1,10 @@ +main = putStr (shows (f (read "42.0")) "\n") + +-- f compiled to bogus code with ghc 0.18 and earlier +-- switch() on a DoubleReg + +f :: Double -> Int +f 1.0 = 1 +f 2.0 = 2 +f 3.0 = 3 +f x = round x diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg028.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg028.stdout new file mode 100644 index 0000000000..d81cc0710e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg028.stdout @@ -0,0 +1 @@ +42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg029.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg029.hs new file mode 100644 index 0000000000..faa9f2f35a --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg029.hs @@ -0,0 +1,15 @@ +module Main(main) where + +-- In 0.19, we lost the ability to do ccalls with more than 6 arguments +-- on the Sparc. Just to make sure it never happens again... + +import CString + +main = + _ccall_ printf (packString "Testing %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n") + (01::Int) (02::Int) (03::Int) (04::Int) (05::Int) (06::Int) (07::Int) (08::Int) + (11::Int) (12::Int) (13::Int) (14::Int) (15::Int) (16::Int) (17::Int) (18::Int) + (21::Int) (22::Int) (23::Int) (24::Int) (25::Int) (26::Int) (27::Int) (28::Int) + (31::Int) (32::Int) (33::Int) (34::Int) (35::Int) (36::Int) (37::Int) (38::Int) + >> + return () diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg029.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg029.stdout new file mode 100644 index 0000000000..d00a3d3c36 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg029.stdout @@ -0,0 +1 @@ +Testing 1 2 3 4 5 6 7 8 11 12 13 14 15 16 17 18 21 22 23 24 25 26 27 28 31 32 33 34 35 36 37 38 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg030.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg030.hs new file mode 100644 index 0000000000..62ca02543d --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg030.hs @@ -0,0 +1,6 @@ +module PrelMain(mainIO) where + +import ST +import CString + +mainIO = _ccall_ puts (packString "123\n") >> return () diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg030.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg030.stdout new file mode 100644 index 0000000000..cc12087def --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg030.stdout @@ -0,0 +1,2 @@ +123 + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg031.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg031.hs new file mode 100644 index 0000000000..2aa3c26b7f --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg031.hs @@ -0,0 +1,43 @@ +-- !! test GEN reps w/ unboxed values in them +-- !! NB: it was the static ones that were hosed... +-- +module Main ( main ) where + +import PrelBase + +main = do + putStr (shows (sum ([1..1{-30-}]++[1..1{-40-}]++[11,22])) "\n") + putStr (shows (prog 1{-30-} 1{-40-}) "\n") + +data Foo a + = MkFoo [a] Int# [Int] Int# [(a,Int)] Int# + -- The above will cause a *horrible* GEN rep'n. + +prog :: Int -> Int -> Int + +prog size_1 size_2 + = let + list1 = static1 : (map mk_foo [1 .. size_1]) + list2 = static2 : (map mk_foo [1 .. size_2]) + in + I# (add_up 0# list1 (reverse list2)) + +static1 = MkFoo (error "static11") 11# [] 11# (error "static12") 11# +static2 = MkFoo (error "static21") 22# [] 22# (error "static22") 22# + +one, two :: Int +one = 1; two = 2 + +mk_foo i@(I# i#) + = MkFoo (error "list1") i# [i,i] i# (error "list2") i# + +add_up :: Int# -> [Foo a] -> [Foo a] -> Int# + +add_up acc [] [] = acc +add_up acc [] ys = add_up acc ys [] +add_up acc (x:xs) (y:ys) = add_up (acc +# add x y) xs ys +add_up acc (x:xs) [] = add_up acc xs [] + +add :: Foo a -> Foo a -> Int# +add (MkFoo _ _ _ _ _ x) (MkFoo _ _ _ _ _ y) + = x +# y diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg031.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg031.stdout new file mode 100644 index 0000000000..a91166f4a3 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg031.stdout @@ -0,0 +1,2 @@ +35 +35 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg032.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg032.hs new file mode 100644 index 0000000000..b61feb8c2b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg032.hs @@ -0,0 +1,20 @@ +-- !! pattern-matching failure on functions that return Int# + +import PrelBase --ghc1.3 + +main = putStr (shows (I# (foo bar1 bar2)) "\n") + where + bar1 = Bar1 40 (39,38) resps + bar2 = Bar1 2 ( 1, 0) resps + resps = error "1.2 responses" + +data Response = Response -- stub + +data Bar + = Bar1 Int (Int,Int) [Response] + | Bar2 Int Int# + | Bar3 Int + +foo :: Bar -> Bar -> Int# + +foo (Bar1 (I# i) _ _) (Bar1 (I# j) _ _) = i +# j diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg032.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg032.stdout new file mode 100644 index 0000000000..d81cc0710e --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg032.stdout @@ -0,0 +1 @@ +42 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg033.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg033.hs new file mode 100644 index 0000000000..8b333a017a --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg033.hs @@ -0,0 +1,77 @@ +-- !! worker/wrapper turns ( \ <absent> -> Int# ) function +-- !! into Int# -- WRONG + +import PrelBase --ghc1.3 + +main = putStr (shows true_or_false "\n") + where + true_or_false + = case (cmp_name True imp1 imp2) of + -1# -> False + 0# -> True + 1# -> False + + imp1 = Imp s "Imp1" s s + imp2 = Imp s "Imp2" s s + + s = "String!" + +-- taken from compiler: basicTypes/ProtoName.lhs + +cmp_name :: Bool -> ProtoName -> ProtoName -> Int# + +cmp_name by_local (Unk n1) (Unk n2) = cmpString n1 n2 +cmp_name by_local (Unk n1) (Imp m n2 _ o2) = cmpString n1 (if by_local then o2 else n2) +cmp_name by_local (Unk n1) (Prel nm) + = let (_, n2) = getOrigName nm in + cmpString n1 n2 + +cmp_name by_local (Prel n1) (Prel n2) = cmpName n1 n2 + +cmp_name True (Imp _ _ _ o1) (Imp _ _ _ o2) = cmpString o1 o2 + +cmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _) + = case cmpString n1 n2 of { + -1# -> -1#; + 0# -> case cmpString m1 m2 of { + 0# -> 0#; + xxx -> if null m1 || null m2 + then 0# + else xxx + }; + _ -> 1# + } + +cmp_name True (Imp _ _ _ o1) (Prel nm) + = let + (_, n2) = getOrigName nm + in + cmpString o1 n2 + +cmp_name False (Imp m1 n1 _ _) (Prel nm) + = case getOrigName nm of { (m2, n2) -> + case cmpString n1 n2 of { -1# -> -1#; 0# -> cmpString m1 m2; _ -> 1# }} + +cmp_name by_local other_p1 other_p2 + = case cmp_name by_local other_p2 other_p1 of -- compare the other way around + -1# -> 1# + 0# -> 0# + _ -> -1# + +data ProtoName + = Unk String -- local name in module + + | Imp String -- name of defining module + String -- name used in defining name + String -- name of the module whose interface told me + -- about this thing + String -- occurrence name + + | Prel String{-Name-} + +cmpString, cmpName :: String -> String -> Int# +cmpString a b = 0# +cmpName = cmpString + +getOrigName :: String -> (String, String) +getOrigName x = ("MODULE", x) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg033.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg033.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg033.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg034.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg034.hs new file mode 100644 index 0000000000..d1016d325a --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg034.hs @@ -0,0 +1,161 @@ +-- !! fromRational woes +import Ratio -- 1.3 + +main = putStr ( + shows tinyFloat ( '\n' + : shows t_f ( '\n' + : shows hugeFloat ( '\n' + : shows h_f ( '\n' + : shows tinyDouble ( '\n' + : shows t_d ( '\n' + : shows hugeDouble ( '\n' + : shows h_d ( '\n' + : shows x_f ( '\n' + : shows x_d ( '\n' + : shows y_f ( '\n' + : shows y_d ( "\n" + ))))))))))))) + where + t_f :: Float + t_d :: Double + h_f :: Float + h_d :: Double + x_f :: Float + x_d :: Double + y_f :: Float + y_d :: Double + t_f = fromRationalX (toRational tinyFloat) + t_d = fromRationalX (toRational tinyDouble) + h_f = fromRationalX (toRational hugeFloat) + h_d = fromRationalX (toRational hugeDouble) + x_f = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational) + x_d = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational) + y_f = 1.82173691287639817263897126389712638972163e-300 + y_d = 1.82173691287639817263897126389712638972163e-300 + +fromRationalX :: (RealFloat a) => Rational -> a +fromRationalX r = + let + h = ceiling (huge `asTypeOf` x) + b = toInteger (floatRadix x) + x = fromRat 0 r + fromRat e0 r' = + let d = denominator r' + n = numerator r' + in if d > h then + let e = integerLogBase b (d `div` h) + 1 + in fromRat (e0-e) (n % (d `div` (b^e))) + else if abs n > h then + let e = integerLogBase b (abs n `div` h) + 1 + in fromRat (e0+e) ((n `div` (b^e)) % d) + else + scaleFloat e0 (rationalToRealFloat {-fromRational-} r') + in x + +{- +fromRationalX r = + rationalToRealFloat r +{- Hmmm... + let + h = ceiling (huge `asTypeOf` x) + b = toInteger (floatRadix x) + x = fromRat 0 r + + fromRat e0 r' = +{--} trace (shows e0 ('/' : shows r' ('/' : shows h "\n"))) ( + let d = denominator r' + n = numerator r' + in if d > h then + let e = integerLogBase b (d `div` h) + 1 + in fromRat (e0-e) (n % (d `div` (b^e))) + else if abs n > h then + let e = integerLogBase b (abs n `div` h) + 1 + in fromRat (e0+e) ((n `div` (b^e)) % d) + else + scaleFloat e0 (rationalToRealFloat r') + -- now that we know things are in-bounds, + -- we use the "old" Prelude code. +{--} ) + in x +-} +-} + +-- Compute the discrete log of i in base b. +-- Simplest way would be just divide i by b until it's smaller then b, but that would +-- be very slow! We are just slightly more clever. +integerLogBase :: Integer -> Integer -> Int +integerLogBase b i = + if i < b then + 0 + else + -- Try squaring the base first to cut down the number of divisions. + let l = 2 * integerLogBase (b*b) i + doDiv :: Integer -> Int -> Int + doDiv i l = if i < b then l else doDiv (i `div` b) (l+1) + in doDiv (i `div` (b^l)) l + + +------------ + +-- Compute smallest and largest floating point values. +tiny :: (RealFloat a) => a +tiny = + let (l, _) = floatRange x + x = encodeFloat 1 (l-1) + in x + +huge :: (RealFloat a) => a +huge = + let (_, u) = floatRange x + d = floatDigits x + x = encodeFloat (floatRadix x ^ d - 1) (u - d) + in x + +tinyDouble = tiny :: Double +tinyFloat = tiny :: Float +hugeDouble = huge :: Double +hugeFloat = huge :: Float + +{- +[In response to a request by simonpj, Joe Fasel writes:] + +A quite reasonable request! This code was added to the Prelude just +before the 1.2 release, when Lennart, working with an early version +of hbi, noticed that (read . show) was not the identity for +floating-point numbers. (There was a one-bit error about half the time.) +The original version of the conversion function was in fact simply +a floating-point divide, as you suggest above. The new version is, +I grant you, somewhat denser. + +How's this? + +--Joe +-} + + +rationalToRealFloat :: (RealFloat a) => Rational -> a + +rationalToRealFloat x = x' + where x' = f e + +-- If the exponent of the nearest floating-point number to x +-- is e, then the significand is the integer nearest xb^(-e), +-- where b is the floating-point radix. We start with a good +-- guess for e, and if it is correct, the exponent of the +-- floating-point number we construct will again be e. If +-- not, one more iteration is needed. + + f e = if e' == e then y else f e' + where y = encodeFloat (round (x * (1%b)^^e)) e + (_,e') = decodeFloat y + b = floatRadix x' + +-- We obtain a trial exponent by doing a floating-point +-- division of x's numerator by its denominator. The +-- result of this division may not itself be the ultimate +-- result, because of an accumulation of three rounding +-- errors. + + (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' + / fromInteger (denominator x)) + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg034.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg034.stdout new file mode 100644 index 0000000000..0c2be1c979 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg034.stdout @@ -0,0 +1,12 @@ +1.1754944e-38 +1.1754944e-38 +3.4028235e38 +3.4028235e38 +2.2250738585072014e-308 +2.2250738585072014e-308 +1.7976931348623157e308 +1.7976931348623157e308 +0.0 +1.821736912876398e-300 +0.0 +1.821736912876398e-300 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg035.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg035.hs new file mode 100644 index 0000000000..7b7b7d011c --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg035.hs @@ -0,0 +1,17 @@ +{-# OPTIONS -optc-DNON_POSIX_SOURCE #-} + +-- The above option is required because 'erf' isn't a POSIX function, and we +-- need a prototype for it in order to compile the following code correctly. +-- Defining NON_POSIX_SOURCE tells the RTS not to define _POSIX_SOURCE. + +module Main (main) where + +import IOExts ( unsafePerformIO ) + +po :: Double -> Double +po rd = 0.5 + 0.5 * erf ((rd / 1.04) / sqrt 2) + where + erf :: Double -> Double + erf x = unsafePerformIO (_ccall_ erf x) + +main = putStr (shows (po 2.0) "\n") diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg035.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg035.stdout new file mode 100644 index 0000000000..a00e9a29ee --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg035.stdout @@ -0,0 +1 @@ +0.9727648049862613 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg036.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg036.hs new file mode 100644 index 0000000000..40bfa74328 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg036.hs @@ -0,0 +1,16 @@ +-- !! Won't compile unless the compile succeeds on +-- !! the "single occurrence of big thing in a duplicated small thing" +-- !! inlining old-chestnut. WDP 95/03 +-- +module Main ( main, g ) where + +main = putStr (shows (g 42 45 45) "\n") + +g :: Int -> Int -> Int -> [Int] + +g x y z + = let + f a b = a + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + g c = f c c + in + [g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y] diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg036.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg036.stdout new file mode 100644 index 0000000000..7b74638be6 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg036.stdout @@ -0,0 +1 @@ +[1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425,1276425,1037862,1276425] diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg037.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg037.hs new file mode 100644 index 0000000000..9c16f37962 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg037.hs @@ -0,0 +1,6 @@ +-- Andy Gill bug report 95/08: +-- Constant strings with '\0' in them don't work :- +-- +main = putStrLn "hello\0 world" +--main = putStrLn "hello0 world" + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg037.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg037.stdout Binary files differnew file mode 100644 index 0000000000..fa50190f4c --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg037.stdout diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg038.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg038.hs new file mode 100644 index 0000000000..57669c6d29 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg038.hs @@ -0,0 +1,13 @@ +{- +From: Rajiv Mirani <mirani> +Date: Sat, 26 Aug 95 21:14:47 -0400 +Subject: GHC bug + +GHC can't parse the following program when there is no newline at the +end of the last line: +-} + +module Main where +main :: IO () +main = return () +-- random comment
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg038.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg038.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg038.stdout diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg039.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg039.hs new file mode 100644 index 0000000000..b7b301794d --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg039.hs @@ -0,0 +1,14 @@ +-- !!! From a Rick Morgan bug report: +-- !!! Single-method class with a locally-polymorphic +-- !!! method. + +module Main where + +class Poly a where + poly :: a -> b -> b + +instance Poly [a] where + poly [] y = y + poly x y = y + +main = print ("hurrah" `poly` "Hello, world!\n") diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg039.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg039.stdout new file mode 100644 index 0000000000..1c2d5d620b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg039.stdout @@ -0,0 +1 @@ +"Hello, world!\n" diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg040.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg040.hs new file mode 100644 index 0000000000..d747d4ab8b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg040.hs @@ -0,0 +1,16 @@ +module Main(main) where + +data Burble a = B1 { op1 :: a -> Int, op2 :: Int -> a, op3 :: Int} + | B2 { op2 :: Int -> a, op4 :: Int -> Int } + + +f1 :: Int -> Burble Int +f1 n = B1 { op1 = \x->x+n, op2 = \x -> x, op3 = n } + +f2 :: Burble a -> Int -> Int +f2 r@(B1 {op1 = op1 , op2 = op2 }) n = op1 (op2 n) + op3 r + +f3 :: Burble a -> Burble a +f3 x@(B1 {op3=op3}) = x {op3 = op3+1} + +main = print (f2 (f3 (f1 3)) 4) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg040.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg040.stdout new file mode 100644 index 0000000000..b4de394767 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg040.stdout @@ -0,0 +1 @@ +11 diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg042.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg042.hs new file mode 100644 index 0000000000..3371be420b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg042.hs @@ -0,0 +1,52 @@ +-- !!! mutable Double array test (ncg test) +-- +module Main ( main ) where + +import PrelBase --ghc1.3 +import IOExts +import ByteArray +import MutableArray +import ST +import Int( fromInt ) + +import Ratio -- 1.3 +import Array -- 1.3 + +main = --primIOToIO (newDoubleArray (0,1) >>= \ arr -> readDoubleArray arr 0) >>= print + putStr test_doubles + + +test_doubles :: String +test_doubles + = let arr# = f 1000 + in + shows (lookup_range arr# 42# 416#) "\n" + where + f :: Int -> ByteArray Int + + f size@(I# size#) + = runST ( + -- allocate an array of the specified size + newDoubleArray (0, (size-1)) >>= \ arr# -> + + -- fill in all elements; elem i has "i * pi" put in it + fill_in arr# 0# (size# -# 1#) >> + + -- freeze the puppy: + freezeByteArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then return () + else writeDoubleArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [Double] + lookup_range arr from# to# + = if (from# ># to#) + then [] + else (indexDoubleArray arr (I# from#)) + : (lookup_range arr (from# +# 1#) to#) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg042.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg042.stdout new file mode 100644 index 0000000000..7f606f75cd --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg042.stdout @@ -0,0 +1 @@ +[131.94689145077132,135.0884841043611,138.23007675795088,141.3716694115407,144.51326206513048,147.6548547187203,150.79644737231007,153.93804002589985,157.07963267948966,160.22122533307945,163.36281798666926,166.50441064025904,169.64600329384882,172.78759594743863,175.92918860102841,179.0707812546182,182.212373908208,185.3539665617978,188.49555921538757,191.63715186897738,194.77874452256717,197.92033717615698,201.06192982974676,204.20352248333654,207.34511513692635,210.48670779051614,213.62830044410595,216.76989309769573,219.9114857512855,223.05307840487532,226.1946710584651,229.3362637120549,232.4778563656447,235.61944901923448,238.76104167282426,241.90263432641407,245.04422698000386,248.18581963359367,251.32741228718345,254.46900494077323,257.610597594363,260.75219024795285,263.89378290154264,267.0353755551324,270.1769682087222,273.318560862312,276.46015351590177,279.6017461694916,282.7433388230814,285.88493147667117,289.02652413026095,292.16811678385073,295.3097094374406,298.45130209103036,301.59289474462014,304.7344873982099,307.8760800517997,311.01767270538954,314.1592653589793,317.3008580125691,320.4424506661589,323.5840433197487,326.7256359733385,329.8672286269283,333.0088212805181,336.15041393410786,339.29200658769764,342.4335992412874,345.57519189487726,348.71678454846705,351.85837720205683,354.9999698556466,358.1415625092364,361.28315516282623,364.424747816416,367.5663404700058,370.7079331235956,373.84952577718536,376.99111843077515,380.132711084365,383.27430373795477,386.41589639154455,389.55748904513433,392.6990816987241,395.84067435231395,398.98226700590374,402.1238596594935,405.2654523130833,408.4070449666731,411.5486376202629,414.6902302738527,417.8318229274425,420.97341558103227,424.11500823462205,427.2566008882119,430.3981935418017,433.53978619539146,436.68137884898124,439.822971502571,442.9645641561608,446.10615680975064,449.2477494633404,452.3893421169302,455.53093477052,458.6725274241098,461.8141200776996,464.9557127312894,468.0973053848792,471.23889803846896,474.38049069205874,477.5220833456485,480.66367599923836,483.80526865282815,486.94686130641793,490.0884539600077,493.2300466135975,496.37163926718733,499.5132319207771,502.6548245743669,505.7964172279567,508.93800988154646,512.0796025351362,515.221195188726,518.3627878423158,521.5043804959057,524.6459731494955,527.7875658030853,530.929158456675,534.0707511102648,537.2123437638546,540.3539364174444,543.4955290710342,546.637121724624,549.7787143782137,552.9203070318035,556.0618996853934,559.2034923389832,562.345084992573,565.4866776461628,568.6282702997526,571.7698629533423,574.9114556069321,578.0530482605219,581.1946409141117,584.3362335677015,587.4778262212914,590.6194188748811,593.7610115284709,596.9026041820607,600.0441968356505,603.1857894892403,606.3273821428301,609.4689747964198,612.6105674500096,615.7521601035994,618.8937527571892,622.0353454107791,625.1769380643689,628.3185307179587,631.4601233715484,634.6017160251382,637.743308678728,640.8849013323178,644.0264939859076,647.1680866394973,650.3096792930871,653.451271946677,656.5928646002668,659.7344572538566,662.8760499074464,666.0176425610362,669.1592352146259,672.3008278682157,675.4424205218055,678.5840131753953,681.7256058289851,684.8671984825748,688.0087911361647,691.1503837897545,694.2919764433443,697.4335690969341,700.5751617505239,703.7167544041137,706.8583470577034,709.9999397112932,713.141532364883,716.2831250184728,719.4247176720626,722.5663103256525,725.7079029792422,728.849495632832,731.9910882864218,735.1326809400116,738.2742735936014,741.4158662471912,744.557458900781,747.6990515543707,750.8406442079605,753.9822368615503,757.1238295151402,760.26542216873,763.4070148223198,766.5486074759095,769.6902001294993,772.8317927830891,775.9733854366789,779.1149780902687,782.2565707438584,785.3981633974482,788.5397560510381,791.6813487046279,794.8229413582177,797.9645340118075,801.1061266653973,804.247719318987,807.3893119725768,810.5309046261666,813.6724972797564,816.8140899333462,819.955682586936,823.0972752405258,826.2388678941156,829.3804605477054,832.5220532012952,835.663645854885,838.8052385084748,841.9468311620645,845.0884238156543,848.2300164692441,851.3716091228339,854.5132017764238,857.6547944300136,860.7963870836033,863.9379797371931,867.0795723907829,870.2211650443727,873.3627576979625,876.5043503515523,879.645943005142,882.7875356587318,885.9291283123216,889.0707209659115,892.2123136195013,895.3539062730911,898.4954989266809,901.6370915802706,904.7786842338604,907.9202768874502,911.06186954104,914.2034621946298,917.3450548482195,920.4866475018093,923.6282401553992,926.769832808989,929.9114254625788,933.0530181161686,936.1946107697584,939.3362034233481,942.4777960769379,945.6193887305277,948.7609813841175,951.9025740377073,955.044166691297,958.185759344887,961.3273519984767,964.4689446520665,967.6105373056563,970.7521299592461,973.8937226128359,977.0353152664256,980.1769079200154,983.3185005736052,986.460093227195,989.6016858807849,992.7432785343747,995.8848711879644,999.0264638415542,1002.168056495144,1005.3096491487338,1008.4512418023236,1011.5928344559134,1014.7344271095031,1017.8760197630929,1021.0176124166827,1024.1592050702725,1027.3007977238624,1030.442390377452,1033.583983031042,1036.7255756846316,1039.8671683382215,1043.0087609918114,1046.150353645401,1049.291946298991,1052.4335389525806,1055.5751316061705,1058.7167242597602,1061.85831691335,1064.9999095669398,1068.1415022205297,1071.2830948741193,1074.4246875277092,1077.5662801812991,1080.7078728348888,1083.8494654884787,1086.9910581420684,1090.1326507956583,1093.274243449248,1096.4158361028378,1099.5574287564275,1102.6990214100174,1105.840614063607,1108.982206717197,1112.1237993707869,1115.2653920243765,1118.4069846779664,1121.548577331556,1124.690169985146,1127.8317626387357,1130.9733552923256,1134.1149479459152,1137.2565405995051,1140.398133253095,1143.5397259066847,1146.6813185602746,1149.8229112138642,1152.9645038674541,1156.1060965210438,1159.2476891746337,1162.3892818282234,1165.5308744818133,1168.672467135403,1171.8140597889928,1174.9556524425827,1178.0972450961724,1181.2388377497623,1184.380430403352,1187.5220230569419,1190.6636157105315,1193.8052083641214,1196.946801017711,1200.088393671301,1203.2299863248907,1206.3715789784806,1209.5131716320705,1212.6547642856601,1215.79635693925,1218.9379495928397,1222.0795422464296,1225.2211349000193,1228.3627275536091,1231.5043202071988,1234.6459128607887,1237.7875055143784,1240.9290981679683,1244.0706908215582,1247.2122834751478,1250.3538761287377,1253.4954687823274,1256.6370614359173,1259.778654089507,1262.9202467430969,1266.0618393966865,1269.2034320502764,1272.345024703866,1275.486617357456,1278.628210011046,1281.7698026646356,1284.9113953182255,1288.0529879718151,1291.194580625405,1294.3361732789947,1297.4777659325846,1300.6193585861743,1303.7609512397642,1306.902543893354] diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg043.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg043.hs new file mode 100644 index 0000000000..88de4c92f2 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg043.hs @@ -0,0 +1,18 @@ +-- !!! Tickled a bug in core2stg +-- !!! (CoreSyn.Coerce constructors were not peeled off +-- !!! when converting CoreSyn.App) + +module Main where + +getData :: String -> IO () +getData filename = case leng filename of {0 -> return ()} +leng :: String -> Int +leng [] = 0 --case ls of {[] -> 0 ; (_:xs) -> 1 + leng xs } +leng ls = leng ls + +f [] [] = [] +f xs ys = f xs ys + +main = + return () >>= \ _ -> + case f [] [] of { [] -> getData [] } diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg043.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg043.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg043.stdout diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg044.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg044.hs new file mode 100644 index 0000000000..aace85761f --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg044.hs @@ -0,0 +1,181 @@ +-- !!! Testing IEEE Float and Double extremity predicates. +module Main(main) where + +import Char +import ST +import MutableArray + +main :: IO () +main = do + sequence_ (map putStrLn double_tests) + sequence_ (map putStrLn float_tests) + where + double_tests = run_tests double_numbers + float_tests = run_tests float_numbers + + run_tests nums = + map ($nums) + [ denorm + , pos_inf + , neg_inf + , nan + , neg_zero + , pos_zero + ] + +------------- +double_numbers :: [Double] +double_numbers = + [ 0 + , encodeFloat 0 0 -- 0 using encodeFloat method + , mkDouble (map chr [0,0,0,0,0,0, 0xf0, 0x7f]) -- +inf + , encodeFloat 1 2047 -- +Inf + , encodeFloat 1 2048 + , encodeFloat 1 2047 -- signalling NaN + , encodeFloat 0xf000000000000 2047 -- quiet NaN + , 0/(0::Double) + -- misc + , 1.82173691287639817263897126389712638972163e-300 + , 1.82173691287639817263897126389712638972163e+300 + , 4.9406564558412465e-324 -- smallest possible denorm number + -- (as reported by enquire running + -- on a i686-pc-linux.) + , 2.2250738585072014e-308 + , 0.11 + , 0.100 + , -3.4 + -- smallest + , let (l, _) = floatRange x + x = encodeFloat 1 (l-1) + in x + -- largest + , let (_, u) = floatRange x + d = floatDigits x + x = encodeFloat (floatRadix x ^ d - 1) (u - d) + in x + ] + +float_numbers :: [Float] +float_numbers = + [ 0 + , encodeFloat 0 0 -- 0 using encodeFloat method + , encodeFloat 1 255 -- +Inf + , encodeFloat 1 256 + , encodeFloat 11 255 -- signalling NaN + , encodeFloat 0xf00000 255 -- quiet NaN + , 0/(0::Float) + -- misc + , 1.82173691287639817263897126389712638972163e-300 + , 1.82173691287639817263897126389712638972163e+300 + , 1.40129846e-45 + , 1.17549435e-38 + , 2.98023259e-08 + , 0.11 + , 0.100 + , -3.4 + -- smallest + , let (l, _) = floatRange x + x = encodeFloat 1 (l-1) + in x + -- largest + , let (_, u) = floatRange x + d = floatDigits x + x = encodeFloat (floatRadix x ^ d - 1) (u - d) + in x + ] + +------------- + +denorm :: RealFloat a => [a] -> String +denorm numbers = + unlines + ( "" + : "*********************************" + : ("Denormalised numbers: " ++ doubleOrFloat numbers) + : "" + : map showPerform numbers) + where + showPerform = showAndPerform (isDenormalized) "isDenormalised" + +pos_inf :: RealFloat a => [a] -> String +pos_inf numbers = + unlines + ( "" + : "*********************************" + : ("Positive Infinity: " ++ doubleOrFloat numbers) + : "" + : map showPerform numbers) + where + showPerform = showAndPerform (isInfinite) "isInfinite" + +neg_inf :: RealFloat a => [a] -> String +neg_inf numbers = + unlines + ( "" + : "*********************************" + : ("Negative Infinity: " ++ doubleOrFloat numbers) + : "" + : map showPerform numbers) + where + showPerform = showAndPerform (\ x -> isInfinite x && x < 0) "isNegInfinite" + +nan :: RealFloat a => [a] -> String +nan numbers = + unlines + ( "" + : "*********************************" + : ("NaN: " ++ doubleOrFloat numbers) + : "" + : map showPerform numbers) + where + showPerform = showAndPerform (isNaN) "isNaN" + +pos_zero :: RealFloat a => [a] -> String +pos_zero numbers = + unlines + ( "" + : "*********************************" + : ("Positive zero: " ++ doubleOrFloat numbers) + : "" + : map showPerform numbers) + where + showPerform = showAndPerform (==0) "isPosZero" + +neg_zero :: RealFloat a => [a] -> String +neg_zero numbers = + unlines + ( "" + : "*********************************" + : ("Negative zero: " ++ doubleOrFloat numbers) + : "" + : map showPerform numbers) + where + showPerform = showAndPerform (isNegativeZero) "isNegativeZero" + +-- what a hack. +doubleOrFloat :: RealFloat a => [a] -> String +doubleOrFloat ls + | (floatDigits atType) == (floatDigits (0::Double)) = "Double" + | (floatDigits atType) == (floatDigits (0::Float)) = "Float" + | otherwise = "unknown RealFloat type" + where + atType = undefined `asTypeOf` (head ls) + +-- make a double from a list of 8 bytes +-- (caller deals with byte ordering.) +mkDouble :: [Char] -> Double +mkDouble ls = + runST ( do + arr <- newCharArray (0,7) + sequence (zipWith (writeCharArray arr) [(0::Int)..] (take 8 ls)) + readDoubleArray arr 0 + ) + +showAndPerform :: (Show a, Show b) + => (a -> b) + -> String + -> a + -> String +showAndPerform fun name_fun val = + name_fun ++ ' ':show val ++ " = " ++ show (fun val) + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg044.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg044.stdout new file mode 100644 index 0000000000..0eb505e236 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg044.stdout @@ -0,0 +1,264 @@ + +********************************* +Denormalised numbers: Double + +isDenormalised 0.0 = False +isDenormalised 0.0 = False +isDenormalised Infinity = False +isDenormalised Infinity = False +isDenormalised Infinity = False +isDenormalised Infinity = False +isDenormalised Infinity = False +isDenormalised NaN = False +isDenormalised 1.821736912876398e-300 = False +isDenormalised 1.8217369128763983e300 = False +isDenormalised 5.0e-324 = True +isDenormalised 2.2250738585072014e-308 = False +isDenormalised 0.11 = False +isDenormalised 0.1 = False +isDenormalised -3.4 = False +isDenormalised 2.2250738585072014e-308 = False +isDenormalised 1.7976931348623157e308 = False + + +********************************* +Positive Infinity: Double + +isInfinite 0.0 = False +isInfinite 0.0 = False +isInfinite Infinity = True +isInfinite Infinity = True +isInfinite Infinity = True +isInfinite Infinity = True +isInfinite Infinity = True +isInfinite NaN = False +isInfinite 1.821736912876398e-300 = False +isInfinite 1.8217369128763983e300 = False +isInfinite 5.0e-324 = False +isInfinite 2.2250738585072014e-308 = False +isInfinite 0.11 = False +isInfinite 0.1 = False +isInfinite -3.4 = False +isInfinite 2.2250738585072014e-308 = False +isInfinite 1.7976931348623157e308 = False + + +********************************* +Negative Infinity: Double + +isNegInfinite 0.0 = False +isNegInfinite 0.0 = False +isNegInfinite Infinity = False +isNegInfinite Infinity = False +isNegInfinite Infinity = False +isNegInfinite Infinity = False +isNegInfinite Infinity = False +isNegInfinite NaN = False +isNegInfinite 1.821736912876398e-300 = False +isNegInfinite 1.8217369128763983e300 = False +isNegInfinite 5.0e-324 = False +isNegInfinite 2.2250738585072014e-308 = False +isNegInfinite 0.11 = False +isNegInfinite 0.1 = False +isNegInfinite -3.4 = False +isNegInfinite 2.2250738585072014e-308 = False +isNegInfinite 1.7976931348623157e308 = False + + +********************************* +NaN: Double + +isNaN 0.0 = False +isNaN 0.0 = False +isNaN Infinity = False +isNaN Infinity = False +isNaN Infinity = False +isNaN Infinity = False +isNaN Infinity = False +isNaN NaN = True +isNaN 1.821736912876398e-300 = False +isNaN 1.8217369128763983e300 = False +isNaN 5.0e-324 = False +isNaN 2.2250738585072014e-308 = False +isNaN 0.11 = False +isNaN 0.1 = False +isNaN -3.4 = False +isNaN 2.2250738585072014e-308 = False +isNaN 1.7976931348623157e308 = False + + +********************************* +Negative zero: Double + +isNegativeZero 0.0 = False +isNegativeZero 0.0 = False +isNegativeZero Infinity = False +isNegativeZero Infinity = False +isNegativeZero Infinity = False +isNegativeZero Infinity = False +isNegativeZero Infinity = False +isNegativeZero NaN = False +isNegativeZero 1.821736912876398e-300 = False +isNegativeZero 1.8217369128763983e300 = False +isNegativeZero 5.0e-324 = False +isNegativeZero 2.2250738585072014e-308 = False +isNegativeZero 0.11 = False +isNegativeZero 0.1 = False +isNegativeZero -3.4 = False +isNegativeZero 2.2250738585072014e-308 = False +isNegativeZero 1.7976931348623157e308 = False + + +********************************* +Positive zero: Double + +isPosZero 0.0 = True +isPosZero 0.0 = True +isPosZero Infinity = False +isPosZero Infinity = False +isPosZero Infinity = False +isPosZero Infinity = False +isPosZero Infinity = False +isPosZero NaN = False +isPosZero 1.821736912876398e-300 = False +isPosZero 1.8217369128763983e300 = False +isPosZero 5.0e-324 = False +isPosZero 2.2250738585072014e-308 = False +isPosZero 0.11 = False +isPosZero 0.1 = False +isPosZero -3.4 = False +isPosZero 2.2250738585072014e-308 = False +isPosZero 1.7976931348623157e308 = False + + +********************************* +Denormalised numbers: Float + +isDenormalised 0.0 = False +isDenormalised 0.0 = False +isDenormalised Infinity = False +isDenormalised Infinity = False +isDenormalised Infinity = False +isDenormalised Infinity = False +isDenormalised NaN = False +isDenormalised 0.0 = False +isDenormalised Infinity = False +isDenormalised 1.0e-45 = True +isDenormalised 1.1754944e-38 = False +isDenormalised 2.9802326e-8 = False +isDenormalised 0.11 = False +isDenormalised 0.1 = False +isDenormalised -3.4 = False +isDenormalised 1.1754944e-38 = False +isDenormalised 3.4028235e38 = False + + +********************************* +Positive Infinity: Float + +isInfinite 0.0 = False +isInfinite 0.0 = False +isInfinite Infinity = True +isInfinite Infinity = True +isInfinite Infinity = True +isInfinite Infinity = True +isInfinite NaN = False +isInfinite 0.0 = False +isInfinite Infinity = True +isInfinite 1.0e-45 = False +isInfinite 1.1754944e-38 = False +isInfinite 2.9802326e-8 = False +isInfinite 0.11 = False +isInfinite 0.1 = False +isInfinite -3.4 = False +isInfinite 1.1754944e-38 = False +isInfinite 3.4028235e38 = False + + +********************************* +Negative Infinity: Float + +isNegInfinite 0.0 = False +isNegInfinite 0.0 = False +isNegInfinite Infinity = False +isNegInfinite Infinity = False +isNegInfinite Infinity = False +isNegInfinite Infinity = False +isNegInfinite NaN = False +isNegInfinite 0.0 = False +isNegInfinite Infinity = False +isNegInfinite 1.0e-45 = False +isNegInfinite 1.1754944e-38 = False +isNegInfinite 2.9802326e-8 = False +isNegInfinite 0.11 = False +isNegInfinite 0.1 = False +isNegInfinite -3.4 = False +isNegInfinite 1.1754944e-38 = False +isNegInfinite 3.4028235e38 = False + + +********************************* +NaN: Float + +isNaN 0.0 = False +isNaN 0.0 = False +isNaN Infinity = False +isNaN Infinity = False +isNaN Infinity = False +isNaN Infinity = False +isNaN NaN = True +isNaN 0.0 = False +isNaN Infinity = False +isNaN 1.0e-45 = False +isNaN 1.1754944e-38 = False +isNaN 2.9802326e-8 = False +isNaN 0.11 = False +isNaN 0.1 = False +isNaN -3.4 = False +isNaN 1.1754944e-38 = False +isNaN 3.4028235e38 = False + + +********************************* +Negative zero: Float + +isNegativeZero 0.0 = False +isNegativeZero 0.0 = False +isNegativeZero Infinity = False +isNegativeZero Infinity = False +isNegativeZero Infinity = False +isNegativeZero Infinity = False +isNegativeZero NaN = False +isNegativeZero 0.0 = False +isNegativeZero Infinity = False +isNegativeZero 1.0e-45 = False +isNegativeZero 1.1754944e-38 = False +isNegativeZero 2.9802326e-8 = False +isNegativeZero 0.11 = False +isNegativeZero 0.1 = False +isNegativeZero -3.4 = False +isNegativeZero 1.1754944e-38 = False +isNegativeZero 3.4028235e38 = False + + +********************************* +Positive zero: Float + +isPosZero 0.0 = True +isPosZero 0.0 = True +isPosZero Infinity = False +isPosZero Infinity = False +isPosZero Infinity = False +isPosZero Infinity = False +isPosZero NaN = False +isPosZero 0.0 = True +isPosZero Infinity = False +isPosZero 1.0e-45 = False +isPosZero 1.1754944e-38 = False +isPosZero 2.9802326e-8 = False +isPosZero 0.11 = False +isPosZero 0.1 = False +isPosZero -3.4 = False +isPosZero 1.1754944e-38 = False +isPosZero 3.4028235e38 = False + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg045.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg045.hs new file mode 100644 index 0000000000..431a7eb96f --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg045.hs @@ -0,0 +1,12 @@ +{-# OPTIONS -fglasgow-exts #-} + +module Main (main,myseq) where + +import PrelGHC +import PrelErr + +main :: IO () +main = seq (error "hello world!" :: Int) (return ()) + +myseq :: a -> b -> b +myseq x y = case (seq# x) of { 0# -> seqError; _ -> y } diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg045.stderr b/testsuite/tests/ghc-regress/codeGen/should_run/cg045.stderr new file mode 100644 index 0000000000..479570d90b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg045.stderr @@ -0,0 +1,2 @@ + +Fail: hello world! diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg045.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg045.stdout new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg045.stdout diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg046.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg046.hs new file mode 100644 index 0000000000..9c9e882781 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg046.hs @@ -0,0 +1,10 @@ +module Main where + +import IO + +-- !!! CAF space leaks + +main = lots_of_xs 10000 + +lots_of_xs 0 = return () +lots_of_xs n = putChar 'x' >> lots_of_xs (n-1) diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg046.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg046.stdout new file mode 100644 index 0000000000..f2776bdd89 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg046.stdout @@ -0,0 +1 @@ +xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg047.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg047.hs new file mode 100644 index 0000000000..275bdf2d3b --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg047.hs @@ -0,0 +1,18 @@ +module Main where + +-- GHC 4.04 +-- I've been having problems getting GHC to compile some code I'm working +-- on with optimisation (-O) turned on. Compilation is fine without -O +-- specified. Through a process of elimination I've managed to reproduce +-- the problemin the following (much simpler) piece of code: + +import List + +test es = + concat (groupBy eq (zip [0..(length es) - 1] es)) + where + eq a b = (fst a) == (fst b) + +main = putStr (show (test [1,2,3,4])) + + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg047.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg047.stdout new file mode 100644 index 0000000000..732d4fe8ff --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg047.stdout @@ -0,0 +1 @@ +[(0,1),(1,2),(2,3),(3,4)]
\ No newline at end of file diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg048.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg048.hs new file mode 100644 index 0000000000..30f0b3e387 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg048.hs @@ -0,0 +1,24 @@ + +-- The new register allocator in 4.08 had a bug wherein +-- flow edges away from an insn which does a jump through +-- a switch table were not being added to the flow graph, +-- which causes computation of live ranges and thus register +-- assignment to be wrong in the alternatives and default. +-- This was fixed properly in the head branch (pre 4.09) +-- and avoided in 4.08.1 by disabling jump table generation +-- in the NCG -- it generates trees of ifs instead. + +module Main ( main ) where + +main = print (map f [1 .. 7]) + + + +{-# NOINLINE f #-} +f :: Int -> Bool +f 7 = False +f 1 = False +f 4 = False +f 6 = False +f 5 = False +f x = if x * 10 == 20 then True else False diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg048.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg048.stdout new file mode 100644 index 0000000000..ff596497db --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg048.stdout @@ -0,0 +1 @@ +[False,True,False,False,False,False,False] diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg049.hs b/testsuite/tests/ghc-regress/codeGen/should_run/cg049.hs new file mode 100644 index 0000000000..d4b6a77908 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg049.hs @@ -0,0 +1,22 @@ +-- !! Data constructors with strict fields +-- This test should use -funbox-strict-fields + +module Main ( main ) where + +main = print (g (f t)) + +t = MkT 1 2 (3,4) (MkS 5 6) + +g (MkT x _ _ _) = x + +data T = MkT Int !Int !(Int,Int) !(S Int) + +data S a = MkS a a + + +{-# NOINLINE f #-} +f :: T -> T -- Takes apart the thing and puts it + -- back together differently +f (MkT x y (a,b) (MkS p q)) = MkT a b (p,q) (MkS x y) + + diff --git a/testsuite/tests/ghc-regress/codeGen/should_run/cg049.stdout b/testsuite/tests/ghc-regress/codeGen/should_run/cg049.stdout new file mode 100644 index 0000000000..00750edc07 --- /dev/null +++ b/testsuite/tests/ghc-regress/codeGen/should_run/cg049.stdout @@ -0,0 +1 @@ +3 |