Explorar o código

* Fix bug ID #31671

git-svn-id: trunk@35884 -
michael %!s(int64=8) %!d(string=hai) anos
pai
achega
1f3e7442c1

+ 38 - 2
packages/fcl-passrc/src/pparser.pp

@@ -327,7 +327,9 @@ type
     procedure NextToken; // read next non whitespace, non space
     procedure UngetToken;
     procedure CheckToken(tk: TToken);
+    procedure CheckTokens(tk: TTokens);
     procedure ExpectToken(tk: TToken);
+    procedure ExpectTokens(tk:  TTokens);
     function ExpectIdentifier: String;
     Function CurTokenIsIdentifier(Const S : String) : Boolean;
     // Expression parsing
@@ -895,6 +897,30 @@ begin
     end;
 end;
 
+procedure TPasParser.CheckTokens(tk: TTokens);
+
+Var
+  S : String;
+  T : TToken;
+begin
+  if not (CurToken in tk) then
+    begin
+    {$IFDEF VerbosePasParser}
+    writeln('TPasParser.ParseExcTokenError String="',CurTokenString,'" Text="',CurTokenText,'" CurToken=',CurToken,' tk=',tk);
+    {$ENDIF}
+    S:='';
+    For T in TToken do
+      if t in tk then
+        begin
+        if (S<>'') then
+          S:=S+' or ';
+        S:=S+TokenInfos[t];
+        end;
+    ParseExcTokenError(S);
+    end;
+
+end;
+
 
 procedure TPasParser.ExpectToken(tk: TToken);
 begin
@@ -902,6 +928,12 @@ begin
   CheckToken(tk);
 end;
 
+procedure TPasParser.ExpectTokens(tk: TTokens);
+begin
+  NextToken;
+  CheckTokens(tk);
+end;
+
 function TPasParser.ExpectIdentifier: String;
 begin
   ExpectToken(tkIdentifier);
@@ -3743,9 +3775,10 @@ begin
   ModCount:=0;
   Repeat
     inc(ModCount);
+    // Writeln(modcount, curtokentext);
     LastToken:=CurToken;
     NextToken;
-    if (ModCount=1) and (CurToken = tkEqual) then
+    if (ModCount in [1,2,3]) and (CurToken = tkEqual) then
       begin
       // for example: const p: procedure = nil;
       UngetToken;
@@ -3773,7 +3806,9 @@ begin
           NextToken; // remove offset
           end;
       end;
-      ExpectToken(tkSemicolon);
+      ExpectTokens([tkSemicolon,tkEqual]);
+      if curtoken=tkEqual then
+        ungettoken;
       end
     else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
       HandleProcedureModifier(Parent,PM)
@@ -3823,6 +3858,7 @@ begin
 //      DumpCurToken('Done '+IntToStr(Ord(Done)));
       UngetToken;
       end;
+
 //    Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
   Until Done;
   if DoCheckHint then  // deprecated,platform,experimental,library, unimplemented etc

+ 7 - 0
packages/fcl-passrc/tests/tcvarparser.pas

@@ -34,6 +34,7 @@ Type
     procedure TestSimpleVarInitializedDeprecated;
     procedure TestSimpleVarInitializedPlatform;
     Procedure TestVarProcedure;
+    Procedure TestVarFunctionINitialized;
     Procedure TestVarProcedureDeprecated;
     Procedure TestVarRecord;
     Procedure TestVarRecordDeprecated;
@@ -187,6 +188,12 @@ begin
   AssertVariableType(TPasProcedureType);
 end;
 
+procedure TTestVarParser.TestVarFunctionINitialized;
+begin
+  ParseVar('function (device: pointer): pointer; cdecl = nil','');
+  AssertVariableType(TPasFunctionType);
+end;
+
 procedure TTestVarParser.TestVarProcedureDeprecated;
 begin
   ParseVar('procedure','deprecated');