fcl-passrc: started resolver tests for multi errors

packages/fcl-passrc/src/pparser.pp

@@ -304,9 +304,9 @@ type
         Parent: TPasImplBlock;
         NewImplElement: TPasImplElement;
         CurBlock: TPasImplBlock;
-        { $IFDEF VerbosePasParserWriteln}
+        {$IFDEF VerbosePasParserWriteln}
         function GetPrefix: string;
-        { $ENDIF VerbosePasParserWriteln}
+        {$ENDIF VerbosePasParserWriteln}
         function CloseBlock: boolean; // true if parent reached
         function CloseStatement(CloseIfs: boolean): boolean; // true if parent reached
         procedure CreateBlock(NewBlock: TPasImplBlock);
@@ -889,7 +889,7 @@ begin
     {$endif}
     Scanner := TPascalScanner.Create(FileResolver);
     Scanner.LogEvents:=AEngine.ScannerLogEvents;
-    Scanner.OnLog:=AEngine.Onlog;
+    Scanner.OnLog:=AEngine.OnLog;
     if not (poSkipDefaultDefs in Options) then
       begin
       Scanner.AddDefine('FPK');
@@ -934,7 +934,7 @@ begin
       Parser.ImplicitUses.Clear;
     Filename := '';
     Parser.LogEvents:=AEngine.ParserLogEvents;
-    Parser.OnLog:=AEngine.Onlog;
+    Parser.OnLog:=AEngine.OnLog;
 
     For S in FPCCommandLine do
       ProcessCmdLinePart(S);
@@ -3907,13 +3907,14 @@ begin
                   Declarations.Variables.Add(TPasVariable(CurEl));
                 Engine.FinishScope(stDeclaration,CurEl);
               end;
-              try
-                CheckToken(tkSemicolon);
-              except
-                on E : Exception do
-                  if not TryErrorRecovery(CreateRecovery(E,[tkSemicolon],False)) then
-                    Raise;
-              end;
+              if (CurToken<>tkSemicolon) then
+                try
+                  CheckToken(tkSemicolon);
+                except
+                  on E : Exception do
+                    if not TryErrorRecovery(CreateRecovery(E,[tkSemicolon],False)) then
+                      Raise;
+                end;
             finally
               List.Free;
             end;
@@ -6148,6 +6149,26 @@ var
     ParseExcTokenError('Semicolon');
   end;
 
+  function Recover(E: Exception): boolean;
+  var
+    RestartTokens: TTokens;
+  begin
+    RestartTokens:=[
+       // token that can end a statement
+       tkSemicolon,tkend,tkfinalization,
+       // tokens that can start a statement
+       tkasm,tkbegin,
+       tkrepeat,tkwhile,tkif,tkgoto,tkfor,tkwith,tkcase,tktry,
+       tkraise,
+       tkAt,tkAtAt,
+       tkIdentifier,tkspecialize,
+       tkNumber,tkString,tkfalse,tktrue,tkChar,
+       tkBraceOpen,tkSquaredBraceOpen,
+       tkMinus,tkPlus,tkinherited
+       ];
+    Result:=TryErrorRecovery(CreateRecovery(E,RestartTokens));
+  end;
+
 var
   El : TPasImplElement;
 begin
@@ -6160,146 +6181,152 @@ begin
   while True do
   begin
     PrevToken:=CurToken;
