Add semantic analyser with type inference and checking
TSemanticAnalyser walks the AST, resolves all identifiers via the symbol table, annotates every expression node with ResolvedType, and type-checks assignments and procedure calls. Raises ESemanticError with source position on undeclared identifiers, type mismatches, duplicate declarations, and unknown types. TProgram now owns the TSymbolTable after analysis so ResolvedType pointers remain valid for the lifetime of the AST. Also adds the 'div' keyword for integer division throughout the pipeline (lexer, parser, semantic). 26 new FPCUnit tests, 126 total, all passing.
This commit is contained in:
parent
a561525ebd
commit
4fbfdfdbba
|
|
@ -5,7 +5,7 @@ unit uAST;
|
|||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, contnrs;
|
||||
Classes, SysUtils, contnrs, uSymbolTable;
|
||||
|
||||
type
|
||||
{ Base node — all AST nodes carry source position. }
|
||||
|
|
@ -19,7 +19,11 @@ type
|
|||
{ Expressions }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
TASTExpr = class(TASTNode);
|
||||
{ Semantic analyser fills ResolvedType on every expression node. }
|
||||
TASTExpr = class(TASTNode)
|
||||
public
|
||||
ResolvedType: TTypeDesc; { set by uSemantic; nil until analysed }
|
||||
end;
|
||||
|
||||
TIntLiteral = class(TASTExpr)
|
||||
public
|
||||
|
|
@ -73,8 +77,9 @@ type
|
|||
|
||||
TVarDecl = class(TASTNode)
|
||||
public
|
||||
Names: TStringList; { owned — one or more names: x, y: Integer }
|
||||
TypeName: string;
|
||||
Names: TStringList; { owned — one or more names: x, y: Integer }
|
||||
TypeName: string;
|
||||
ResolvedType: TTypeDesc; { set by uSemantic; nil until analysed }
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
|
@ -93,15 +98,30 @@ type
|
|||
|
||||
TProgram = class(TASTNode)
|
||||
public
|
||||
Name: string;
|
||||
UsedUnits: TStringList; { owned — unit names from uses clause }
|
||||
Block: TBlock; { owned }
|
||||
Name: string;
|
||||
UsedUnits: TStringList; { owned — unit names from uses clause }
|
||||
Block: TBlock; { owned }
|
||||
SymbolTable: TSymbolTable; { owned after semantic analysis; nil before }
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
function BinaryOpName(AOp: TBinaryOp): string;
|
||||
|
||||
implementation
|
||||
|
||||
function BinaryOpName(AOp: TBinaryOp): string;
|
||||
begin
|
||||
case AOp of
|
||||
boAdd: Result := '+';
|
||||
boSub: Result := '-';
|
||||
boMul: Result := '*';
|
||||
boDiv: Result := 'div';
|
||||
else
|
||||
Result := '?';
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TBinaryExpr }
|
||||
|
||||
destructor TBinaryExpr.Destroy;
|
||||
|
|
@ -173,6 +193,7 @@ end;
|
|||
|
||||
destructor TProgram.Destroy;
|
||||
begin
|
||||
SymbolTable.Free;
|
||||
UsedUnits.Free;
|
||||
Block.Free;
|
||||
inherited Destroy;
|
||||
|
|
|
|||
|
|
@ -29,7 +29,8 @@ type
|
|||
tkPlus,
|
||||
tkMinus,
|
||||
tkStar,
|
||||
tkSlash,
|
||||
tkSlash, { '/' — future: float division }
|
||||
tkDiv, { 'div' keyword — integer division }
|
||||
{ Assignment and colon }
|
||||
tkAssign, { := }
|
||||
tkColon, { : }
|
||||
|
|
@ -81,6 +82,7 @@ begin
|
|||
else if AUpper = 'VAR' then Result := tkVar
|
||||
else if AUpper = 'BEGIN' then Result := tkBegin
|
||||
else if AUpper = 'END' then Result := tkEnd
|
||||
else if AUpper = 'DIV' then Result := tkDiv
|
||||
else
|
||||
Result := tkIdent; { keyword outside Phase 1 grammar treated as ident }
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -313,7 +313,7 @@ var
|
|||
Node: TBinaryExpr;
|
||||
begin
|
||||
Result := ParseFactor;
|
||||
while Check(tkStar) or Check(tkSlash) do
|
||||
while Check(tkStar) or Check(tkSlash) or Check(tkDiv) do
|
||||
begin
|
||||
if Check(tkStar) then Op := boMul else Op := boDiv;
|
||||
Advance;
|
||||
|
|
|
|||
233
compiler/src/main/pascal/uSemantic.pas
Normal file
233
compiler/src/main/pascal/uSemantic.pas
Normal file
|
|
@ -0,0 +1,233 @@
|
|||
unit uSemantic;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
// Semantic analysis pass — walks the AST produced by uParser and:
|
||||
// 1. Resolves every identifier to a TSymbol in the symbol table.
|
||||
// 2. Infers and annotates every expression node with ResolvedType.
|
||||
// 3. Type-checks assignments (lhs type == rhs type).
|
||||
// 4. Validates procedure/function calls (callee exists, arg types valid).
|
||||
// 5. Raises ESemanticError with source position on any violation.
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, uAST, uSymbolTable;
|
||||
|
||||
type
|
||||
ESemanticError = class(Exception);
|
||||
|
||||
TSemanticAnalyser = class
|
||||
private
|
||||
FTable: TSymbolTable;
|
||||
|
||||
procedure AnalyseBlock(ABlock: TBlock);
|
||||
procedure AnalyseVarDecls(ABlock: TBlock);
|
||||
procedure AnalyseStmts(ABlock: TBlock);
|
||||
procedure AnalyseStmt(AStmt: TASTStmt);
|
||||
procedure AnalyseAssignment(AAssign: TAssignment);
|
||||
procedure AnalyseProcCall(ACall: TProcCall);
|
||||
function AnalyseExpr(AExpr: TASTExpr): TTypeDesc;
|
||||
function AnalyseBinaryExpr(ABin: TBinaryExpr): TTypeDesc;
|
||||
|
||||
procedure SemanticError(const AMsg: string; ALine, ACol: Integer);
|
||||
procedure CheckTypesMatch(AExpected, AActual: TTypeDesc;
|
||||
const AContext: string; ALine, ACol: Integer);
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
procedure Analyse(AProg: TProgram);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
constructor TSemanticAnalyser.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FTable := TSymbolTable.Create;
|
||||
end;
|
||||
|
||||
destructor TSemanticAnalyser.Destroy;
|
||||
begin
|
||||
FTable.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.SemanticError(const AMsg: string; ALine, ACol: Integer);
|
||||
begin
|
||||
raise ESemanticError.CreateFmt('%s at line %d col %d', [AMsg, ALine, ACol]);
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.CheckTypesMatch(AExpected, AActual: TTypeDesc;
|
||||
const AContext: string; ALine, ACol: Integer);
|
||||
begin
|
||||
if AExpected <> AActual then
|
||||
SemanticError(
|
||||
Format('Type mismatch in %s: expected ''%s'' but got ''%s''',
|
||||
[AContext, AExpected.Name, AActual.Name]),
|
||||
ALine, ACol);
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.Analyse(AProg: TProgram);
|
||||
begin
|
||||
AnalyseBlock(AProg.Block);
|
||||
{ Transfer symbol table ownership to the program so that TTypeDesc
|
||||
objects (referenced by ResolvedType pointers on AST nodes) outlive
|
||||
this analyser. }
|
||||
AProg.SymbolTable := FTable;
|
||||
FTable := nil;
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.AnalyseBlock(ABlock: TBlock);
|
||||
begin
|
||||
FTable.PushScope;
|
||||
try
|
||||
AnalyseVarDecls(ABlock);
|
||||
AnalyseStmts(ABlock);
|
||||
finally
|
||||
FTable.PopScope;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.AnalyseVarDecls(ABlock: TBlock);
|
||||
var
|
||||
I, J: Integer;
|
||||
Decl: TVarDecl;
|
||||
Typ: TTypeDesc;
|
||||
VarName: string;
|
||||
Sym: TSymbol;
|
||||
begin
|
||||
for I := 0 to ABlock.Decls.Count - 1 do
|
||||
begin
|
||||
Decl := TVarDecl(ABlock.Decls[I]);
|
||||
|
||||
Typ := FTable.FindType(Decl.TypeName);
|
||||
if Typ = nil then
|
||||
SemanticError(
|
||||
Format('Unknown type ''%s''', [Decl.TypeName]),
|
||||
Decl.Line, Decl.Col);
|
||||
|
||||
Decl.ResolvedType := Typ;
|
||||
|
||||
for J := 0 to Decl.Names.Count - 1 do
|
||||
begin
|
||||
VarName := Decl.Names[J];
|
||||
Sym := TSymbol.Create(VarName, skVariable, Typ);
|
||||
if not FTable.Define(Sym) then
|
||||
begin
|
||||
Sym.Free;
|
||||
SemanticError(
|
||||
Format('Duplicate identifier ''%s''', [VarName]),
|
||||
Decl.Line, Decl.Col);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.AnalyseStmts(ABlock: TBlock);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
for I := 0 to ABlock.Stmts.Count - 1 do
|
||||
AnalyseStmt(TASTStmt(ABlock.Stmts[I]));
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.AnalyseStmt(AStmt: TASTStmt);
|
||||
begin
|
||||
if AStmt is TAssignment then
|
||||
AnalyseAssignment(TAssignment(AStmt))
|
||||
else if AStmt is TProcCall then
|
||||
AnalyseProcCall(TProcCall(AStmt));
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.AnalyseAssignment(AAssign: TAssignment);
|
||||
var
|
||||
VarSym: TSymbol;
|
||||
ExprType: TTypeDesc;
|
||||
begin
|
||||
VarSym := FTable.Lookup(AAssign.Name);
|
||||
if VarSym = nil then
|
||||
SemanticError(
|
||||
Format('Undeclared variable ''%s''', [AAssign.Name]),
|
||||
AAssign.Line, AAssign.Col);
|
||||
if VarSym.Kind <> skVariable then
|
||||
SemanticError(
|
||||
Format('''%s'' is not a variable', [AAssign.Name]),
|
||||
AAssign.Line, AAssign.Col);
|
||||
|
||||
ExprType := AnalyseExpr(AAssign.Expr);
|
||||
CheckTypesMatch(VarSym.TypeDesc, ExprType, 'assignment', AAssign.Line, AAssign.Col);
|
||||
end;
|
||||
|
||||
procedure TSemanticAnalyser.AnalyseProcCall(ACall: TProcCall);
|
||||
var
|
||||
Sym: TSymbol;
|
||||
I: Integer;
|
||||
begin
|
||||
Sym := FTable.Lookup(ACall.Name);
|
||||
if Sym = nil then
|
||||
SemanticError(
|
||||
Format('Undeclared procedure ''%s''', [ACall.Name]),
|
||||
ACall.Line, ACall.Col);
|
||||
if not (Sym.Kind in [skProcedure, skFunction]) then
|
||||
SemanticError(
|
||||
Format('''%s'' is not a procedure or function', [ACall.Name]),
|
||||
ACall.Line, ACall.Col);
|
||||
|
||||
{ Analyse argument expressions for type correctness.
|
||||
Phase 1 built-ins (Write/WriteLn) accept any single argument —
|
||||
detailed overload resolution is a Phase 2 enhancement. }
|
||||
for I := 0 to ACall.Args.Count - 1 do
|
||||
AnalyseExpr(TASTExpr(ACall.Args[I]));
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.AnalyseExpr(AExpr: TASTExpr): TTypeDesc;
|
||||
var
|
||||
Sym: TSymbol;
|
||||
begin
|
||||
if AExpr is TIntLiteral then
|
||||
Result := FTable.TypeInteger
|
||||
else if AExpr is TStringLiteral then
|
||||
Result := FTable.TypeString
|
||||
else if AExpr is TIdentExpr then
|
||||
begin
|
||||
Sym := FTable.Lookup(TIdentExpr(AExpr).Name);
|
||||
if Sym = nil then
|
||||
SemanticError(
|
||||
Format('Undeclared identifier ''%s''', [TIdentExpr(AExpr).Name]),
|
||||
AExpr.Line, AExpr.Col);
|
||||
Result := Sym.TypeDesc;
|
||||
end
|
||||
else if AExpr is TBinaryExpr then
|
||||
Result := AnalyseBinaryExpr(TBinaryExpr(AExpr))
|
||||
else
|
||||
SemanticError('Unknown expression node', AExpr.Line, AExpr.Col);
|
||||
|
||||
AExpr.ResolvedType := Result;
|
||||
end;
|
||||
|
||||
function TSemanticAnalyser.AnalyseBinaryExpr(ABin: TBinaryExpr): TTypeDesc;
|
||||
var
|
||||
LType, RType: TTypeDesc;
|
||||
begin
|
||||
LType := AnalyseExpr(ABin.Left);
|
||||
RType := AnalyseExpr(ABin.Right);
|
||||
|
||||
{ Arithmetic operators require both operands to be numeric. }
|
||||
if not LType.IsNumeric then
|
||||
SemanticError(
|
||||
Format('Left operand of ''%s'' must be numeric, got ''%s''',
|
||||
[BinaryOpName(ABin.Op), LType.Name]),
|
||||
ABin.Line, ABin.Col);
|
||||
if not RType.IsNumeric then
|
||||
SemanticError(
|
||||
Format('Right operand of ''%s'' must be numeric, got ''%s''',
|
||||
[BinaryOpName(ABin.Op), RType.Name]),
|
||||
ABin.Line, ABin.Col);
|
||||
|
||||
CheckTypesMatch(LType, RType, 'binary expression', ABin.Line, ABin.Col);
|
||||
|
||||
Result := LType;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
@ -13,7 +13,8 @@ uses
|
|||
cp.test.lexer,
|
||||
cp.test.parser,
|
||||
cp.test.codegen,
|
||||
cp.test.symtable;
|
||||
cp.test.symtable,
|
||||
cp.test.semantic;
|
||||
|
||||
var
|
||||
Application: TTestRunner;
|
||||
|
|
|
|||
379
compiler/src/test/pascal/cp.test.semantic.pas
Normal file
379
compiler/src/test/pascal/cp.test.semantic.pas
Normal file
|
|
@ -0,0 +1,379 @@
|
|||
unit cp.test.semantic;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry,
|
||||
uLexer, uParser, uAST, uSymbolTable, uSemantic;
|
||||
|
||||
type
|
||||
TSemanticTests = class(TTestCase)
|
||||
private
|
||||
function Analyse(const ASrc: string): TProgram;
|
||||
procedure AnalyseExpectError(const ASrc: string);
|
||||
published
|
||||
{ Variable declarations are added to the symbol table }
|
||||
procedure TestVarDecl_RegistersSymbol;
|
||||
procedure TestVarDecl_Type_Integer;
|
||||
procedure TestVarDecl_Type_String;
|
||||
procedure TestVarDecl_MultiName_BothRegistered;
|
||||
procedure TestVarDecl_UnknownType_RaisesError;
|
||||
procedure TestVarDecl_Duplicate_RaisesError;
|
||||
|
||||
{ Expression type inference }
|
||||
procedure TestExpr_IntLiteral_TypeIsInteger;
|
||||
procedure TestExpr_StringLiteral_TypeIsString;
|
||||
procedure TestExpr_Ident_ResolvesToVarType;
|
||||
procedure TestExpr_Ident_Undeclared_RaisesError;
|
||||
procedure TestExpr_Add_TwoIntegers_TypeIsInteger;
|
||||
procedure TestExpr_Add_IntAndString_RaisesError;
|
||||
procedure TestExpr_Sub_TypeIsInteger;
|
||||
procedure TestExpr_Mul_TypeIsInteger;
|
||||
procedure TestExpr_Div_TypeIsInteger;
|
||||
|
||||
{ Assignment type checking }
|
||||
procedure TestAssign_IntToInt_OK;
|
||||
procedure TestAssign_StringToString_OK;
|
||||
procedure TestAssign_IntToString_RaisesError;
|
||||
procedure TestAssign_StringToInt_RaisesError;
|
||||
procedure TestAssign_UndeclaredVar_RaisesError;
|
||||
|
||||
{ Procedure calls }
|
||||
procedure TestProcCall_WriteLn_NoArgs_OK;
|
||||
procedure TestProcCall_WriteLn_StringArg_OK;
|
||||
procedure TestProcCall_WriteLn_IntArg_OK;
|
||||
procedure TestProcCall_UndeclaredProc_RaisesError;
|
||||
|
||||
{ Full program analysis }
|
||||
procedure TestProgram_HelloWorld_OK;
|
||||
procedure TestProgram_ArithmeticAndPrint_OK;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TSemanticTests.Analyse(const ASrc: string): TProgram;
|
||||
var
|
||||
L: TLexer;
|
||||
P: TParser;
|
||||
A: TSemanticAnalyser;
|
||||
begin
|
||||
L := TLexer.Create(ASrc);
|
||||
P := TParser.Create(L);
|
||||
try
|
||||
Result := P.Parse;
|
||||
finally
|
||||
P.Free;
|
||||
L.Free;
|
||||
end;
|
||||
A := TSemanticAnalyser.Create;
|
||||
try
|
||||
A.Analyse(Result);
|
||||
finally
|
||||
A.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.AnalyseExpectError(const ASrc: string);
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
try
|
||||
Prog := Analyse(ASrc);
|
||||
Prog.Free;
|
||||
Fail('Expected ESemanticError');
|
||||
except
|
||||
on E: ESemanticError do ; { expected }
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Var declarations }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TSemanticTests.TestVarDecl_RegistersSymbol;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Decl: TVarDecl;
|
||||
begin
|
||||
Prog := Analyse('program P; var x: Integer; begin end.');
|
||||
try
|
||||
AssertEquals('1 decl', 1, Prog.Block.Decls.Count);
|
||||
Decl := TVarDecl(Prog.Block.Decls[0]);
|
||||
AssertNotNull('ResolvedType set', Decl.ResolvedType);
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestVarDecl_Type_Integer;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := Analyse('program P; var n: Integer; begin end.');
|
||||
try
|
||||
AssertEquals('Integer kind',
|
||||
Ord(tyInteger),
|
||||
Ord(TVarDecl(Prog.Block.Decls[0]).ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestVarDecl_Type_String;
|
||||
var
|
||||
Prog: TProgram;
|
||||
begin
|
||||
Prog := Analyse('program P; var s: string; begin end.');
|
||||
try
|
||||
AssertEquals('string kind',
|
||||
Ord(tyString),
|
||||
Ord(TVarDecl(Prog.Block.Decls[0]).ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestVarDecl_MultiName_BothRegistered;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Decl: TVarDecl;
|
||||
begin
|
||||
Prog := Analyse('program P; var x, y: Integer; begin end.');
|
||||
try
|
||||
Decl := TVarDecl(Prog.Block.Decls[0]);
|
||||
AssertNotNull('ResolvedType', Decl.ResolvedType);
|
||||
AssertEquals('Integer', Ord(tyInteger), Ord(Decl.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestVarDecl_UnknownType_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError('program P; var x: Foobar; begin end.');
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestVarDecl_Duplicate_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError(
|
||||
'program P; var x: Integer; x: string; begin end.');
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Expression type inference }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TSemanticTests.TestExpr_IntLiteral_TypeIsInteger;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Assign: TAssignment;
|
||||
begin
|
||||
Prog := Analyse('program P; var n: Integer; begin n := 42 end.');
|
||||
try
|
||||
Assign := TAssignment(Prog.Block.Stmts[0]);
|
||||
AssertNotNull('Expr type', Assign.Expr.ResolvedType);
|
||||
AssertEquals('Integer',
|
||||
Ord(tyInteger), Ord(Assign.Expr.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_StringLiteral_TypeIsString;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Assign: TAssignment;
|
||||
begin
|
||||
Prog := Analyse(
|
||||
'program P; var s: string; begin s := ''hello'' end.');
|
||||
try
|
||||
Assign := TAssignment(Prog.Block.Stmts[0]);
|
||||
AssertEquals('string',
|
||||
Ord(tyString), Ord(Assign.Expr.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_Ident_ResolvesToVarType;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := Analyse(
|
||||
'program P; var x, y: Integer; begin y := x + 1 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertNotNull('Left type', Bin.Left.ResolvedType);
|
||||
AssertEquals('x is Integer',
|
||||
Ord(tyInteger), Ord(Bin.Left.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_Ident_Undeclared_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError(
|
||||
'program P; var n: Integer; begin n := undeclared end.');
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_Add_TwoIntegers_TypeIsInteger;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := Analyse(
|
||||
'program P; var n: Integer; begin n := 1 + 2 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Add result is Integer',
|
||||
Ord(tyInteger), Ord(Bin.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_Add_IntAndString_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError(
|
||||
'program P; var n: Integer; s: string; begin n := n + s end.');
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_Sub_TypeIsInteger;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := Analyse(
|
||||
'program P; var n: Integer; begin n := 10 - 3 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Sub is Integer',
|
||||
Ord(tyInteger), Ord(Bin.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_Mul_TypeIsInteger;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := Analyse(
|
||||
'program P; var n: Integer; begin n := 3 * 4 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Mul is Integer',
|
||||
Ord(tyInteger), Ord(Bin.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestExpr_Div_TypeIsInteger;
|
||||
var
|
||||
Prog: TProgram;
|
||||
Bin: TBinaryExpr;
|
||||
begin
|
||||
Prog := Analyse(
|
||||
'program P; var n: Integer; begin n := 8 div 2 end.');
|
||||
try
|
||||
Bin := TBinaryExpr(TAssignment(Prog.Block.Stmts[0]).Expr);
|
||||
AssertEquals('Div is Integer',
|
||||
Ord(tyInteger), Ord(Bin.ResolvedType.Kind));
|
||||
finally
|
||||
Prog.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Assignment type checking }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TSemanticTests.TestAssign_IntToInt_OK;
|
||||
begin
|
||||
Analyse('program P; var n: Integer; begin n := 5 end.').Free;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestAssign_StringToString_OK;
|
||||
begin
|
||||
Analyse(
|
||||
'program P; var s: string; begin s := ''hi'' end.').Free;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestAssign_IntToString_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError(
|
||||
'program P; var s: string; begin s := 42 end.');
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestAssign_StringToInt_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError(
|
||||
'program P; var n: Integer; begin n := ''hello'' end.');
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestAssign_UndeclaredVar_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError(
|
||||
'program P; begin ghost := 1 end.');
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Procedure calls }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TSemanticTests.TestProcCall_WriteLn_NoArgs_OK;
|
||||
begin
|
||||
Analyse('program P; begin WriteLn end.').Free;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestProcCall_WriteLn_StringArg_OK;
|
||||
begin
|
||||
Analyse('program P; begin WriteLn(''Hello'') end.').Free;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestProcCall_WriteLn_IntArg_OK;
|
||||
begin
|
||||
Analyse('program P; begin WriteLn(99) end.').Free;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestProcCall_UndeclaredProc_RaisesError;
|
||||
begin
|
||||
AnalyseExpectError('program P; begin NoSuchProc end.');
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Full programs }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TSemanticTests.TestProgram_HelloWorld_OK;
|
||||
begin
|
||||
Analyse(
|
||||
'program Hello;' + LineEnding +
|
||||
'begin' + LineEnding +
|
||||
' WriteLn(''Hello!'');' + LineEnding +
|
||||
'end.'
|
||||
).Free;
|
||||
end;
|
||||
|
||||
procedure TSemanticTests.TestProgram_ArithmeticAndPrint_OK;
|
||||
begin
|
||||
Analyse(
|
||||
'program Arith;' + LineEnding +
|
||||
'var n: Integer;' + LineEnding +
|
||||
'begin' + LineEnding +
|
||||
' n := 3 * 4 + 2;' + LineEnding +
|
||||
' WriteLn(n);' + LineEnding +
|
||||
'end.'
|
||||
).Free;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TSemanticTests);
|
||||
|
||||
end.
|
||||
Loading…
Reference in a new issue