-- $Id: CoreUntypedTest.hs,v 1.3 2004/10/18 23:47:48 leavens Exp leavens $

-- Gary T. Leavens
-- Semantic testing for the language of Chapter 1

module CoreUntypedTest where
import CoreLangParser
import CoreTypeHelpers
import CoreTyping
import CoreUntypedSemantics
import Domains
import CoreLangProgs
import Testing

sample_store :: DStore
sample_store = [1..10]


evalC :: Command -> String
evalC c = let (Tree_Subst (_ ::: Node atr _) _) = annotate c
          in if atr == Aerr
             then "type error"
             else show (meaningC c sample_store)
evalE :: Expression -> String
evalE e = let (Tree_Subst (_ ::: Node atr _) _) = annotate e
          in if atr == Aerr
             then "type error"
             else show (meaningE e sample_store)


repC :: String -> IO ()
repC = putStrLn . evalC . read
repE :: String -> IO ()
repE = putStrLn . evalE . read


test n = repC (prog n)


runC :: String -> DStore
runC c = let parsedC = (read c)
             (Tree_Subst (_ ::: Node atr _) _) = annotate parsedC
         in if atr == Aerr
	    then error "type error"
	    else meaningC parsedC sample_store

tests :: [TestCase DStore DStore]
tests = map (\(c,m) -> eqTest c (runC c) (m sample_store)) progs_with_results

-- The following runs all the test programs

go :: IO ()
go = run_tests tests