Commit 1dce8845 authored by sewardj's avatar sewardj

[project @ 2001-06-20 15:11:17 by sewardj]

All your codeGen tests are belong to me.  Well, the should_run ones,
at least.
parent 23f574d4
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", "", "") }
-- !! cg001: main = -42 -- take 1
main = print ( f () )
where
f :: a -> Int
f x = -42
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
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
main = print (length ([9,8,7,6,5,4,3,2,1] :: [Int]))
-- !! answer: 65532
main = print foo
foo :: Int
foo = ((1 + 2 + 32767 - 4) * 6) --later? `div` 3
main = print (length thirteen_ones)
where
thirteen_ones = take (13::Int) ones
ones :: [Int]
ones = 1 : ones
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)
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]
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]
main = print a
where
a :: Int
b :: Int
(a, b) = (3 + 4, 5 + 6)
-- !!! 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
-- !!! 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
{-
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
-}
-- !! cg014: main = -42 -- twice: in Float and Double
main = print ((show ( (-42) :: Float )) ++ " " ++ (show ( (-42) :: Double )) ++ "\n")
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 ()
-- !!! 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"
)))))))))))
-- !!! 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))
TrueTrueFalse
\ No newline at end of file
-- !!! 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)
-- !!! printing of floating-pt numbers
--
main = print (1.234e5 :: Float)
-- !!! reading/showing of Ints/Integers
--
main = print ((read "-1") :: Integer)
-- !!! 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
-- !!! 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
-- !!! test super-dictionary grabification
--
main = putStr (show (is_one (1.2::Double)))
is_one :: RealFloat a => a -> Bool
is_one x = x == 1.0
-- !!! 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")