Commit b1d77828 authored by Antonio Locascio's avatar Antonio Locascio

Arreglo tests

parent 198ab4df
......@@ -127,6 +127,7 @@ test-suite Interp
, directory
, ansi-terminal
, containers
, cond
, HaskTiger
other-modules: Tools
ghc-options: -threaded -rtsopts -with-rtsopts=-N
......
......@@ -325,6 +325,9 @@ restore colls = do
emptyCPU :: CPU
emptyCPU = CPU M.empty M.empty M.empty [] [] [] True 0
emptyCPUNI :: CPU
emptyCPUNI = CPU M.empty M.empty M.empty [] [] [] False 0
-- | Función que búsca los posibles labels dentro de una sequencia de stms.
splitStms
:: [Stm]
......@@ -401,7 +404,7 @@ loadMain tmain fr s = do
----------------------------------------
----------------------------------------
-- | Inicializador
-- | Inicializador interactivo
startInteractive
::
-- | Fragmentos de funciones ya definidas. (fuera del main)
......@@ -410,7 +413,7 @@ startInteractive
-> [(Label, Symbol)]
-- | Básicamente el main.
-> ([Stm], Frame)
-> IO ()
-> IO (Int, [Symbol])
startInteractive fs ss (tmain, mainFr) =
let (factMain, rests) = splitStms tmain
(cpuInit', me ) = runState
......@@ -420,18 +423,40 @@ startInteractive fs ss (tmain, mainFr) =
factMain' = if null factMain then snd $ head rests else factMain
in evalStateT (interactive factMain') cpuInit
-- | Inicializador no interactivo
startInterp
::
-- | Fragmentos de funciones ya definidas. (fuera del main)
[(Frame, [Stm])]
-- | Strings.
-> [(Label, Symbol)]
-- | Básicamente el main.
-> ([Stm], Frame)
-> IO (Int, [Symbol])
startInterp fs ss (tmain, mainFr) =
let (factMain, rests) = splitStms tmain
(cpuInit', me ) = runState
(loadMain tmain mainFr $ loadProcs fs $ loadLabels ss $ return
emptyCPUNI
)
memSize
cpuInit = uTemp rv me $ uTemp fp me $ uTemp sp me cpuInit'
factMain' = if null factMain then snd $ head rests else factMain
in evalStateT (interactive factMain') cpuInit
interactive :: [Stm] -> RC ()
interactive :: [Stm] -> RC (Int, [Symbol])
interactive [] = do
cpu <- get
case frameStack cpu of
[f] -> liftIO $ putStrLn (printCpu cpu)
_ -> return ()
[f] ->
liftIO $ putStrLn (printCpu cpu) >> return (mem cpu ! rv, output cpu)
_ -> return (0, [])
interactive s@(stm : stms) = do
cpu <- get
liftIO $ putStrLn ("Next stm: " ++ renderStm stm)
ln <- if inter cpu
ln <- if inter cpu
then do
liftIO $ putStrLn ("Next stm: " ++ renderStm stm)
liftIO (putStr "> " >> hFlush stdout)
liftIO getLine
else return "c"
......
{-# Language OverloadedStrings #-}
import Tools
import TigerTree
import TigerFrame
import TigerInterp
import TigerSymbol
import Tools
import TigerTree
import TigerInterpFrame
import TigerInteractive
import TigerInterpTypes
import TigerSymbol
import TigerTemp
import Control.Conditional
import Data.Map as M
import Data.Map as M
procs = []
strings = [(pack "str1", pack "hola")]
mainStms = [res suma]
frame = defaultFrame
main :: IO ()
main =
let cpu = CPU
-- mem
(M.fromList
[ (rv , 0)
, (fp , 0)
, (sp , 0)
, (pack "r1", 15)
, (pack "r2", 100)
])
-- wat
(M.fromList [(1, Str "hola")])
-- dat
(M.fromList [ ("str1" , DInt 1)])
-- I/O
[]
[]
in
putStrLn "\n======= Test Interpreter n progress =======" >>
putStrLn (printCpu $ runInitial cpu [(res callP)]) >>
main = do
putStrLn "\n======= Test Interpreter n progress ======="
ifM (testinterp procs strings (mainStms, frame) 29) bluenice redfail
--startInterp procs strings (mainStms, frame)
putStrLn "\n======= Test FIN ======="
testinterp :: CPU -> [Stm] -> Int -> Bool
testinterp cpu stm = ((mem (runInitial cpu stm) ! rv) ==)
testinterp
:: [(Frame, [Stm])] -> [(Label, Symbol)] -> ([Stm], Frame) -> Int -> IO Bool
testinterp pr strs main_ r = do
(res, _) <- startInterp pr strs main_
return $ res == r
suma :: Exp
suma = Binop Plus (Const 14) (Const 15)
......
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