Skip to content

Commit 1cc8a77

Browse files
committed
Add tests for CBPV ASTs
1 parent 5f4d19e commit 1cc8a77

13 files changed

Lines changed: 1314 additions & 19 deletions

test/Main.hs

Lines changed: 34 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ import Control.Monad (void)
44
import Data.ByteString.Lazy qualified as LBS
55
import System.Directory (makeAbsolute)
66
import System.FilePath (takeFileName, (<.>), (</>))
7-
import System.IO (hClose)
7+
import System.IO (hClose, Handle)
88
import System.IO.Temp (withSystemTempFile)
99
import System.Timeout (timeout)
1010
import Test.Tasty
@@ -21,7 +21,15 @@ tests allExamples =
2121
testGroup "λ-compiler tests"
2222
[ testGroup "examples"
2323

24-
[ testGroup "compile"
24+
[ testGroup "cbpv"
25+
[ anyCBPVTests allExamples
26+
]
27+
28+
, testGroup "cbpv-opt"
29+
[ anyCBPVOptTests allExamples
30+
]
31+
32+
, testGroup "compile"
2533
[ cCompileTests allExamples
2634
, amCompileTests allExamples
2735
]
@@ -33,6 +41,22 @@ tests allExamples =
3341
]
3442
]
3543

44+
anyCBPVTests :: [FilePath] -> TestTree
45+
anyCBPVTests allExamples =
46+
testGroup "Any backend"
47+
$ getCBPVOfExample (makeAMOptions UntilCBPV) <$> allExamples
48+
49+
getCBPVOfExample :: (FilePath -> Options) -> String -> TestTree
50+
getCBPVOfExample = goldenOf "cbpv" mainFuncWithOptions
51+
52+
anyCBPVOptTests :: [FilePath] -> TestTree
53+
anyCBPVOptTests allExamples =
54+
testGroup "Any backend"
55+
$ getCBPVOptOfExample (makeAMOptions UntilCBPVOpt) <$> allExamples
56+
57+
getCBPVOptOfExample :: (FilePath -> Options) -> String -> TestTree
58+
getCBPVOptOfExample = goldenOf ("cbpv" <.> "opt") mainFuncWithOptions
59+
3660
cCompileTests :: [FilePath] -> TestTree
3761
cCompileTests allExamples =
3862
testGroup "C backend"
@@ -44,16 +68,7 @@ amCompileTests allExamples =
4468
$ compileOfExample "am" (makeAMOptions UntilAM) <$> allExamples
4569

4670
compileOfExample :: String -> (FilePath -> Options) -> String -> TestTree
47-
compileOfExample tag optionBuilder s =
48-
goldenVsStringDiff s gitDiff ("." </> "test" </> "golden" </> s <.> tag <.> "compile")
49-
$ withSystemTempFile s
50-
$ \fp handle -> do
51-
getExamplePath s
52-
>>= void
53-
. mainFuncWithOptions handle
54-
. optionBuilder
55-
hClose handle
56-
LBS.take 10000 <$> LBS.readFile fp
71+
compileOfExample tag = goldenOf (tag <.> "compile") mainFuncWithOptions
5772

5873
cExecutionTests :: [FilePath] -> TestTree
5974
cExecutionTests allExamples =
@@ -66,15 +81,15 @@ amExecutionTests allExamples =
6681
$ executionOfExample "am" (makeAMOptions Run) <$> allExamples
6782

6883
executionOfExample :: String -> (FilePath -> Options) -> String -> TestTree
69-
executionOfExample tag optionBuilder s =
70-
goldenVsStringDiff s gitDiff ("." </> "test" </> "golden" </> s <.> tag <.> "execution")
84+
executionOfExample tag = goldenOf (tag <.> "execution") $ \handle ->
85+
timeout 300000 . mainFuncWithOptions handle
86+
87+
goldenOf :: String -> (Handle -> Options -> IO a) -> (FilePath -> Options) -> String -> TestTree
88+
goldenOf tag f optionBuilder s =
89+
goldenVsStringDiff s gitDiff ("." </> "test" </> "golden" </> s <.> tag)
7190
$ withSystemTempFile s
7291
$ \fp handle -> do
73-
getExamplePath s
74-
>>= void
75-
. timeout 300000
76-
. mainFuncWithOptions handle
77-
. optionBuilder
92+
getExamplePath s >>= void . f handle . optionBuilder
7893
hClose handle
7994
LBS.take 10000 <$> LBS.readFile fp
8095

test/golden/Fib10.lc.cbpv

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
[ TopTmDef
2+
{ tmDefName = "u_recFib"
3+
, tmDefBody = TmThunk
4+
( TmRec "u_recFib"
5+
( TpUp
6+
( TpFun TpInt
7+
( TpDown
8+
( TpUp
9+
( TpFun TpInt
10+
( TpDown
11+
( TpUp
12+
( TpFun TpInt
13+
( TpDown
14+
( TpUp
15+
( TpFun TpInt ( TpDown TpInt ) )
16+
)
17+
)
18+
)
19+
)
20+
)
21+
)
22+
)
23+
)
24+
)
25+
)
26+
( TmTo
27+
( TmReturn
28+
( TmThunk
29+
( TmLam
30+
( Param
31+
{ paramName = "u_n"
32+
, paramType = TpInt
33+
}
34+
)
35+
( TmReturn
36+
( TmThunk
37+
( TmLam
38+
( Param
39+
{ paramName = "u_l"
40+
, paramType = TpInt
41+
}
42+
)
43+
( TmReturn
44+
( TmThunk
45+
( TmLam
46+
( Param
47+
{ paramName = "u_x"
48+
, paramType = TpInt
49+
}
50+
)
51+
( TmReturn
52+
( TmThunk
53+
( TmLam
54+
( Param
55+
{ paramName = "u_y"
56+
, paramType = TpInt
57+
}
58+
)
59+
( TmTo
60+
( TmTo
61+
( TmReturn
62+
( TmVar "u_n" )
63+
) "c_inp0_0"
64+
( TmTo
65+
( TmReturn
66+
( TmVar "u_l" )
67+
) "c_inp1_0"
68+
( TmPrimBinOp PrimILt
69+
( TmVar "c_inp0_0" )
70+
( TmVar "c_inp1_0" )
71+
)
72+
)
73+
) "c_c_1"
74+
( TmIf
75+
( TmVar "c_c_1" )
76+
( TmReturn
77+
( TmInt 0 )
78+
)
79+
( TmTo
80+
( TmReturn
81+
( TmVar "u_l" )
82+
) "c_v_2"
83+
( TmPrintInt
84+
( TmVar "c_v_2" )
85+
( TmTo
86+
( TmReturn
87+
( TmVar "u_x" )
88+
) "c_v_3"
89+
( TmPrintInt
90+
( TmVar "c_v_3" )
91+
( TmTo
92+
( TmReturn
93+
( TmVar "u_n" )
94+
) "c_a0_6"
95+
( TmTo
96+
( TmTo
97+
( TmReturn
98+
( TmVar "u_l" )
99+
) "c_inp0_4"
100+
( TmTo
101+
( TmReturn
102+
( TmInt 1 )
103+
) "c_inp1_4"
104+
( TmPrimBinOp PrimIAdd
105+
( TmVar "c_inp0_4" )
106+
( TmVar "c_inp1_4" )
107+
)
108+
)
109+
) "c_a1_6"
110+
( TmTo
111+
( TmReturn
112+
( TmVar "u_y" )
113+
) "c_a2_6"
114+
( TmTo
115+
( TmTo
116+
( TmReturn
117+
( TmVar "u_x" )
118+
) "c_inp0_5"
119+
( TmTo
120+
( TmReturn
121+
( TmVar "u_y" )
122+
) "c_inp1_5"
123+
( TmPrimBinOp PrimIAdd
124+
( TmVar "c_inp0_5" )
125+
( TmVar "c_inp1_5" )
126+
)
127+
)
128+
) "c_a3_6"
129+
( TmTo
130+

0 commit comments

Comments
 (0)