-    NextToken;
-    {$IFDEF VerbosePasParserWriteln}
-    WriteLn(' Token=',CurTokenText,' CurBlock=',CurBlock.ClassName);
-    {$ENDIF VerbosePasParserWriteln}
-    case CurToken of
-    tkasm:
-      begin
-      CheckStatementCanStart;
-      if Params.ParseAsm then
-        break;
-      end;
-    tkbegin:
-      begin
-      CheckStatementCanStart;
-      El:=TPasImplElement(Params.CreateElement(TPasImplBeginBlock));
-      Params.CreateBlock(TPasImplBeginBlock(El));
-      end;
-    tkrepeat:
-      begin
-      CheckStatementCanStart;
-      El:=TPasImplRepeatUntil(Params.CreateElement(TPasImplRepeatUntil));
-      Params.CreateBlock(TPasImplRepeatUntil(El));
-      end;
-    tkIf:
-      begin
-      CheckStatementCanStart;
-      Params.ParseIf;
-      end;
-    tkelse,tkotherwise:
-      // ELSE can close multiple blocks, similar to semicolon
-      if Params.ParseElse then
-        exit; // case-else TPasImplCaseStatement
-    tkwhile:
-      begin
-      // while Condition do
-      CheckStatementCanStart;
-      Params.ParseWhile;
-      end;
-    tkgoto:
-      begin
-      CheckStatementCanStart;
-      Params.ParseGoto;
-      end;
-    tkfor:
-      begin
-      CheckStatementCanStart;
-      Params.ParseFor;
-      end;
-    tkwith:
-      begin
-      CheckStatementCanStart;
-      Params.ParseWith;
-      end;
-    tkcase:
-      begin
-      CheckStatementCanStart;
-      Params.ParseCase;
-      end;
-    tktry:
-      begin
-      CheckStatementCanStart;
-      El:=TPasImplTry(Params.CreateElement(TPasImplTry));
-      Params.CreateBlock(TPasImplTry(El));
-      end;
-    tkfinally:
-      if Params.ParseFinally then
-        break;
-    tkexcept:
-      if Params.ParseExcept then
-        break;
-    tkraise:
-      begin
-      CheckStatementCanStart;
-      Params.ParseRaise;
-      end;
-    tkend:
-      begin
-        // Note: ParseStatement should return with CurToken at last token of the statement
-        if Params.CloseStatement(true) then
+    try
+      NextToken;
+      {$IFDEF VerbosePasParserWriteln}
+      WriteLn(' Token=',CurTokenText,' CurBlock=',CurBlock.ClassName);
+      {$ENDIF VerbosePasParserWriteln}
+      case CurToken of
+      tkasm:
         begin
-          // there was none requiring an END
-          UngetToken;
+        CheckStatementCanStart;
+        if Params.ParseAsm then
           break;
         end;
-        // still a block left
-        if Params.CurBlock is TPasImplBeginBlock then
+      tkbegin:
         begin
-          // close at END
-          if Params.CloseBlock then break; // close end
-          if Params.CloseStatement(false) then break;
-        end else if Params.CurBlock is TPasImplCaseElse then
+        CheckStatementCanStart;
+        El:=TPasImplElement(Params.CreateElement(TPasImplBeginBlock));
+        Params.CreateBlock(TPasImplBeginBlock(El));
+        end;
+      tkrepeat:
         begin
-          if Params.CloseBlock then break; // close else
-          if Params.CloseBlock then break; // close caseof
-          if Params.CloseStatement(false) then break;
-        end else if Params.CurBlock is TPasImplTryHandler then
+        CheckStatementCanStart;
+        El:=TPasImplRepeatUntil(Params.CreateElement(TPasImplRepeatUntil));
+        Params.CreateBlock(TPasImplRepeatUntil(El));
+        end;
+      tkIf:
         begin
-          if Params.CloseBlock then break; // close finally/except
-          if Params.CloseBlock then break; // close try
-          if Params.CloseStatement(false) then break;
-        end else
-          ParseExcSyntaxError;
-      end;
-    tkSemiColon:
-      if Params.CloseStatement(true) then break;
-    tkFinalization:
-      if Params.CloseStatement(true) then
+        CheckStatementCanStart;
+        Params.ParseIf;
+        end;
+      tkelse,tkotherwise:
+        // ELSE can close multiple blocks, similar to semicolon
+        if Params.ParseElse then
+          exit; // case-else TPasImplCaseStatement
+      tkwhile:
         begin
-        UngetToken;
-        break;
+        // while Condition do
+        CheckStatementCanStart;
+        Params.ParseWhile;
         end;
-    tkuntil:
-      if Params.ParseUntil then
-        break;
-    tkEOF:
-      CheckToken(tkend);
-    tkAt,tkAtAt,
-    tkIdentifier,tkspecialize,
-    tkNumber,tkString,tkfalse,tktrue,tkChar,
-    tkBraceOpen,tkSquaredBraceOpen,
-    tkMinus,tkPlus,tkinherited:
-      begin
-      // Do not check this here:
-      //      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
-      //        ParseExc;
-      CheckStatementCanStart;
-
-      //writeln('TPasParser.ParseStatement ',CurToken,' ',CurTokenString);
-
-      // On is usable as an identifier
-      if CompareText(CurTokenText,'on')=0 then
+      tkgoto:
+        begin
+        CheckStatementCanStart;
+        Params.ParseGoto;
+        end;
+      tkfor:
+        begin
+        CheckStatementCanStart;
+        Params.ParseFor;
+        end;
+      tkwith:
+        begin
+        CheckStatementCanStart;
+        Params.ParseWith;
+        end;
+      tkcase:
         begin
