Add simple test

miniml.cabal

@@ -97,6 +97,7 @@ test-suite tests
         Sample.AnfTest
         Sample.FactorialTest
         Sample.FibonacciTest
+        Sample.SimpleTest
         Unit.Parser.ParserTest
         Unit.StdLibTest
         Unit.TypeInference.TypeInferenceTest

test/Main.hs

@@ -5,6 +5,7 @@ module Main where
 import qualified Sample.AnfTest
 import qualified Sample.FactorialTest
 import qualified Sample.FibonacciTest
+import qualified Sample.SimpleTest
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import qualified Unit.Parser.ParserTest as Unit.ParserTest
 import qualified Unit.StdLibTest
@@ -28,5 +29,6 @@ sampleTests =
     "sample tests (Golden)"
     [ Sample.FactorialTest.tests,
       Sample.FibonacciTest.tests,
-      Sample.AnfTest.tests
+      Sample.AnfTest.tests,
+      Sample.SimpleTest.tests
     ]

test/Sample/Simple/SimpleTest.anf

@@ -0,0 +1,5 @@
+let id'2 x'1 = x'1;;
+let k'4 x'3 = (x'3 42);;
+let simp'5 = 
+  let anf'6 = (k'4 id'2)
+  in (print_int anf'6);;

test/Sample/Simple/SimpleTest.ast

@@ -0,0 +1,39 @@
+Just
+    ( Program
+        [ StmtDecl
+            ( DeclFun "id" False
+                ( Fun
+                    (
+                        ( "x"
+                        , Nothing
+                        ) :| []
+                    ) Nothing
+                    ( ExprId "x" )
+                )
+            )
+        , StmtDecl
+            ( DeclFun "k" False
+                ( Fun
+                    (
+                        ( "x"
+                        , Nothing
+                        ) :| []
+                    ) Nothing
+                    ( ExprApp
+                        ( ExprId "x" )
+                        ( ExprPrimVal
+                            ( PrimValInt 42 )
+                        )
+                    )
+                )
+            )
+        , StmtExpr
+            ( ExprApp
+                ( ExprId "print_int" )
+                ( ExprApp
+                    ( ExprId "k" )
+                    ( ExprId "id" )
+                )
+            )
+        ]
+    )

test/Sample/Simple/SimpleTest.ll

@@ -0,0 +1,50 @@
+; ModuleID = 'simpleTest'
+
+
+
+
+
+declare external ccc  i64 @not(i64)    
+
+
+declare external ccc  i64 @print_bool(i64)    
+
+
+declare external ccc  i64 @print_int(i64)    
+
+
+declare external ccc  i64 @miniml_div(i64, i64)    
+
+
+declare external ccc  i64 @miniml_fun_to_paf(i64, i64)    
+
+
+declare external ccc  i64 @miniml_apply(i64, i64)    
+
+
+define external ccc  i64 @id.2(i64  %x.1_0)    {
+  ret i64 %x.1_0 
+}
+
+
+define external ccc  i64 @k.4(i64  %x.3_0)    {
+  %1 =  call ccc  i64  @miniml_apply(i64  %x.3_0, i64  42)  
+  ret i64 %1 
+}
+
+
+@simp.5 =    global i64 0
+
+
+define external ccc  i64 @main()    {
+  %anf.6_0 = ptrtoint i64 (i64)* @k.4 to i64 
+  %anf.6_1 =  call ccc  i64  @miniml_fun_to_paf(i64  %anf.6_0, i64  1)  
+  %anf.6_2 = ptrtoint i64 (i64)* @id.2 to i64 
+  %anf.6_3 =  call ccc  i64  @miniml_fun_to_paf(i64  %anf.6_2, i64  1)  
+  %anf.6_4 =  call ccc  i64  @miniml_apply(i64  %anf.6_1, i64  %anf.6_3)  
+  %1 = ptrtoint i64 (i64)* @print_int to i64 
+  %2 =  call ccc  i64  @miniml_fun_to_paf(i64  %1, i64  1)  
+  %3 =  call ccc  i64  @miniml_apply(i64  %2, i64  %anf.6_4)  
+  store  i64 %3, i64* @simp.5 
+  ret i64 0 
+}

test/Sample/Simple/SimpleTest.ml

@@ -0,0 +1,5 @@
+let id x = x;;
+
+let k x = x 42;;
+
+print_int (k id)

test/Sample/Simple/SimpleTest.out

@@ -0,0 +1 @@
+42

test/Sample/SimpleTest.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Sample.SimpleTest (tests) where
+
+import Data.ByteString.Lazy.Char8 (pack)
+import qualified Data.Text.IO as LBS
+import Data.Text.Lazy (unpack)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.Golden (goldenVsString)
+import Test.Tasty.HUnit (testCase, (@?=))
+import Text.Pretty.Simple (pShowNoColor)
+import Utils (processTillAnfGen, processTillLlvmIr, processTillLlvmRunOutput, processTillParser, processTillVerify)
+
+tests :: TestTree
+tests =
+  testGroup
+    "simpleTest"
+    [ testParsing simpleTest,
+      testTypeCheck simpleTest,
+      testAstToAnf simpleTest,
+      testLlvm simpleTest,
+      testLlvmRun simpleTest
+    ]
+
+-- Test types
+
+testParsing :: TestFileProvider -> TestTree
+testParsing (title, testFileProvider) =
+  goldenVsString
+    (title <> " - parsing")
+    (testFileProvider "ast")
+    (pack . unpack . pShowNoColor . processTillParser <$> LBS.readFile (testFileProvider "ml"))
+
+testTypeCheck :: TestFileProvider -> TestTree
+testTypeCheck (title, testFileProvider) =
+  testCase (title <> " - type checking") $ do
+    isOk <- processTillVerify <$> LBS.readFile (testFileProvider "ml")
+    isOk @?= True
+
+testAstToAnf :: TestFileProvider -> TestTree
+testAstToAnf (title, testFileProvider) =
+  goldenVsString
+    (title <> " - ANF")
+    (testFileProvider "anf")
+    (pack . processTillAnfGen <$> LBS.readFile (testFileProvider "ml"))
+
+testLlvm :: TestFileProvider -> TestTree
+testLlvm (title, testFileProvider) =
+  goldenVsString
+    (title <> " - LLVM")
+    (testFileProvider "ll")
+    (pack . processTillLlvmIr "simpleTest" <$> LBS.readFile (testFileProvider "ml"))
+
+testLlvmRun :: TestFileProvider -> TestTree
+testLlvmRun (title, testFileProvider) =
+  goldenVsString
+    (title <> " - LLVM run")
+    (testFileProvider "out")
+    (pack . processTillLlvmRunOutput "simpleTest" <$> LBS.readFile (testFileProvider "ml"))
+
+-- Test file providers
+
+type TestFileProvider = (String, String -> FilePath)
+
+simpleTest :: TestFileProvider
+simpleTest = ("simple test", \ext -> testFile $ "SimpleTest." <> ext)
+
+testFile :: String -> String
+testFile filename = "test/Sample/Simple/" <> filename