~jojo/Carth

9a1ca419bd8693265700a59f6f2b8923434257d7 — JoJo 1 year, 2 months ago 5f45496
Test that good programs produce expected output

For the programs in test/tests/good/, compile and run the program,
capturing stdout. If the string of stdout matches the text in the
first comment of the file, the test passes.
5 files changed, 43 insertions(+), 14 deletions(-)

M app/GetConfig.hs
M carth.cabal
M src/Conf.hs
M src/Misc.hs
M test/SystemSpec.hs
M app/GetConfig.hs => app/GetConfig.hs +1 -1
@@ 70,7 70,7 @@ compileCfg args = do
runCfg :: [String] -> IO Conf
runCfg args = do
    (fs, inf) <- get args runOpts usageRun
    let defaultCfg = RunConfig { rInfile = inf, rDebug = False, rVerbose = False }
    let defaultCfg = defaultRunConfig inf
        cfg = foldl (&) defaultCfg fs
    pure (RunConf cfg)


M carth.cabal => carth.cabal +1 -0
@@ 120,4 120,5 @@ test-suite carth-test
    , process
    , template-haskell
    , utf8-string
    , silently
  default-language: Haskell2010

M src/Conf.hs => src/Conf.hs +3 -0
@@ 39,5 39,8 @@ defaultCompileConfig inf outf = CompileConfig { cInfile = inf
                                              , cVerbose = False
                                              }

defaultRunConfig :: FilePath -> RunConfig
defaultRunConfig inf = RunConfig { rInfile = inf, rDebug = False, rVerbose = False }

verbose :: Config cfg => cfg -> String -> IO ()
verbose cfg msg = when (getVerbose cfg) $ putStrLn msg

M src/Misc.hs => src/Misc.hs +3 -0
@@ 94,3 94,6 @@ partitionWith f = foldl'
        Right c -> (bs, c : cs)
    )
    ([], [])

rightToMaybe :: Either a b -> Maybe b
rightToMaybe = either (const Nothing) Just

M test/SystemSpec.hs => test/SystemSpec.hs +35 -13
@@ 7,26 7,28 @@ import Data.Functor
import Control.Monad
import System.Directory
import System.FilePath
import Data.List
import Test.Hspec
import System.IO.Silently

import Misc
import Parse
import Check
import Compile
import Monomorphize
import qualified Monomorphic
import Conf

spec :: Spec
spec = do
    describe "Examples compile" $ do
        let d = "examples"
        fs <- runIO $ listDirectory d <&> filter isSourceFile
        forM_ fs $ \f -> do
            it (dropExtension f) $ shouldReturn (compile' (d </> f)) True
    describe "Benchmarks compile" $ do
        let d = "test/bench"
    describe "Good programs run with expected output" $ do
        let d = "test/tests/good"
        fs <- runIO $ listDirectory d <&> filter isSourceFile
        forM_ fs $ \f -> do
            it (dropExtension f) $ shouldReturn (compile' (d </> f)) True
            expectedOut <- runIO $ fmap
                (unlines . map (drop 3) . takeWhile (isPrefixOf ";; ") . lines)
                (readFile (d </> f))
            it (dropExtension f) $ shouldReturn (run' (d </> f)) expectedOut
    describe "Bad programs don't typecheck" $ do
        let d = "test/tests/bad"
        fs <- runIO $ listDirectory d <&> filter isSourceFile


@@ 36,15 38,35 @@ spec = do
            it (dropExtension f) $ shouldSatisfy (fmap typecheck result) $ \case
                Right (Left e) -> show (toConstr e) == expectedErr
                _ -> False
    describe "Examples compile" $ do
        let d = "examples"
        fs <- runIO $ listDirectory d <&> filter isSourceFile
        forM_ fs $ \f -> do
            it (dropExtension f) $ shouldReturn (compile' (d </> f)) True
    describe "Benchmarks compile" $ do
        let d = "test/bench"
        fs <- runIO $ listDirectory d <&> filter isSourceFile
        forM_ fs $ \f -> do
            it (dropExtension f) $ shouldReturn (compile' (d </> f)) True

isSourceFile :: FilePath -> Bool
isSourceFile f = let e = takeExtension f in e == ".carth" || e == ".org"

run' :: FilePath -> IO String
run' f =
    let cfg = defaultRunConfig f
    in  frontend f >>= \case
            Nothing -> error "Program failed to pass through frontend"
            Just ast -> capture_ (run f cfg ast)

compile' :: FilePath -> IO Bool
compile' f =
    let cfg = defaultCompileConfig f (dropExtension f)
    in  Parse.parse f >>= \case
            Left _ -> pure False
            Right ast -> case typecheck ast of
                Left _ -> pure False
                Right ann -> compile f cfg (monomorphize ann) $> True
    in  frontend f >>= \case
            Nothing -> pure False
            Just ast -> compile f cfg ast $> True

frontend :: FilePath -> IO (Maybe Monomorphic.Program)
frontend f = parse f <&> \case
    Left _ -> Nothing
    Right ast -> fmap monomorphize (rightToMaybe (typecheck ast))