elna/tests/Language/Elna/NameAnalysisSpec.hs

module Language.Elna.NameAnalysisSpec
    ( spec
    ) where

import Data.Text (Text)
import Text.Megaparsec (runParser)
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")

    it "puts parameters into the local symbol table" $ do
        let given = "proc main(ref param: int) {}"
            expected = SymbolTable.enter "param" (VariableInfo True intType) SymbolTable.empty
        actual <- nameAnalysisOnText given

        case SymbolTable.lookup "main" <$> actual of
            Right lookupResult
                | Just (ProcedureInfo localTable _) <- lookupResult ->
                    Just localTable `shouldBe` expected
            _ -> expectationFailure "Procedure symbol not found"

    it "puts variables into the local symbol table" $ do
        let given = "proc main() { var var1: int; }"
            expected = SymbolTable.enter "var1" (VariableInfo False intType) SymbolTable.empty
        actual <- nameAnalysisOnText given

        case SymbolTable.lookup "main" <$> actual of
            Right lookupResult
                | Just (ProcedureInfo localTable _) <- lookupResult ->
                    Just localTable `shouldBe` expected
            _ -> expectationFailure "Procedure symbol not found"