-          if Params.ParseOn then
+        CheckStatementCanStart;
+        Params.ParseCase;
+        end;
+      tktry:
+        begin
+        CheckStatementCanStart;
+        El:=TPasImplTry(Params.CreateElement(TPasImplTry));
+        Params.CreateBlock(TPasImplTry(El));
+        end;
+      tkfinally:
+        if Params.ParseFinally then
+          break;
+      tkexcept:
+        if Params.ParseExcept then
+          break;
+      tkraise:
+        begin
+        CheckStatementCanStart;
+        Params.ParseRaise;
+        end;
+      tkend:
+        begin
+          // Note: ParseStatement should return with CurToken at last token of the statement
+          if Params.CloseStatement(true) then
+          begin
+            // there was none requiring an END
+            UngetToken;
             break;
-        end
+          end;
+          // still a block left
+          if Params.CurBlock is TPasImplBeginBlock then
+          begin
+            // close at END
+            if Params.CloseBlock then break; // close end
+            if Params.CloseStatement(false) then break;
+          end else if Params.CurBlock is TPasImplCaseElse then
+          begin
+            if Params.CloseBlock then break; // close else
+            if Params.CloseBlock then break; // close caseof
+            if Params.CloseStatement(false) then break;
+          end else if Params.CurBlock is TPasImplTryHandler then
+          begin
+            if Params.CloseBlock then break; // close finally/except
+            if Params.CloseBlock then break; // close try
+            if Params.CloseStatement(false) then break;
+          end else
+            ParseExcSyntaxError;
+        end;
+      tkSemiColon:
+        if Params.CloseStatement(true) then break;
+      tkFinalization:
+        if Params.CloseStatement(true) then
+          begin
+          UngetToken;
+          break;
+          end;
+      tkuntil:
+        if Params.ParseUntil then
+          break;
+      tkEOF:
+        CheckToken(tkend);
+      tkAt,tkAtAt,
+      tkIdentifier,tkspecialize,
+      tkNumber,tkString,tkfalse,tktrue,tkChar,
+      tkBraceOpen,tkSquaredBraceOpen,
+      tkMinus,tkPlus,tkinherited:
+        begin
+        // Do not check this here:
+        //      if (CurToken=tkAt) and not (msDelphi in CurrentModeswitches) then
+        //        ParseExc;
+        CheckStatementCanStart;
+
+        //writeln('TPasParser.ParseStatement ',CurToken,' ',CurTokenString);
+
+        // On is usable as an identifier
+        if CompareText(CurTokenText,'on')=0 then
+          begin
+            if Params.ParseOn then
+              break;
+          end
+        else
+          Params.ParseExpr;
+        end;
       else
-        Params.ParseExpr;
+        ParseExcSyntaxError;
       end;
-    else
-      ParseExcSyntaxError;
+    except
+      on E : Exception do
+        if not Recover(E) then
+          raise;
     end;
   end;
 
@@ -7772,7 +7799,7 @@ end;
 
 { TPasParser.TParseStatementParams }
 
-{ $IFDEF VerbosePasParserWriteln}
+{$IFDEF VerbosePasParserWriteln}
 function TPasParser.TParseStatementParams.GetPrefix: string;
 var
   c: TPasElement;
@@ -7784,7 +7811,7 @@ begin
     c:=c.Parent;
   end;
 end;
-{ $ENDIF VerbosePasParserWriteln}
+{$ENDIF VerbosePasParserWriteln}
 
 function TPasParser.TParseStatementParams.CloseBlock: boolean;
 var C: TPasImplBlockClass;

packages/fcl-passrc/tests/tcbaseparser.pas

@@ -130,6 +130,7 @@ end;
 
 function TTestEngine.HandleResultOnError(aElement: TPasElement): Boolean;
 begin
+  if aElement=nil then ;
   Result:=False;
 end;
 

packages/fcl-passrc/tests/tcgenerics.pas

@@ -1,4 +1,4 @@
-unit tcgenerics;
+unit TCGenerics;
 
 {$mode objfpc}{$H+}
 

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -1,4 +1,4 @@
-unit tcresolvegenerics;
+unit TCResolveGenerics;
 
 {$mode objfpc}{$H+}
 

packages/fcl-passrc/tests/tcresolvemultierrors.pas

