Browse Source

fcl-passrc: test write(a:3,b3:)

git-svn-id: trunk@38277 -
Mattias Gaertner 7 years ago
parent
commit
f7f6712344
2 changed files with 72 additions and 43 deletions
  1. 14 14
      packages/fcl-passrc/src/pparser.pp
  2. 58 29
      packages/fcl-passrc/tests/tcstatements.pas

+ 14 - 14
packages/fcl-passrc/src/pparser.pp

@@ -329,7 +329,7 @@ type
     Function TokenIsProcedureModifier(Parent : TPasElement; const S : String; Out PM : TProcedureModifier) : Boolean; virtual;
     Function TokenIsProcedureModifier(Parent : TPasElement; const S : String; Out PM : TProcedureModifier) : Boolean; virtual;
     Function TokenIsProcedureTypeModifier(Parent : TPasElement; const S : String; Out PTM : TProcTypeModifier) : Boolean; virtual;
     Function TokenIsProcedureTypeModifier(Parent : TPasElement; const S : String; Out PTM : TProcTypeModifier) : Boolean; virtual;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
     Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
-    function ParseParams(AParent : TPasElement;paramskind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
+    function ParseParams(AParent : TPasElement; ParamsKind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
     function ParseExpIdent(AParent : TPasElement): TPasExpr;
     function ParseExpIdent(AParent : TPasElement): TPasExpr;
     procedure DoParseClassType(AType: TPasClassType);
     procedure DoParseClassType(AType: TPasClassType);
     function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
     function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
@@ -1871,16 +1871,16 @@ begin
     end;
     end;
 end;
 end;
 
 
-function TPasParser.ParseParams(AParent: TPasElement; paramskind: TPasExprKind;
+function TPasParser.ParseParams(AParent: TPasElement; ParamsKind: TPasExprKind;
   AllowFormatting: Boolean = False): TParamsExpr;
   AllowFormatting: Boolean = False): TParamsExpr;
 var
 var
-  params  : TParamsExpr;
-  p       : TPasExpr;
+  Params  : TParamsExpr;
+  Expr    : TPasExpr;
   PClose  : TToken;
   PClose  : TToken;
 
 
 begin
 begin
   Result:=nil;
   Result:=nil;
-  if paramskind in [pekArrayParams, pekSet] then
+  if ParamsKind in [pekArrayParams, pekSet] then
     begin
     begin
     if CurToken<>tkSquaredBraceOpen then
     if CurToken<>tkSquaredBraceOpen then
       ParseExc(nParserExpectTokenError,SParserExpectTokenError,['[']);
       ParseExc(nParserExpectTokenError,SParserExpectTokenError,['[']);
@@ -1893,28 +1893,28 @@ begin
     PClose:=tkBraceClose;
     PClose:=tkBraceClose;
     end;
     end;
 
 
-  params:=TParamsExpr(CreateElement(TParamsExpr,'',AParent,CurTokenPos));
+  Params:=TParamsExpr(CreateElement(TParamsExpr,'',AParent,CurTokenPos));
   try
   try
-    params.Kind:=paramskind;
+    Params.Kind:=ParamsKind;
     NextToken;
     NextToken;
     if not isEndOfExp(false,false) then
     if not isEndOfExp(false,false) then
       begin
       begin
       repeat
       repeat
-        p:=DoParseExpression(params);
-        if not Assigned(p) then
+        Expr:=DoParseExpression(Params);
+        if not Assigned(Expr) then
           ParseExcSyntaxError;
           ParseExcSyntaxError;
-        params.AddParam(p);
+        Params.AddParam(Expr);
         if (CurToken=tkColon) then
         if (CurToken=tkColon) then
           if Not AllowFormatting then
           if Not AllowFormatting then
             ParseExc(nParserExpectTokenError,SParserExpectTokenError,[','])
             ParseExc(nParserExpectTokenError,SParserExpectTokenError,[','])
           else
           else
             begin
             begin
             NextToken;
             NextToken;
-            p.format1:=DoParseExpression(p);
+            Expr.format1:=DoParseExpression(Expr);
             if (CurToken=tkColon) then
             if (CurToken=tkColon) then
               begin
               begin
               NextToken;
               NextToken;
-              p.format2:=DoParseExpression(p);
+              Expr.format2:=DoParseExpression(Expr);
               end;
               end;
             end;
             end;
         if not (CurToken in [tkComma, PClose]) then
         if not (CurToken in [tkComma, PClose]) then
@@ -1932,9 +1932,9 @@ begin
       until CurToken=PClose;
       until CurToken=PClose;
       end;
       end;
     NextToken;
     NextToken;
-    Result:=params;
+    Result:=Params;
   finally
   finally
-    if not Assigned(Result) then params.Release;
+    if not Assigned(Result) then Params.Release;
   end;
   end;
 end;
 end;
 
 

+ 58 - 29
packages/fcl-passrc/tests/tcstatements.pas

@@ -20,7 +20,7 @@ Type
     FStatement: TPasImplBlock;
     FStatement: TPasImplBlock;
     FVariables : TStrings;
     FVariables : TStrings;
     procedure DoTestCallOtherFormat;
     procedure DoTestCallOtherFormat;
-    procedure TestCallFormat(FN: String; Two: Boolean);
+    procedure TestCallFormat(FN: String; AddPrecision: Boolean; AddSecondParam: boolean = false);
   Protected
   Protected
     Procedure SetUp; override;
     Procedure SetUp; override;
     Procedure TearDown; override;
     Procedure TearDown; override;
@@ -53,6 +53,8 @@ Type
     Procedure TestCallOneArg;
     Procedure TestCallOneArg;
     procedure TestCallWriteFormat1;
     procedure TestCallWriteFormat1;
     procedure TestCallWriteFormat2;
     procedure TestCallWriteFormat2;
+    procedure TestCallWriteFormat3;
+    procedure TestCallWriteFormat4;
     procedure TestCallWritelnFormat1;
     procedure TestCallWritelnFormat1;
     procedure TestCallWritelnFormat2;
     procedure TestCallWritelnFormat2;
     procedure TestCallStrFormat1;
     procedure TestCallStrFormat1;
@@ -117,12 +119,12 @@ Type
     Procedure TestAsmBlockWithEndLabel;
     Procedure TestAsmBlockWithEndLabel;
     Procedure TestAsmBlockInIfThen;
     Procedure TestAsmBlockInIfThen;
     Procedure TestGotoInIfThen;
     Procedure TestGotoInIfThen;
-    procedure AssignToAddress;
-    procedure FinalizationNoSemicolon;
-    procedure MacroComment;
-    Procedure PlatformIdentifier;
-    Procedure PlatformIdentifier2;
-    Procedure OnIdentifier;
+    procedure TestAssignToAddress;
+    procedure TestFinalizationNoSemicolon;
+    procedure TestMacroComment;
+    Procedure TestPlatformIdentifier;
+    Procedure TestPlatformIdentifier2;
+    Procedure TestArgumentNameOn;
   end;
   end;
 
 
 
 
@@ -461,16 +463,35 @@ begin
   AssertExpression('Parameter is constant',P.Params[0],pekNumber,'1');
   AssertExpression('Parameter is constant',P.Params[0],pekNumber,'1');
 end;
 end;
 
 
-procedure TTestStatementParser.TestCallFormat(FN : String; Two : Boolean);
+procedure TTestStatementParser.TestCallFormat(FN: String;
+  AddPrecision: Boolean; AddSecondParam: boolean);
+var
+  P : TParamsExpr;
+
+  procedure CheckParam(Index: integer; const aParamName: string);
+  begin
+    AssertExpression('Parameter['+IntToStr(Index)+'] is identifier',P.Params[Index],pekIdent,aParamName);
+    AssertExpression('Parameter['+IntToStr(Index)+'] has formatting constant 1' ,P.Params[Index].format1,pekNumber,'3');
+    if AddPrecision then
+      AssertExpression('Parameter['+IntToStr(Index)+'] has formatting constant 2',P.Params[Index].format2,pekNumber,'2');
+  end;
 
 
 Var
 Var
   S : TPasImplSimple;
   S : TPasImplSimple;
-  P : TParamsExpr;
   N : String;
   N : String;
+  ArgCnt: Integer;
 begin
 begin
   N:=fn+'(a:3';
   N:=fn+'(a:3';
-  if Two then
+  if AddPrecision then
     N:=N+':2';
     N:=N+':2';
+  ArgCnt:=1;
+  if AddSecondParam then
+    begin
+    ArgCnt:=2;
+    N:=N+',b:3';
+    if AddPrecision then
+      N:=N+':2';
+    end;
   N:=N+');';
   N:=N+');';
   TestStatement(N);
   TestStatement(N);
   AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
   AssertEquals('1 statement',1,PasProgram.InitializationSection.Elements.Count);
@@ -479,50 +500,58 @@ begin
   AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
   AssertExpression('Doit call',S.Expr,pekFuncParams,TParamsExpr);
   P:=S.Expr as TParamsExpr;
   P:=S.Expr as TParamsExpr;
   AssertExpression('Correct function call name',P.Value,pekIdent,FN);
   AssertExpression('Correct function call name',P.Value,pekIdent,FN);
-  AssertEquals('One param',1,Length(P.Params));
-  AssertExpression('Parameter is identifier',P.Params[0],pekIdent,'a');
-  AssertExpression('Parameter has formatting constant 1' ,P.Params[0].format1,pekNumber,'3');
-  if Two then
-    AssertExpression('Parameter has formatting constant 2',P.Params[0].format2,pekNumber,'2');
+  AssertEquals(IntToStr(ArgCnt)+' param',ArgCnt,Length(P.Params));
+  CheckParam(0,'a');
+  if AddSecondParam then
+    CheckParam(1,'b');
 end;
 end;
 
 
 procedure TTestStatementParser.TestCallWriteFormat1;
 procedure TTestStatementParser.TestCallWriteFormat1;
 
 
 begin
 begin
-  TestCalLFormat('write',False);
+  TestCallFormat('write',False);
 end;
 end;
 
 
 procedure TTestStatementParser.TestCallWriteFormat2;
 procedure TTestStatementParser.TestCallWriteFormat2;
 
 
 begin
 begin
-  TestCalLFormat('write',True);
+  TestCallFormat('write',True);
 end;
 end;
 
 
-procedure TTestStatementParser.TestCallWritelnFormat1;
+procedure TTestStatementParser.TestCallWriteFormat3;
 begin
 begin
-  TestCalLFormat('writeln',False);
+  TestCallFormat('write',false,true);
+end;
 
 
+procedure TTestStatementParser.TestCallWriteFormat4;
+begin
+  TestCallFormat('write',true,true);
+end;
+
+procedure TTestStatementParser.TestCallWritelnFormat1;
+begin
+  TestCallFormat('writeln',False);
 end;
 end;
 
 
 procedure TTestStatementParser.TestCallWritelnFormat2;
 procedure TTestStatementParser.TestCallWritelnFormat2;
 begin
 begin
-  TestCalLFormat('writeln',True);
+  TestCallFormat('writeln',True);
 end;
 end;
 
 
 procedure TTestStatementParser.TestCallStrFormat1;
 procedure TTestStatementParser.TestCallStrFormat1;
 begin
 begin
-  TestCalLFormat('str',False);
+  TestCallFormat('str',False);
 end;
 end;
 
 
 procedure TTestStatementParser.TestCallStrFormat2;
 procedure TTestStatementParser.TestCallStrFormat2;
 begin
 begin
-  TestCalLFormat('str',True);
+  TestCallFormat('str',True);
 end;
 end;
 
 
 procedure TTestStatementParser.DoTestCallOtherFormat;
 procedure TTestStatementParser.DoTestCallOtherFormat;
 
 
 begin
 begin
-  TestCalLFormat('nono',False);
+  TestCallFormat('nono',False);
 end;
 end;
 
 
 procedure TTestStatementParser.TestCallOtherFormat;
 procedure TTestStatementParser.TestCallOtherFormat;
@@ -1709,14 +1738,14 @@ begin
   ParseModule;
   ParseModule;
 end;
 end;
 
 
-procedure TTestStatementParser.AssignToAddress;
+procedure TTestStatementParser.TestAssignToAddress;
 
 
 begin
 begin
   AddStatements(['@Proc:=Nil']);
   AddStatements(['@Proc:=Nil']);
   ParseModule;
   ParseModule;
 end;
 end;
 
 
-procedure TTestStatementParser.FinalizationNoSemicolon;
+procedure TTestStatementParser.TestFinalizationNoSemicolon;
 begin
 begin
   Source.Add('unit afile;');
   Source.Add('unit afile;');
   Source.Add('{$mode objfpc}');
   Source.Add('{$mode objfpc}');
@@ -1729,7 +1758,7 @@ begin
   ParseModule;
   ParseModule;
 end;
 end;
 
 
-procedure TTestStatementParser.MacroComment;
+procedure TTestStatementParser.TestMacroComment;
 begin
 begin
   AddStatements(['{$MACRO ON}',
   AddStatements(['{$MACRO ON}',
   '{$DEFINE func := //}',
   '{$DEFINE func := //}',
@@ -1740,19 +1769,19 @@ begin
   ParseModule;
   ParseModule;
 end;
 end;
 
 
-procedure TTestStatementParser.PlatformIdentifier;
+procedure TTestStatementParser.TestPlatformIdentifier;
 begin
 begin
   AddStatements(['write(platform);']);
   AddStatements(['write(platform);']);
   ParseModule;
   ParseModule;
 end;
 end;
 
 
-procedure TTestStatementParser.PlatformIdentifier2;
+procedure TTestStatementParser.TestPlatformIdentifier2;
 begin
 begin
   AddStatements(['write(libs+platform);']);
   AddStatements(['write(libs+platform);']);
   ParseModule;
   ParseModule;
 end;
 end;
 
 
-procedure TTestStatementParser.OnIdentifier;
+procedure TTestStatementParser.TestArgumentNameOn;
 begin
 begin
   Source.Add('function TryOn(const on: boolean): boolean;');
   Source.Add('function TryOn(const on: boolean): boolean;');
   Source.Add('  begin');
   Source.Add('  begin');