-
-
Notifications
You must be signed in to change notification settings - Fork 36
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
16 changed files
with
291 additions
and
21 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,10 @@ | ||
module Main where | ||
|
||
import System.Environment (getArgs) | ||
import CLI.Lib (mainWithArgs) | ||
|
||
|
||
main :: IO () | ||
main = do | ||
args <- getArgs | ||
mainWithArgs args |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
File renamed without changes.
File renamed without changes.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,50 @@ | ||
grinMain = n1 <- pure (CInt 1) | ||
t1 <- store n1 | ||
n2 <- pure (CInt 10000) | ||
t2 <- store n2 | ||
n3 <- pure (Fupto t1 t2) | ||
t3 <- store n3 | ||
n4 <- pure (Flength t3) | ||
t4 <- store n4 | ||
n5 <- eval t4 | ||
(CInt r') <- pure n5 | ||
_prim_int_print r' | ||
|
||
upto m n = n6 <- eval m | ||
(CInt m') <- pure n6 | ||
n7 <- eval n | ||
(CInt n') <- pure n7 | ||
b' <- _prim_int_gt m' n' | ||
if b' then | ||
n8 <- pure (CNil) | ||
pure n8 | ||
else | ||
m1' <- _prim_int_add m' 1 | ||
n9 <- pure (CInt m1') | ||
m1 <- store n9 | ||
n10 <- pure (Fupto m1 n) | ||
p <- store n10 | ||
n11 <- pure (CCons m p) | ||
pure n11 | ||
|
||
length l = l2 <- eval l | ||
case l2 of | ||
(CNil) -> n12 <- pure (CInt 0) | ||
pure n12 | ||
(CCons x xs) -> n13 <- length xs | ||
(CInt l') <- pure n13 | ||
len <- _prim_int_add l' 1 | ||
n14 <- pure (CInt len) | ||
pure n14 | ||
|
||
eval q = v <- fetch q | ||
case v of | ||
(CInt x'1) -> pure v | ||
(CNil) -> pure v | ||
(CCons y ys) -> pure v | ||
(Fupto a b) -> w <- upto a b | ||
update q w | ||
pure w | ||
(Flength c) -> z <- length c | ||
update q z | ||
pure z |
File renamed without changes.
File renamed without changes.
File renamed without changes.
File renamed without changes.
Empty file.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,8 @@ | ||
module Main where | ||
|
||
import Test.Hspec (hspec) | ||
import Test.Hspec.Compiler (endToEnd) | ||
|
||
|
||
main :: IO () | ||
main = hspec $ endToEnd "./grin/test-data/" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,105 @@ | ||
{-# LANGUAGE TypeFamilies, LambdaCase #-} | ||
module Test.Hspec.Compiler where | ||
|
||
import Control.Monad (forM, when) | ||
import Test.Hspec.Core.Spec hiding (pending) | ||
import System.Directory.Tree | ||
import System.FilePath.Posix | ||
import System.Directory (doesFileExist) | ||
import Data.Yaml as Yaml | ||
import CLI.Lib (mainWithArgs) | ||
import Data.IORef | ||
|
||
|
||
data InputFile | ||
= Binary FilePath | ||
| Textual FilePath | ||
deriving (Eq, Show) | ||
|
||
inputToFilePath :: InputFile -> FilePath | ||
inputToFilePath = \case | ||
Binary fp -> fp | ||
Textual fp -> fp | ||
|
||
data CompilerTest | ||
= PipelineTest | ||
{ compilerInput :: InputFile -- name.grin name.binary | ||
, compilerOptions :: [String] -- input.opts | ||
, compilerExpected :: FilePath -- input.expected | ||
} | ||
| EndToEndTest | ||
{ compilerInput :: InputFile | ||
} | ||
|
||
-- TODO: Documentation | ||
evaluatePipelineTest input options expected params actionWith progressCallback = do | ||
result <- newIORef $ Result "" Success | ||
actionWith $ \() -> do | ||
let args = case input of | ||
Binary fp -> [fp, "--load-binary"] | ||
Textual fp -> [fp] | ||
let outFile = inputToFilePath input <.> "out" | ||
mainWithArgs $ args ++ options ++ ["--save-grin=" ++ outFile] | ||
content <- readFile outFile | ||
expected <- readFile expected | ||
when (content /= expected) $ error "BLAH." | ||
readIORef result | ||
|
||
-- TODO: Checking run result and bisecting | ||
evaluateEndToEndTest input params actionWith progressCallback = do | ||
result <- newIORef $ Result "" Success | ||
actionWith $ \() -> do | ||
let args = case input of | ||
Binary fp -> [fp, "--load-binary"] | ||
Textual fp -> [fp] | ||
mainWithArgs args | ||
readIORef result | ||
|
||
instance Example CompilerTest where | ||
type Arg CompilerTest = () | ||
evaluateExample compilerTest = case compilerTest of | ||
PipelineTest i o e -> evaluatePipelineTest i o e | ||
EndToEndTest i -> evaluateEndToEndTest i | ||
|
||
endToEnd :: FilePath -> Spec | ||
endToEnd dp = describe "End to end tests" $ do | ||
compilerTests <- runIO $ readDirectoryWith createTest dp | ||
treeToSpec $ dirTree compilerTests | ||
|
||
createTest :: FilePath -> IO (Maybe (Either String CompilerTest)) | ||
createTest fp = do | ||
let isTest = takeExtension fp `elem` [".grin", ".binary"] | ||
case isTest of | ||
False -> pure Nothing | ||
True -> do | ||
hasOpts <- doesFileExist (fp <.> "opts") | ||
hasExpected <- doesFileExist (fp <.> "expected") | ||
case (hasOpts, hasExpected) of | ||
(True, False) -> pure $ Just $ Left $ unwords ["Missing expected result file:", fp <.> "expected"] | ||
(False, True) -> pure $ Just $ Left $ unwords ["Missing options file:", fp <.> "opts"] | ||
(False, False) -> pure $ Just $ Right $ EndToEndTest $ inputFile fp | ||
(True, True) -> Just <$> createPipelineTest fp | ||
|
||
inputFile :: FilePath -> InputFile | ||
inputFile fp = case takeExtension fp of | ||
".grin" -> Textual fp | ||
".binary" -> Binary fp | ||
|
||
createPipelineTest :: FilePath -> IO (Either String CompilerTest) | ||
createPipelineTest fp = do | ||
eopts <- Yaml.decodeFileWithWarnings (fp <.> "opts") | ||
case eopts of | ||
Left errs -> pure $ Left $ show errs | ||
Right (warnings, opts) -> do | ||
print ("YAML warnings:", warnings) | ||
pure $ Right $ PipelineTest | ||
{ compilerInput = inputFile fp | ||
, compilerOptions = opts | ||
, compilerExpected = fp <.> "expected" | ||
} | ||
|
||
treeToSpec :: DirTree (Maybe (Either String CompilerTest)) -> Spec | ||
treeToSpec = \case | ||
Failed name ex -> it name $ pendingWith $ show ex | ||
Dir name contents -> describe name $ mapM_ treeToSpec contents | ||
File name test -> maybe (pure ()) (either (it name . pendingWith) (it name)) test |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.