@@ -0,0 +1,64 @@
+unit TCResolveMultiErrors;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, testregistry, tcresolver, PParser,
+  PScanner;
+
+type
+
+  { TTestResolveMultiErrors }
+
+  TTestResolveMultiErrors = Class(TCustomTestResolver)
+  protected
+    procedure SetUp; override;
+    procedure OnParserError(Sender: TObject; const aContext: TRecoveryContext;
+      var aAllowRecovery: Boolean); virtual;
+  Published
+    procedure TestStatements_IdentifiersNotFound;
+  end;
+
+implementation
+
+{ TTestResolveMultiErrors }
+
+procedure TTestResolveMultiErrors.OnParserError(Sender: TObject;
+  const aContext: TRecoveryContext; var aAllowRecovery: Boolean);
+{$IFDEF VerbosePasResolver}
+var
+  aParser: TPasParser;
+{$ENDIF}
+begin
+  if Sender=nil then exit;
+  if aContext.Error=nil then ;
+  if aAllowRecovery then ;
+  {$IFDEF VerbosePasResolver}
+  aParser:=Sender as TPasParser;
+  writeln('TTestResolveMultiErrors.OnParserError ',aParser.LastMsgType,' (',aParser.LastMsgNumber,') Msg="',aParser.LastMsg,'"');
+  {$ENDIF}
+end;
+
+procedure TTestResolveMultiErrors.SetUp;
+begin
+  inherited SetUp;
+  Parser.MaxErrorCount:=100;
+  Parser.OnError:=@OnParserError;
+end;
+
+procedure TTestResolveMultiErrors.TestStatements_IdentifiersNotFound;
+begin
+  StartProgram(false);
+  Add('begin');
+  //Add('  a:=3;');
+  //Add('  b;');
+  ParseProgram;
+end;
+
+initialization
+  RegisterTests([TTestResolveMultiErrors]);
+
+end.
+

packages/fcl-passrc/tests/tcresolver.pas

@@ -11,7 +11,7 @@
     {=a} is "a", search at next token for a TPasAliasType t with t.DestType
            points to an element labeled "a"
 *)
-unit tcresolver;
+unit TCResolver;
 
 {$mode objfpc}{$H+}
 

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -2,7 +2,7 @@
   Examples:
     ./testpassrc --suite=TTestResolver.TestEmpty
 }
-unit tcuseanalyzer;
+unit TCUseAnalyzer;
 
 {$mode objfpc}{$H+}
 

packages/fcl-passrc/tests/testpassrc.lpi

@@ -4,7 +4,9 @@
     <Version Value="12"/>
     <General>
       <Flags>
-        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
         <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
         <CompatibilityMode Value="True"/>
@@ -40,7 +42,7 @@
         <PackageName Value="FCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="15">
+    <Units Count="17">
       <Unit0>
         <Filename Value="testpassrc.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -92,15 +94,27 @@
       <Unit12>
         <Filename Value="tcresolver.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCResolver"/>
       </Unit12>
       <Unit13>
-        <Filename Value="tcgenerics.pas"/>
+        <Filename Value="tcuseanalyzer.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCUseAnalyzer"/>
       </Unit13>
       <Unit14>
-        <Filename Value="tcuseanalyzer.pas"/>
+        <Filename Value="tcresolvegenerics.pas"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="TCResolveGenerics"/>
       </Unit14>
+      <Unit15>
+        <Filename Value="tcgenerics.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="tcresolvemultierrors.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TCResolveMultiErrors"/>
+      </Unit16>
     </Units>
   </ProjectOptions>
   <CompilerOptions>
@@ -126,11 +140,6 @@
       </Checks>
       <VerifyObjMethodCallValidity Value="True"/>
     </CodeGeneration>
-    <Linking>
-      <Debugging>
-        <DebugInfoType Value="dsDwarf3"/>
-      </Debugging>
-    </Linking>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

packages/fcl-passrc/tests/testpassrc.lpr

@@ -6,8 +6,9 @@ uses
   //MemCheck,
   Classes, consoletestrunner, tcscanner,  tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
-  tcexprparser, tcprocfunc, tcpassrcutil, tcresolver,
-  tcuseanalyzer, pasresolveeval, tcresolvegenerics, tcgenerics;
+  tcexprparser, tcprocfunc, tcpassrcutil, TCGenerics,
+  TCResolver, TCResolveGenerics, TCResolveMultiErrors,
+  TCUseAnalyzer;
 
 type