Commit a3882aa9 authored by thomie's avatar thomie

Testsuite: AMPify tests/raytrace/Eval.hs

parent 0741f656
...@@ -5,6 +5,7 @@ ...@@ -5,6 +5,7 @@
module Eval where module Eval where
import Control.Monad
import Data.Array import Data.Array
import Geometry import Geometry
...@@ -22,9 +23,16 @@ class Monad m => MonadEval m where ...@@ -22,9 +23,16 @@ class Monad m => MonadEval m where
newtype Pure a = Pure a deriving Show newtype Pure a = Pure a deriving Show
instance Functor Pure where
fmap = liftM
instance Applicative Pure where
pure = Pure
(<*>) = ap
instance Monad Pure where instance Monad Pure where
Pure x >>= k = k x Pure x >>= k = k x
return = Pure return = pure
fail s = error s fail s = error s
instance MonadEval Pure where instance MonadEval Pure where
...@@ -248,7 +256,7 @@ doPrimOp primOp op args ...@@ -248,7 +256,7 @@ doPrimOp primOp op args
types = getPrimOpType primOp types = getPrimOpType primOp
-- Render is somewhat funny, becauase it can only get called at top level. -- Render is somewhat funny, because it can only get called at top level.
-- All other operations are purely functional. -- All other operations are purely functional.
doAllOp :: PrimOp -> GMLOp -> Stack -> IO Stack doAllOp :: PrimOp -> GMLOp -> Stack -> IO Stack
...@@ -286,11 +294,18 @@ newtype Abs a = Abs { runAbs :: Int -> AbsState a } ...@@ -286,11 +294,18 @@ newtype Abs a = Abs { runAbs :: Int -> AbsState a }
data AbsState a = AbsState a !Int data AbsState a = AbsState a !Int
| AbsFail String | AbsFail String
instance Functor Abs where
fmap = liftM
instance Applicative Abs where
pure x = Abs (\ n -> AbsState x n)
(<*>) = ap
instance Monad Abs where instance Monad Abs where
(Abs fn) >>= k = Abs (\ s -> case fn s of (Abs fn) >>= k = Abs (\ s -> case fn s of
AbsState r s' -> runAbs (k r) s' AbsState r s' -> runAbs (k r) s'
AbsFail m -> AbsFail m) AbsFail m -> AbsFail m)
return x = Abs (\ n -> AbsState x n) return = pure
fail s = Abs (\ n -> AbsFail s) fail s = Abs (\ n -> AbsFail s)
instance MonadEval Abs where instance MonadEval Abs where
...@@ -325,7 +340,7 @@ mainEval prog = do { stk <- eval (State emptyEnv [] prog) ...@@ -325,7 +340,7 @@ mainEval prog = do { stk <- eval (State emptyEnv [] prog)
} }
-} -}
done = "Items still on stack at (successfull) termination of program" done = "Items still on stack at (successful) termination of program"
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- testing -- testing
......
...@@ -2,8 +2,15 @@ setTestOpts([omit_ways(['ghci']), when(fast(), skip)]) ...@@ -2,8 +2,15 @@ setTestOpts([omit_ways(['ghci']), when(fast(), skip)])
hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}" hpc_prefix = "perl ../hpcrun.pl --clear --exeext={exeext} --hpc={hpc}"
test('hpc_raytrace', \ # TODO. It is unclear what the purpose of this test is. It produces lots of
[ when(fast(), skip), cmd_prefix(hpc_prefix), reqlib('parsec') ], \ # output, but the expected output file is missing. I (thomie) added
multimod_compile_and_run, \ # the ignore_output setup function, just to make the test pass for the
['Main','-fhpc -package parsec']) # moment.
# Note that the subdirectory tixs also has a test.T file, and those tests
# depend on some of the files in this directory.
# Also note that testsuite/tests/programs/galois_raytrace has a similar (but
# not the same) copy of this program.
test('hpc_raytrace',
[cmd_prefix(hpc_prefix), reqlib('parsec'), ignore_output],
multimod_compile_and_run, ['Main','-fhpc -package parsec'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment