blob: 10e6ee064891dc06dbe2dbb6bc2d41e2ec4e0494 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
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"
|
