Browse Source

fcl-passrc: parser: bark on garbage behind proc modifier

git-svn-id: trunk@42736 -
Mattias Gaertner 6 years ago
parent
commit
722e33ce65
2 changed files with 25 additions and 22 deletions
  1. 14 22
      packages/fcl-passrc/src/pparser.pp
  2. 11 0
      packages/fcl-passrc/tests/tcresolver.pas

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

@@ -4927,9 +4927,8 @@ begin
 end;
 end;
 
 
 procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
 procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
-
+// at end on last token of modifier, usually the semicolon
 Var
 Var
-  Tok : String;
   P : TPasProcedure;
   P : TPasProcedure;
   E : TPasExpr;
   E : TPasExpr;
 
 
@@ -4953,28 +4952,23 @@ begin
       // external libname
       // external libname
       // external libname name XYZ
       // external libname name XYZ
       // external name XYZ
       // external name XYZ
-      Tok:=UpperCase(CurTokenString);
-      if Not ((CurToken=tkIdentifier) and (Tok='NAME')) then
+      if Not CurTokenIsIdentifier('NAME') then
         begin
         begin
         E:=DoParseExpression(Parent);
         E:=DoParseExpression(Parent);
         if Assigned(P) then
         if Assigned(P) then
           P.LibraryExpr:=E;
           P.LibraryExpr:=E;
         end;
         end;
-      if CurToken=tkSemicolon then
-        UnGetToken
-      else
+      if CurTokenIsIdentifier('NAME') then
         begin
         begin
-        Tok:=UpperCase(CurTokenString);
-        if ((CurToken=tkIdentifier) and (Tok='NAME')) then
-          begin
-          NextToken;
-          if not (CurToken in [tkChar,tkString,tkIdentifier]) then
-            ParseExcTokenError(TokenInfos[tkString]);
-          E:=DoParseExpression(Parent);
-          if Assigned(P) then
-            P.LibrarySymbolName:=E;
-          end;
+        NextToken;
+        if not (CurToken in [tkChar,tkString,tkIdentifier]) then
+          ParseExcTokenError(TokenInfos[tkString]);
+        E:=DoParseExpression(Parent);
+        if Assigned(P) then
+          P.LibrarySymbolName:=E;
         end;
         end;
+      if CurToken<>tkSemicolon then
+        UngetToken;
       end
       end
     else
     else
       UngetToken;
       UngetToken;
@@ -5004,8 +4998,7 @@ begin
       E:=DoParseExpression(Parent);
       E:=DoParseExpression(Parent);
       if Parent is TPasProcedure then
       if Parent is TPasProcedure then
         TPasProcedure(Parent).PublicName:=E;
         TPasProcedure(Parent).PublicName:=E;
-      if (CurToken <> tkSemicolon) then
-        ParseExcTokenError(TokenInfos[tkSemicolon]);
+      CheckToken(tkSemicolon);
       end;
       end;
     end;
     end;
   pmForward:
   pmForward:
@@ -5029,14 +5022,14 @@ begin
       pekString: TPasProcedure(Parent).Messagetype:=pmtString;
       pekString: TPasProcedure(Parent).Messagetype:=pmtString;
       end;
       end;
       end;
       end;
-    if CurToken = tkSemicolon then
+    if CurToken<>tkSemicolon then
       UngetToken;
       UngetToken;
     end;
     end;
   pmDispID:
   pmDispID:
     begin
     begin
     NextToken;
     NextToken;
     TPasProcedure(Parent).DispIDExpr:=DoParseExpression(Parent);
     TPasProcedure(Parent).DispIDExpr:=DoParseExpression(Parent);
-    if CurToken = tkSemicolon then
+    if CurToken<>tkSemicolon then
       UngetToken;
       UngetToken;
     end;
     end;
   end; // Case
   end; // Case
@@ -6472,7 +6465,6 @@ begin
     PC:=GetProcedureClass(ProcType);
     PC:=GetProcedureClass(ProcType);
     if Name<>'' then
     if Name<>'' then
       Parent:=CheckIfOverLoaded(Parent,Name);
       Parent:=CheckIfOverLoaded(Parent,Name);
-    //TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
     Result := TPasProcedure(Engine.CreateElement(PC, Name, Parent, AVisibility,
     Result := TPasProcedure(Engine.CreateElement(PC, Name, Parent, AVisibility,
                                                  CurSourcePos, NameParts));
                                                  CurSourcePos, NameParts));
     if NameParts<>nil then
     if NameParts<>nil then

+ 11 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -453,6 +453,7 @@ type
     Procedure TestProc_ImplicitCalls;
     Procedure TestProc_ImplicitCalls;
     Procedure TestProc_Absolute;
     Procedure TestProc_Absolute;
     Procedure TestProc_LocalInit;
     Procedure TestProc_LocalInit;
+    Procedure TestProc_ExtNamePropertyFail;
 
 
     // anonymous procs
     // anonymous procs
     Procedure TestAnonymousProc_Assign;
     Procedure TestAnonymousProc_Assign;
@@ -7503,6 +7504,16 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestProc_ExtNamePropertyFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Foo; external name ''});'' property;',
+  'begin']);
+  CheckParserException('Expected ";" at token "property" in file afile.pp at line 2 column 36',
+    nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestAnonymousProc_Assign;
 procedure TTestResolver.TestAnonymousProc_Assign;
 begin
 begin
   StartProgram(false);
   StartProgram(false);