summaryrefslogtreecommitdiff
path: root/ghc/tests/programs
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/tests/programs')
-rw-r--r--ghc/tests/programs/Makefile9
-rw-r--r--ghc/tests/programs/barton-mangler-bug/Basic.hs15
-rw-r--r--ghc/tests/programs/fast2haskell/Word.hs4
-rw-r--r--ghc/tests/programs/fun_insts/Main.hs3
-rw-r--r--ghc/tests/programs/jeff-bug/AQ.hs2
-rw-r--r--ghc/tests/programs/jeff-bug/BoundedSet.hs2
-rw-r--r--ghc/tests/programs/jeff-bug/Devices.hs9
-rw-r--r--ghc/tests/programs/jeff-bug/PreludeSig.hs10
-rw-r--r--ghc/tests/programs/jeff-bug/ROB_retire.hs1
-rw-r--r--ghc/tests/programs/jeff-bug/STEx.hs12
-rw-r--r--ghc/tests/programs/jeff-bug/Signal.hs11
-rw-r--r--ghc/tests/programs/jeff-bug/Trans.hs2
-rw-r--r--ghc/tests/programs/life_space_leak/Makefile2
-rw-r--r--ghc/tests/programs/north_lias/Main.lhs10
-rw-r--r--ghc/tests/programs/okeefe_neural/Main.hs2
15 files changed, 61 insertions, 33 deletions
diff --git a/ghc/tests/programs/Makefile b/ghc/tests/programs/Makefile
index 617e589493..9844376884 100644
--- a/ghc/tests/programs/Makefile
+++ b/ghc/tests/programs/Makefile
@@ -1,7 +1,7 @@
TOP = .
include $(TOP)/mk/boilerplate.mk
-NOT_THESE = CVS mk Makefile \
+NOT_THESE = CVS mk Makefile
NOT_THESE += hill_stk_oflow
# Correctly fails to terminate
@@ -9,7 +9,12 @@ NOT_THESE += hill_stk_oflow
NOT_THESE += ipoole_spec_class
# Dialogue style IO
-# areid_pass
+NOT_THESE += areid_pass
+# Old-style I/O
+
+NOT_THESE += north_lias
+# Deliberately causes divide by zero, and
+# we can't catch that yet
SUBDIRS = $(filter-out $(NOT_THESE), $(wildcard *))
diff --git a/ghc/tests/programs/barton-mangler-bug/Basic.hs b/ghc/tests/programs/barton-mangler-bug/Basic.hs
index ad240f8cfe..5b3d054c50 100644
--- a/ghc/tests/programs/barton-mangler-bug/Basic.hs
+++ b/ghc/tests/programs/barton-mangler-bug/Basic.hs
@@ -18,7 +18,13 @@ instance Signal (->) where
data {- (Physical a, Physical b) => -} SignalRep a b =
FunctionRep (a -> b) |
PieceContRep (PieceCont a b)
- deriving (Eq, Show)
+
+instance Eq (SignalRep a b) where
+ (==) a b = error "No equality for SignalRep"
+
+instance Show (SignalRep a b) where
+ show sr = error "No show for SignalRep"
+
instance Signal SignalRep where
mapSignal (FunctionRep f) = mapSignal f
mapSignal (PieceContRep f) = mapSignal f
@@ -64,7 +70,12 @@ data Event =
TimeEvent Float |
FunctionEvent (Float -> Bool) |
BurstEvent Int Event
- deriving (Show)
+
+instance Show Event where
+ show (TimeEvent f) = "TimeEvent " ++ show f
+ show (FunctionEvent _) = "FunctionEvent"
+ show (BurstEvent i e) = "BurstEvent " ++ show i ++ " " ++ show e
+
instance Eq Event where
(TimeEvent x) == (TimeEvent y) = x == y
(BurstEvent i e) == (BurstEvent i' e') = (i' == i) && (e' == e)
diff --git a/ghc/tests/programs/fast2haskell/Word.hs b/ghc/tests/programs/fast2haskell/Word.hs
index 4c7091cdcf..9161622083 100644
--- a/ghc/tests/programs/fast2haskell/Word.hs
+++ b/ghc/tests/programs/fast2haskell/Word.hs
@@ -50,8 +50,8 @@ instance Num Word where
Word x - Word y = case (w2i x) -# (w2i y) of z -> Word (i2w z)
Word x * Word y = case (w2i x) *# (w2i y) of z -> Word (i2w z)
negate (Word x) = case negateInt# (w2i x) of z -> Word (i2w z)
- fromInteger (J# a# s# d#)
- = case integer2Int# a# s# d# of { z# ->
+ fromInteger i
+ = case fromInteger i of { I# z# ->
Word (i2w z#) }
instance Show Word where
diff --git a/ghc/tests/programs/fun_insts/Main.hs b/ghc/tests/programs/fun_insts/Main.hs
index 286154ccb8..fece8c9c47 100644
--- a/ghc/tests/programs/fun_insts/Main.hs
+++ b/ghc/tests/programs/fun_insts/Main.hs
@@ -5,6 +5,9 @@ module Main where
instance (Eq a, Eq b) => Eq (a->b)
+instance Show (a->b) where
+ show f = "<<function>>"
+
instance (Num a, Num b) => Num (a->b) where
f + g = \x -> f x + g x
negate f = \x -> - (f x)
diff --git a/ghc/tests/programs/jeff-bug/AQ.hs b/ghc/tests/programs/jeff-bug/AQ.hs
index 397f96ccfd..ec86a6761c 100644
--- a/ghc/tests/programs/jeff-bug/AQ.hs
+++ b/ghc/tests/programs/jeff-bug/AQ.hs
@@ -150,7 +150,7 @@ iterateQueue q f
update q n f
= do { x <- getQVal q n
- ; setQVal q n $ map f x
+ ; setQVal q n $ fmap f x
}
-------------------------------------------------------------------------
diff --git a/ghc/tests/programs/jeff-bug/BoundedSet.hs b/ghc/tests/programs/jeff-bug/BoundedSet.hs
index 0583ba6f54..b8e8cafb7a 100644
--- a/ghc/tests/programs/jeff-bug/BoundedSet.hs
+++ b/ghc/tests/programs/jeff-bug/BoundedSet.hs
@@ -14,7 +14,7 @@ module BoundedSet
import LazyST
import Prelude hiding (read)
-import List
+import List hiding (insert)
new :: Int -> ST s (BoundedSet s a)
diff --git a/ghc/tests/programs/jeff-bug/Devices.hs b/ghc/tests/programs/jeff-bug/Devices.hs
index 96a2940a2f..fd3366c758 100644
--- a/ghc/tests/programs/jeff-bug/Devices.hs
+++ b/ghc/tests/programs/jeff-bug/Devices.hs
@@ -16,6 +16,7 @@ import LazyST
import Instruction
import Array
+import Monad
import StateArray
import Ix
@@ -109,8 +110,8 @@ fetch (k,f,lim,memory@(range,_)) pc n
buildPCs :: (Word w, Cell c, Register r, Instruction i) =>
w -> (w,w) -> Trans i (c r w) -> Int -> [Trans i (c r w)]
buildPCs k range pctrans n
- = do p <- map getReg $ T.getDstPC pctrans
- pc <- map getVal $ T.getDstPC pctrans
+ = do p <- fmap getReg $ T.getDstPC pctrans
+ pc <- fmap getVal $ T.getDstPC pctrans
let pcs = filter (inRange range) $ take n [pc,pc+k .. ]
return $ map (mkPC range) pcs
`catchEx` []
@@ -138,7 +139,7 @@ instrsFetch n convert initContents pcs
let x = getVal reg
guard $ ispc p
return x
- `catchEx` (error "ugh" ) --$ "getpc " ++ show t)
+ `catchEx` (error "ugh" ) -- $ "getpc " ++ show t)
insertPCs pcs l = lift2 addPCs pcs l
addPCs x y = zipWith addPC x y
addPC pc (Trans d o s l) = Trans d o s (loc pc:l)
@@ -290,7 +291,7 @@ pairRegFile bounds initVals writePorts readPorts
-- I THINK THAT THIS ONE SHOULD GO...
registers src1 src2 p
- = unbundle2 $ map getContents arrResps
+ = unbundle2 $ fmap getContents arrResps
where
(writebackContents,writebackReg) = unbundle2 p
arrResps = stateArray ((minBound,maxBound),[(minBound,maxBound,0)])
diff --git a/ghc/tests/programs/jeff-bug/PreludeSig.hs b/ghc/tests/programs/jeff-bug/PreludeSig.hs
index f2cd6109d6..b54bbbed92 100644
--- a/ghc/tests/programs/jeff-bug/PreludeSig.hs
+++ b/ghc/tests/programs/jeff-bug/PreludeSig.hs
@@ -1,8 +1,9 @@
module PreludeSig where
-import Prelude(Ord,Bool,MonadZero,Int,($),(.))
+import Prelude(Ord,Bool,Int,($),(.))
import qualified Prelude as P
import qualified List
+import Monad
import Signal
-- Begin Signature ----------------------------------------------------
@@ -20,7 +21,7 @@ max :: Ord a => Signal a -> Signal a -> Signal a
min :: Ord a => Signal a -> Signal a -> Signal a
maximum :: Ord a => Signal [a] -> Signal a
minimum :: Ord a => Signal [a] -> Signal a
-filter :: MonadZero c => (a -> Bool) -> Signal (c a) -> Signal (c a)
+filter :: MonadPlus c => (a -> Bool) -> Signal (c a) -> Signal (c a)
partition :: (a -> Bool) -> Signal [a] -> (Signal [a],Signal [a])
fst :: Signal (a,b) -> Signal a
snd :: Signal (a,b) -> Signal b
@@ -44,7 +45,10 @@ maximum = lift1 P.maximum
minimum = lift1 P.minimum
-filter x y = lift1 (P.filter x) y
+filter p y = lift1 filt y
+ where
+ filt m = do { x <- m;
+ if p x then mzero else return x }
partition x y = unbundle2 (lift1 (List.partition x) y )
diff --git a/ghc/tests/programs/jeff-bug/ROB_retire.hs b/ghc/tests/programs/jeff-bug/ROB_retire.hs
index 0080259aa5..b00c78d50b 100644
--- a/ghc/tests/programs/jeff-bug/ROB_retire.hs
+++ b/ghc/tests/programs/jeff-bug/ROB_retire.hs
@@ -12,6 +12,7 @@ import AQ(AQ)
import RAT(RAT)
import DLX
+import Monad
import Utils
diff --git a/ghc/tests/programs/jeff-bug/STEx.hs b/ghc/tests/programs/jeff-bug/STEx.hs
index cb77722b9c..76ed6fb686 100644
--- a/ghc/tests/programs/jeff-bug/STEx.hs
+++ b/ghc/tests/programs/jeff-bug/STEx.hs
@@ -1,5 +1,6 @@
module STEx where
import LazyST
+import Monad
infixl 1 `handle`
@@ -13,7 +14,6 @@ infixl 1 `handle`
{-data STEx s a-}
{-instance Monad (STEx s)-}
-{-instance MonadZero (STEx s)-}
{-instance MonadPlus (STEx s)-}
-- c `handle` x, return x if c raises an exception
@@ -49,13 +49,11 @@ instance Monad (STEx s) where
in z'
Nothing -> return Nothing
-instance MonadZero (STEx s) where
- zero = liftEx zero
-
instance MonadPlus (STEx s) where
- (STEx x) ++ (STEx y) = STEx $ do x' <- x
- y' <- y
- return $ x' ++ y'
+ mzero = liftEx mzero
+ (STEx x) `mplus` (STEx y) = STEx $ do x' <- x
+ y' <- y
+ return $ mplus x' y'
liftST x = STEx $ do {z <- x ; return $ return z}
liftEx x = STEx $ return x
diff --git a/ghc/tests/programs/jeff-bug/Signal.hs b/ghc/tests/programs/jeff-bug/Signal.hs
index 5498a26040..c4b20402bd 100644
--- a/ghc/tests/programs/jeff-bug/Signal.hs
+++ b/ghc/tests/programs/jeff-bug/Signal.hs
@@ -1,4 +1,5 @@
module Signal where
+import Monad
import LazyST
import List
import Random
@@ -212,7 +213,7 @@ instance Integral a => Integral (Signal a) where
(*>=) = lift2 (>=)
(*&&) = lift2 (&&)
(*||) = lift2 (||)
-(*++) = lift2 (++)
+(*++) = lift2 mplus
(*:) = lift2 (:)
data Then = Then
@@ -241,7 +242,7 @@ newtype Signal a = List [a]
deriving Show
instance Functor Signal where
- map f ~(List as) = List (map f as)
+ fmap f ~(List as) = List (map f as)
at ~(List l) n = l!!n
@@ -290,9 +291,11 @@ superscalar f (List input) = List (chop lens output)
------------------------------------------------------------------------
-- Non-determinism
-integers = List . unsafePerformIO . randomIO
+-- integers :: (Integer,Integer) -> Signal Integer
+integers rng = List (unsafePerformIO (do { g <- newStdGen ;
+ return (randomRs rng g) }))
-ints = map toInt . integers . toIntegers
+ints = fmap toInt . integers . toIntegers
where
toIntegers (x,y) = (toInteger x,toInteger y)
diff --git a/ghc/tests/programs/jeff-bug/Trans.hs b/ghc/tests/programs/jeff-bug/Trans.hs
index 29c96c6c43..62cb987d45 100644
--- a/ghc/tests/programs/jeff-bug/Trans.hs
+++ b/ghc/tests/programs/jeff-bug/Trans.hs
@@ -312,7 +312,7 @@ rawHazard (preceeding,following)
filterDst f (Trans d _ _ _) = filter f d
--added 19 Nov
-filterOut f = map (filter $ not . f)
+filterOut f = fmap (filter $ not . f)
fillInCells cells bypassCells
= repCells (\x y -> (not $ isAss y) && cellHazard x y) cells bypassCells
diff --git a/ghc/tests/programs/life_space_leak/Makefile b/ghc/tests/programs/life_space_leak/Makefile
index cc14abc6b2..00783e530d 100644
--- a/ghc/tests/programs/life_space_leak/Makefile
+++ b/ghc/tests/programs/life_space_leak/Makefile
@@ -1,7 +1,7 @@
TOP = ..
include $(TOP)/mk/boilerplate.mk
-SRC_RUNTEST_OPTS += -prescript ./life.test
+SRC_RUNTEST_OPTS += -prescript "./life.test
all :: runtest
diff --git a/ghc/tests/programs/north_lias/Main.lhs b/ghc/tests/programs/north_lias/Main.lhs
index 3f4a4373ac..46c23877b9 100644
--- a/ghc/tests/programs/north_lias/Main.lhs
+++ b/ghc/tests/programs/north_lias/Main.lhs
@@ -17,7 +17,9 @@ used in expressions, but does not determine the characteristics.
> maxInt, minInt :: Int
> maxInt = maxBound
-> minInt = minBound
+> minInt = minBound + 1 -- NOTA BENE: this program does (minInt `rem` (-1)), and
+> -- that gives an exception if minInt = minBound,
+> -- because the result of the division is too big to fit
> main = (initial_checks flp_parms . main_identities flp_parms .
> notification_checks flp_parms) (return ())
@@ -102,20 +104,20 @@ AN element has the form
> | i /= j = showits "Integer operation check number " .
> showit test_number . showits " fails with " .
> showit i . showits " ". showit j . new_line
-> | True = id
+> | True = showits "Integer operation check number " . showit test_number . showits " ok " . new_line
> equal_flp :: (RealFloat a) => (a, a, Int) -> Cont -> Cont
> equal_flp (x, y, test_number)
> | x /= y = showits "Floating point operation check number " .
> showit test_number . showits " fails" . new_line .
> showit x . showits " " . showit y . new_line
-> | True = id
+> | True = showits "Floating operation check number " . showit test_number . showits " ok " . new_line
> test_true :: (Bool, Int) -> Cont -> Cont
> test_true (b, test_number)
> | not b = showits "Predicate number " . showit test_number .
> showits " fails " . showit b . new_line
-> | True = id
+> | True = showits "Predicate number " . showit test_number . showits " ok " . new_line
> -- This procedure checks that sqrt(y*y) = y when y*y is exact
> check_exact_squares :: (RealFloat a) => FloatParms a -> Cont -> Cont
diff --git a/ghc/tests/programs/okeefe_neural/Main.hs b/ghc/tests/programs/okeefe_neural/Main.hs
index 5c6cffa22d..35c5c82b43 100644
--- a/ghc/tests/programs/okeefe_neural/Main.hs
+++ b/ghc/tests/programs/okeefe_neural/Main.hs
@@ -121,7 +121,7 @@ train pats i_h_wt i_h_ch h_o_wt h_o_ch epochs s =
out_err = vscale (vsub out_pat out_act) out_act
hid_err = vscale (vmmul out_err h_o_wt) hid_act
-main = ans
+main = putStrLn (show ans)
where (in1,out1) = head patterns
nin = length in1
nhid = nin
View Lorry Controller Status