mirror of
https://github.com/grin-compiler/grin.git
synced 2024-09-11 07:25:28 +03:00
Compiler test: check against user defined output filenames.
This commit is contained in:
parent
d95f5e09e0
commit
c403598d77
3
.gitignore
vendored
3
.gitignore
vendored
@ -26,4 +26,5 @@ output/
|
||||
.grin-output/
|
||||
.vscode/
|
||||
*.out
|
||||
|
||||
*.out.ll
|
||||
*.out.s
|
||||
|
@ -39,7 +39,6 @@ script:
|
||||
- stack build --coverage
|
||||
- stack exec grin-test --coverage
|
||||
- stack exec grin-end-to-end-test --coverage
|
||||
- stack exec grin -- grin/grin/sum_simple.grin
|
||||
|
||||
after_script:
|
||||
- travis_retry curl -L https://github.com/rubik/stack-hpc-coveralls/releases/download/v0.0.4.0/shc-linux-x64-8.0.1.tar.bz2 | tar -xj
|
||||
|
@ -1,3 +1,5 @@
|
||||
outputExtension: "out"
|
||||
grinOptions:
|
||||
- "--quiet"
|
||||
- "--dpe"
|
||||
- "--save-grin=$$$OUT$$$"
|
||||
|
37
grin/test-data/sum-simple/sum_simple_exp.grin
Normal file
37
grin/test-data/sum-simple/sum_simple_exp.grin
Normal file
@ -0,0 +1,37 @@
|
||||
grinMain = t1 <- store (CInt 1)
|
||||
t2 <- store (CInt 10000)
|
||||
t3 <- store (Fupto t1 t2)
|
||||
t4 <- store (Fsum t3)
|
||||
(CInt r') <- eval t4
|
||||
_prim_int_print r'
|
||||
|
||||
upto m n = (CInt m') <- eval m
|
||||
(CInt n') <- eval n
|
||||
b' <- _prim_int_gt m' n'
|
||||
if b' then
|
||||
pure (CNil)
|
||||
else
|
||||
m1' <- _prim_int_add m' 1
|
||||
m1 <- store (CInt m1')
|
||||
p <- store (Fupto m1 n)
|
||||
pure (CCons m p)
|
||||
|
||||
sum l = l2 <- eval l
|
||||
case l2 of
|
||||
(CNil) -> pure (CInt 0)
|
||||
(CCons x xs) -> (CInt x') <- eval x
|
||||
(CInt s') <- sum xs
|
||||
ax' <- _prim_int_add x' s'
|
||||
pure (CInt ax')
|
||||
|
||||
eval q = v <- fetch q
|
||||
case v of
|
||||
(CInt x'1) -> pure (CInt x'1)
|
||||
(CNil) -> pure (CNil)
|
||||
(CCons y ys) -> pure (CCons y ys)
|
||||
(Fupto a b) -> w <- upto a b
|
||||
update q w
|
||||
pure w
|
||||
(Fsum c) -> z <- sum c
|
||||
update q z
|
||||
pure z
|
24
grin/test-data/sum-simple/sum_simple_exp.grin.expected
Normal file
24
grin/test-data/sum-simple/sum_simple_exp.grin.expected
Normal file
@ -0,0 +1,24 @@
|
||||
.text
|
||||
.file "<string>"
|
||||
.globl grinMain # -- Begin function grinMain
|
||||
.p2align 4, 0x90
|
||||
.type grinMain,@function
|
||||
grinMain: # @grinMain
|
||||
.cfi_startproc
|
||||
# %bb.0: # %grinMain.entry
|
||||
movl $50005000, %edi # imm = 0x2FB0408
|
||||
jmp _prim_int_print # TAILCALL
|
||||
.Lfunc_end0:
|
||||
.size grinMain, .Lfunc_end0-grinMain
|
||||
.cfi_endproc
|
||||
# -- End function
|
||||
.type _heap_ptr_,@object # @_heap_ptr_
|
||||
.bss
|
||||
.globl _heap_ptr_
|
||||
.p2align 3
|
||||
_heap_ptr_:
|
||||
.quad 0 # 0x0
|
||||
.size _heap_ptr_, 8
|
||||
|
||||
|
||||
.section ".note.GNU-stack","",@progbits
|
6
grin/test-data/sum-simple/sum_simple_exp.grin.opts
Normal file
6
grin/test-data/sum-simple/sum_simple_exp.grin.opts
Normal file
@ -0,0 +1,6 @@
|
||||
outputExtension: "out.s"
|
||||
grinOptions:
|
||||
- "--optimize"
|
||||
- "--hpt"
|
||||
- "--quiet"
|
||||
- "--save-llvm=$$$OUT$$$"
|
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TypeFamilies, LambdaCase, TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies, LambdaCase, TypeApplications, DeriveGeneric #-}
|
||||
module Test.Hspec.Compiler where
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
@ -22,6 +22,7 @@ import Data.Char (isDigit)
|
||||
import Data.List (isSuffixOf)
|
||||
import Data.String.Utils (replace)
|
||||
import System.Directory
|
||||
import GHC.Generics
|
||||
|
||||
|
||||
data InputFile
|
||||
@ -39,13 +40,14 @@ data CompilerTest
|
||||
{ compilerInput :: InputFile -- name.grin name.binary
|
||||
, compilerOptions :: [String] -- input.opts
|
||||
, compilerExpected :: FilePath -- input.expected
|
||||
, compilerOutputExt :: FilePath -- input.out -- defined in configuration
|
||||
}
|
||||
| EndToEndTest
|
||||
{ compilerInput :: InputFile
|
||||
}
|
||||
|
||||
-- TODO: Documentation
|
||||
evaluatePipelineTest input options expected params actionWith progressCallback = do
|
||||
evaluatePipelineTest input options expected ext params actionWith progressCallback = do
|
||||
result <- newIORef $ Result "" $ Failure Nothing $ Reason "End-to-end test did not set test as success."
|
||||
actionWith $ \() -> catch
|
||||
(do let args = case input of
|
||||
@ -53,7 +55,7 @@ evaluatePipelineTest input options expected params actionWith progressCallback =
|
||||
Textual fp -> [fp]
|
||||
let outFile = inputToFilePath input <.> "out"
|
||||
mainWithArgs $ args ++ (map (replace "$$$OUT$$$" outFile) options)
|
||||
content <- readFile outFile
|
||||
content <- readFile (inputToFilePath input <.> ext)
|
||||
expected <- readFile expected
|
||||
if (content == expected)
|
||||
then writeIORef result $ Result "" Success
|
||||
@ -156,7 +158,7 @@ bisect directory expected = do
|
||||
instance Example CompilerTest where
|
||||
type Arg CompilerTest = ()
|
||||
evaluateExample compilerTest = case compilerTest of
|
||||
PipelineTest i o e -> evaluatePipelineTest i o e
|
||||
PipelineTest i o e x -> evaluatePipelineTest i o e x
|
||||
EndToEndTest i -> evaluateEndToEndTest i
|
||||
|
||||
endToEnd :: FilePath -> Spec
|
||||
@ -183,21 +185,32 @@ inputFile fp = case takeExtension fp of
|
||||
".grin" -> Textual fp
|
||||
".binary" -> Binary fp
|
||||
|
||||
data Options = Options
|
||||
{ outputExtension :: String
|
||||
, grinOptions :: [String]
|
||||
} deriving (Generic)
|
||||
|
||||
instance FromJSON Options
|
||||
|
||||
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)
|
||||
Right (warnings, Options ext opts) -> do
|
||||
pure $ Right $ PipelineTest
|
||||
{ compilerInput = inputFile fp
|
||||
, compilerOptions = opts
|
||||
, compilerExpected = fp <.> "expected"
|
||||
, compilerOutputExt = ext
|
||||
}
|
||||
|
||||
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
|
||||
File name test -> maybe (pure ()) (either (it name . pendingWith) (itName name)) test
|
||||
where
|
||||
itName name test = case test of
|
||||
PipelineTest{} -> it ("pipeline-test: " ++ name) test
|
||||
EndToEndTest{} -> it ("end-to-end: " ++ name) test
|
||||
|
Loading…
Reference in New Issue
Block a user