79 lines
2.8 KiB
Haskell
79 lines
2.8 KiB
Haskell
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"
|