Browse Source

* More error recovery: variable (lists)

Michaël Van Canneyt 2 years ago
parent
commit
4bdf6233c3

+ 23 - 5
packages/fcl-passrc/src/pparser.pp

@@ -1516,8 +1516,8 @@ begin
       begin
       Include(StopAt,tkEOF);
       Repeat
-        tk:=Scanner.FetchToken;
-      Until tk in StopAt;
+        NextToken;
+      Until CurToken in StopAt;
       end;
     if aContext.UngetRestartToken then
       UngetToken;
@@ -3873,7 +3873,13 @@ begin
                   Declarations.Variables.Add(TPasVariable(CurEl));
                 Engine.FinishScope(stDeclaration,CurEl);
               end;
-              CheckToken(tkSemicolon);
+              try
+                CheckToken(tkSemicolon);
+              except
+                on E : Exception do
+                  if not TryErrorRecovery(CreateRecovery(E,[tkSemicolon],False)) then
+                    Raise;
+              end;
             finally
               List.Free;
             end;
@@ -4978,10 +4984,16 @@ procedure TPasParser.ParseInlineVarDecl(Parent: TPasElement; List: TFPList;
 Var
   tt : TTokens;
 begin
-  ParseVarList(Parent,List,AVisibility,False);
   tt:=[tkEnd,tkSemicolon];
   if ClosingBrace then
     Include(tt,tkBraceClose);
+  try
+    ParseVarList(Parent,List,AVisibility,False);
+  except
+    on E : Exception do
+      if not TryErrorRecovery(CreateRecovery(E,tt,False)) then
+        Raise;
+  end;
   if not (CurToken in tt) then
     ParseExc(nParserExpectedSemiColonEnd,SParserExpectedSemiColonEnd);
 end;
@@ -4990,7 +5002,13 @@ end;
 procedure TPasParser.ParseVarDecl(Parent: TPasElement; List: TFPList);
 
 begin
-  ParseVarList(Parent,List,visDefault,True);
+  try
+    ParseVarList(Parent,List,visDefault,True);
+  except
+    on E : Exception do
+      if not TryErrorRecovery(CreateRecovery(E,[tkSemicolon],False)) then
+        Raise;
+  end;
 end;
 
 // Starts after the opening bracket token

+ 23 - 1
packages/fcl-passrc/tests/tcvarparser.pas

@@ -5,7 +5,7 @@ unit tcvarparser;
 interface
 
 uses
-  Classes, SysUtils, fpcunit, pastree, pscanner,
+  Classes, SysUtils, fpcunit, pastree, pscanner, pparser,
   tcbaseparser, testregistry;
 
 Type
@@ -64,6 +64,7 @@ Type
     Procedure TestVarPublicName;
     Procedure TestVarDeprecatedExternalName;
     Procedure TestVarHintPriorToInit;
+    Procedure TestErrorRecovery;
   end;
 
 implementation
@@ -451,6 +452,27 @@ begin
   AssertEquals('Correct initialization value',False, E.Value);
 end;
 
+procedure TTestVarParser.TestErrorRecovery;
+
+begin
+  Add('Var');
+  Add('  a : integer;');
+  Add('  a = integer;');
+  Add('  a : abc integer;');
+//  Writeln(source.text);
+  try
+    Parser.MaxErrorCount:=3;
+    Parser.OnLog:=@DoParserLog;
+    ParseDeclarations;
+  except
+    On E : Exception do
+      begin
+      AssertEquals('Correct class',E.ClassType,EParserError);
+      end;
+  end;
+  AssertErrorCount(2);
+end;
+
 initialization
 
   RegisterTests([TTestVarParser]);

+ 7 - 2
packages/fcl-passrc/tests/testpassrc.lpi

@@ -24,13 +24,13 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <CommandLineParams Value="--suite=TTestTypeParser.TestAbstractObject"/>
+        <CommandLineParams Value="--suite=TTestVarParser.TestErrorRecovery"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <CommandLineParams Value="--suite=TTestTypeParser.TestAbstractObject"/>
+            <CommandLineParams Value="--suite=TTestVarParser.TestErrorRecovery"/>
           </local>
         </Mode0>
       </Modes>
@@ -126,6 +126,11 @@
       </Checks>
       <VerifyObjMethodCallValidity Value="True"/>
     </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf3"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">