Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix tests

Browse source
This commit is contained in:
Martin Fredin 2023-04-03 09:39:24 +02:00
parent 0d6c5920a9
commit c998241c65
1 changed files with 12 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

32
tests/TestTypeCheckerHm.hs
View file

@ -1,26 +1,18 @@
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE QualifiedDo #-}
module TestTypeCheckerHm where module TestTypeCheckerHm where
import Control.Monad ((<=<)) import Control.Monad ((<=<))
import DoStrings qualified as D import qualified DoStrings as D
import Grammar.Par (myLexer, pProgram) import Grammar.Par (myLexer, pProgram)
import Grammar.Print (printTree) import Grammar.Print (printTree)
import Test.Hspec import Prelude (Bool (..), Either (..), fmap,
import Prelude ( foldl1, fst, not, ($), (.), (>>))
Bool (..), import Test.Hspec
Either (..),
fmap,
foldl1,
not,
($),
(.),
(>>),
)
-- import Test.QuickCheck -- import Test.QuickCheck
import TypeChecker.TypeCheckerHm (typecheck) import TypeChecker.TypeCheckerHm (typecheck)
testTypeCheckerHm = describe "Hindley-Milner type checker test" $ do testTypeCheckerHm = describe "Hindley-Milner type checker test" $ do
foldl1 (>>) goods foldl1 (>>) goods
@ -217,10 +209,10 @@ bes =
testSatisfy desc test satisfaction = specify desc $ run test `shouldSatisfy` satisfaction testSatisfy desc test satisfaction = specify desc $ run test `shouldSatisfy` satisfaction
testBe desc test shouldbe = specify desc $ run test `shouldBe` run shouldbe testBe desc test shouldbe = specify desc $ run test `shouldBe` run shouldbe
run = fmap printTree . typecheck <=< pProgram . myLexer run = fmap (printTree . fst) . typecheck <=< pProgram . myLexer
ok (Right _) = True ok (Right _) = True
ok (Left _) = False ok (Left _) = False
bad = not . ok bad = not . ok
@ -232,7 +224,7 @@ _const = D.do
_List = D.do _List = D.do
"data List (a) where" "data List (a) where"
" {" " {"
" Nil : List (a)" " Nil : List (a);"
" Cons : a -> List (a) -> List (a)" " Cons : a -> List (a) -> List (a)"
" };" " };"