elna/tests/Language/Elna/NameAnalysisSpec.hs

79 lines
2.8 KiB
Haskell
Raw Normal View History

module Language.Elna.NameAnalysisSpec
( spec
) where
import Data.Text (Text)
import Text.Megaparsec (runParser)
2024-08-04 12:23:19 +02:00
import Test.Hspec
( Spec
, describe
, expectationFailure
, it
, shouldBe
, shouldSatisfy
)
import Language.Elna.NameAnalysis (Error(..), nameAnalysis)
import Language.Elna.SymbolTable (Info(..), SymbolTable)
import qualified Language.Elna.SymbolTable as SymbolTable
import qualified Language.Elna.Parser as AST
import Language.Elna.Types (intType)
import Control.Exception (throwIO)
nameAnalysisOnText :: Text -> IO (Either Error SymbolTable)
nameAnalysisOnText sourceText = nameAnalysis
<$> either throwIO pure (runParser AST.programP "" sourceText)
spec :: Spec
spec = describe "nameAnalysis" $ do
it "adds type to the symbol table" $ do
let given = "type A = int;"
expected = Right $ Just $ TypeInfo intType
actual <- nameAnalysisOnText given
actual `shouldSatisfy` (expected ==) . fmap (SymbolTable.lookup "A")
it "errors when the aliased type is not defined" $ do
let given = "type A = B;"
expected = Left $ UndefinedTypeError "B"
actual <- nameAnalysisOnText given
actual `shouldBe` expected
it "errors if the aliased identifier is not a type" $ do
let given = "proc main() {} type A = main;"
expected = Left
$ UnexpectedTypeInfoError
$ ProcedureInfo mempty mempty
actual <- nameAnalysisOnText given
actual `shouldBe` expected
it "replaces the alias with an equivalent base type" $ do
let given = "type A = int; type B = A; type C = B;"
expected = Right $ Just $ TypeInfo intType
actual <- nameAnalysisOnText given
actual `shouldSatisfy` (expected ==) . fmap (SymbolTable.lookup "C")
2024-08-04 12:23:19 +02:00
it "puts parameters into the local symbol table" $ do
let given = "proc main(ref param: int) {}"
2024-08-12 21:00:52 +02:00
expected = SymbolTable.enter "param" (VariableInfo True intType) SymbolTable.empty
2024-08-04 12:23:19 +02:00
actual <- nameAnalysisOnText given
case SymbolTable.lookup "main" <$> actual of
Right lookupResult
| Just (ProcedureInfo localTable _) <- lookupResult ->
2024-08-05 22:56:35 +02:00
Just localTable `shouldBe` expected
2024-08-04 12:23:19 +02:00
_ -> expectationFailure "Procedure symbol not found"
it "puts variables into the local symbol table" $ do
let given = "proc main() { var var1: int; }"
2024-08-12 21:00:52 +02:00
expected = SymbolTable.enter "var1" (VariableInfo False intType) SymbolTable.empty
2024-08-04 12:23:19 +02:00
actual <- nameAnalysisOnText given
case SymbolTable.lookup "main" <$> actual of
Right lookupResult
| Just (ProcedureInfo localTable _) <- lookupResult ->
2024-08-05 22:56:35 +02:00
Just localTable `shouldBe` expected
2024-08-04 12:23:19 +02:00
_ -> expectationFailure "Procedure symbol not found"