unit tcstatements; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpcunit, pastree, pscanner, pparser, tcbaseparser, testregistry; Type { TTestStatementParser } TTestStatementParser = Class(TTestParser) private FStatement: TPasImplBlock; FVariables : TStrings; Protected Procedure SetUp; override; Procedure TearDown; override; procedure AddStatements(ASource : Array of string); Procedure DeclareVar(Const AVarType : String; Const AVarName : String = 'A'); function TestStatement(ASource : string) : TPasImplElement; function TestStatement(ASource : Array of string) : TPasImplElement; Procedure ExpectParserError(Const Msg : string); Procedure ExpectParserError(Const Msg : string; ASource : Array of string); Function AssertStatement(Msg : String; AClass : TClass;AIndex : Integer = 0) : TPasImplBlock; Property Statement: TPasImplBlock Read FStatement; Published Procedure TestEmpty; Procedure TestEmptyStatement; Procedure TestEmptyStatements; Procedure TestBlock; Procedure TestAssignment; Procedure TestAssignmentAdd; Procedure TestAssignmentMinus; Procedure TestAssignmentMul; Procedure TestAssignmentDivision; Procedure TestCall; Procedure TestCallQualified; Procedure TestCallQualified2; Procedure TestCallNoArgs; Procedure TestCallOneArg; Procedure TestIf; Procedure TestIfBlock; Procedure TestIfAssignment; Procedure TestIfElse; Procedure TestIfElseBlock; Procedure TestIfSemiColonElseError; Procedure TestNestedIf; Procedure TestNestedIfElse; Procedure TestWhile; Procedure TestWhileBlock; Procedure TestWhileNested; Procedure TestRepeat; Procedure TestRepeatBlock; procedure TestRepeatBlockNosemicolon; Procedure TestRepeatNested; Procedure TestFor; Procedure TestForIn; Procedure TestForExpr; Procedure TestForBlock; procedure TestDowntoBlock; Procedure TestForNested; Procedure TestWith; Procedure TestWithMultiple; Procedure TestCaseEmpty; Procedure TestCaseOneInteger; Procedure TestCaseTwoIntegers; Procedure TestCaseRange; Procedure TestCaseRangeSeparate; Procedure TestCase2Cases; Procedure TestCaseBlock; Procedure TestCaseElseBlockEmpty; Procedure TestCaseElseBlockAssignment; Procedure TestCaseElseBlock2Assignments; Procedure TestCaseIfCaseElse; Procedure TestCaseIfElse; Procedure TestRaise; Procedure TestRaiseEmpty; Procedure TestRaiseAt; Procedure TestTryFinally; Procedure TestTryFinallyEmpty; Procedure TestTryFinallyNested; procedure TestTryExcept; procedure TestTryExceptNested; procedure TestTryExceptEmpty; Procedure TestTryExceptOn; Procedure TestTryExceptOn2; Procedure TestTryExceptOnElse; Procedure TestTryExceptOnIfElse; end; implementation { TTestStatementParser } procedure TTestStatementParser.SetUp; begin inherited SetUp; FVariables:=TStringList.Create; end; procedure TTestStatementParser.TearDown; begin FreeAndNil(FVariables); inherited TearDown; end; procedure TTestStatementParser.AddStatements(ASource: array of string); Var I :Integer; begin StartProgram('afile'); if FVariables.Count>0 then begin Add('Var'); For I:=0 to FVariables.Count-1 do Add(' '+Fvariables[I]); end; Add('begin'); For I:=Low(ASource) to High(ASource) do Add(' '+ASource[i]); end; procedure TTestStatementParser.DeclareVar(const AVarType: String; const AVarName: String); begin FVariables.Add(AVarName+' : '+AVarType+';'); end; function TTestStatementParser.TestStatement(ASource: string): TPasImplElement; begin Result:=TestStatement([ASource]); end; function TTestStatementParser.TestStatement(ASource: array of string): TPasImplElement; begin Result:=Nil; FStatement:=Nil; AddStatements(ASource); ParseModule; AssertEquals('Have program',TPasProgram,Module.ClassType); AssertNotNull('Have program section',PasProgram.ProgramSection); AssertNotNull('Have initialization section',PasProgram.InitializationSection); if (PasProgram.InitializationSection.Elements.Count>0) then if TObject(PasProgram.InitializationSection.Elements[0]) is TPasImplBlock then FStatement:=TPasImplBlock(PasProgram.InitializationSection.Elements[0]); Result:=FStatement; end; procedure TTestStatementParser.ExpectParserError(Const Msg : string); begin AssertException(Msg,EParserError,@ParseModule); end; procedure TTestStatementParser.ExpectParserError(const Msg: string; ASource: array of string); begin AddStatements(ASource); ExpectParserError(Msg); end; function TTestStatementParser.AssertStatement(Msg: String; AClass: TClass; AIndex: Integer): TPasImplBlock; begin if not (AIndex