fcl-passrc: debug queued parsing, more tests

git-svn-id: trunk@38434 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1438,7 +1438,7 @@ type
     procedure NotifyPendingUsedInterfaces; virtual;
     function GetPendingUsedInterface(Section: TPasSection): TPasUsesUnit;
     function CheckPendingUsedInterface(Section: TPasSection): boolean; override;
-    procedure ContinueParsing; virtual;
+    procedure UsedInterfacesFinished(Section: TPasSection); virtual;
     function NeedArrayValues(El: TPasElement): boolean; override;
     function GetDefaultClassVisibility(AClass: TPasClassType
       ): TPasMemberVisibility; override;
@@ -4138,7 +4138,10 @@ end;
 
 procedure TPasResolver.FinishInterfaceSection(Section: TPasSection);
 begin
-  {$IFDEF VerbosePasResolver}
+  {$IFDEF VerboseUnitQueue}
+  writeln('TPasResolver.FinishInterfaceSection ',GetObjName(RootElement));
+  {$ENDIF}
+  {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
   if not IsUnitIntfFinished(Section.GetModule) then
     RaiseInternalError(20171214004323,'TPasResolver.FinishInterfaceSection "'+CurrentParser.CurModule.Name+'" "'+Section.GetModule.Name+'" IsUnitIntfFinished=false');
   {$ENDIF}
@@ -11832,7 +11835,6 @@ var
   PendingResolver: TPasResolver;
   PendingParser: TPasParser;
   PendingSection: TPasSection;
-  Changed: Boolean;
 begin
   // call all PendingResolvers
   // Note that a waiting resolver might continue parsing, so this
@@ -11849,14 +11851,7 @@ begin
     {$ENDIF}
     if PendingSection=nil then
       RaiseInternalError(20180305141421);
-    Changed:=PendingResolver.CheckPendingUsedInterface(PendingSection); // beware: this might alter the ModuleScope.PendingResolvers
-    if Changed and (PendingSection.PendingUsedIntf=nil) then
-      begin
-      {$IFDEF VerbosePasResolver}
-      writeln('TPasResolver.FinishInterfaceSection "',ModuleScope.Element.Name,'" Continue="',PendingResolver.RootElement.Name,'"');
-      {$ENDIF}
-      PendingParser.ParseContinue;
-      end;
+    PendingResolver.CheckPendingUsedInterface(PendingSection); // beware: this might alter the ModuleScope.PendingResolvers
     dec(i);
     if i>=ModuleScope.PendingResolvers.Count then
       i:=ModuleScope.PendingResolvers.Count-1;
@@ -11905,6 +11900,7 @@ begin
     end;
 
   Section.PendingUsedIntf:=GetPendingUsedInterface(Section);
+  //writeln('TPasResolver.CheckPendingUsedInterface ',GetObjName(RootElement),' Section=',GetObjName(Section),' PendingUsedIntf=',GetObjName(Section.PendingUsedIntf));
   if Section.PendingUsedIntf<>nil then
     begin
     // module not yet finished due to pending used interfaces
@@ -11921,22 +11917,26 @@ begin
   else
     begin
     {$IFDEF VerbosePasResolver}
+    {AllowWriteln}
     if WasPending then
       writeln('TPasResolver.CheckPendingUsedInterface "',CurrentParser.CurModule.Name,'" uses section complete: ',Section.ClassName);
+    {AllowWriteln-}
     {$ENDIF}
-
     Result:=WasPending;
+    if Result then
+      UsedInterfacesFinished(Section);
     end;
 end;
 
-procedure TPasResolver.ContinueParsing;
+procedure TPasResolver.UsedInterfacesFinished(Section: TPasSection);
 // if there is a unit cycle that stopped parsing this unit
 // this method is called after the needed used unit interfaces have finished
 begin
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.ContinueParsing "',CurrentParser.CurModule.Name,'"...');
+  writeln('TPasResolver.UsesSectionFinished ',Section.ElementTypeName,' "',CurrentParser.CurModule.Name,'"...');
   {$ENDIF}
   CurrentParser.ParseContinue;
+  if Section=nil then ;
 end;
 
 function TPasResolver.NeedArrayValues(El: TPasElement): boolean;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -605,6 +605,9 @@ begin
   Result:=aClass.Create;
   Result.Element:=El;
   FUsedElements.Add(Result);
+  {$IFDEF VerbosePasAnalyzer}
+  //writeln('TPasAnalyzer.Add END ',GetElModName(El),' Success=',FindNode(El)<>nil,' ',ptruint(pointer(El)));
+  {$ENDIF}
 end;
 
 procedure TPasAnalyzer.CreateTree;
@@ -2271,7 +2274,7 @@ begin
     exit;
     end;
   {$IFDEF VerbosePasAnalyzer}
-  writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') ',Msg.MsgText);
+  writeln('TPasAnalyzer.EmitMessage [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') ',Msg.MsgText,' ScopeModule=',GetObjName(ScopeModule));
   {$ENDIF}
   try
     OnMessage(Self,Msg);

packages/fcl-passrc/src/pparser.pp

@@ -2790,14 +2790,14 @@ begin
     exit; // parse completed
   if (LastMsg<>'') and (LastMsgType<=mtError) then
     begin
-    {$IFDEF VerbosePasResolver}
+    {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
     writeln('TPasParser.CanParseContinue ',CurModule.Name,' LastMsg="',LastMsgType,':',LastMsg,'"');
     {$ENDIF}
     exit;
     end;
   if (Scanner.LastMsg<>'') and (Scanner.LastMsgType<=mtError) then
     begin
-    {$IFDEF VerbosePasResolver}
+    {$IF defined(VerbosePasResolver) or defined(VerboseUnitQueue)}
     writeln('TPasParser.CanParseContinue ',CurModule.Name,' Scanner.LastMsg="',Scanner.LastMsgType,':',Scanner.LastMsg,'"');
     {$ENDIF}
     exit;
@@ -2810,8 +2810,16 @@ begin
         and (CurModule.InterfaceSection=nil) then
       exit(true)
     else
+      begin
+      {$IFDEF VerboseUnitQueue}
+      writeln('TPasParser.CanParseContinue ',CurModule.Name,' no LastSection');
+      {$ENDIF}
       exit(false);
+      end;
   Result:=Section.PendingUsedIntf=nil;
+  {$IFDEF VerboseUnitQueue}
+  writeln('TPasParser.CanParseContinue ',CurModule.Name,' Result=',Result,' ',Section.ElementTypeName);
+  {$ENDIF}
 end;
 
 procedure TPasParser.ParseContinue;
@@ -2841,7 +2849,9 @@ begin
       ParseDeclarations(Section);
       end;
     Section:=GetLastSection;
-    if (Section<>nil) and (Section.PendingUsedIntf<>nil) then
+    if Section=nil then
+      ParseExc(nErrNoSourceGiven,'[20180306112327]');
+    if Section.PendingUsedIntf<>nil then
       HasFinished:=false;
     if HasFinished then
       Engine.FinishScope(stModule,CurModule);
@@ -2913,6 +2923,7 @@ begin
     if not HasFinished then
       begin
       {$IFDEF VerbosePasResolver}
+      {AllowWriteln}
       writeln('TPasParser.ParseProgram pause parsing after uses list of "',CurModule.Name,'"');
       if CanParseContinue(aSection) then
         begin
@@ -2921,6 +2932,7 @@ begin
           writeln('TPasParser.ParseProgram aSection=',aSection.ClassName,' ',Section=aSection);
         ParseExc(nErrNoSourceGiven,'[20180305172432] ');
         end;
+      {AllowWriteln-}
       {$ENDIF}
       exit;
       end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -71,6 +71,7 @@ type
       overload; override;
     function FindUnit(const AName, InFilename: String; NameExpr,
       InFileExpr: TPasExpr): TPasModule; override;
+    procedure UsedInterfacesFinished(Section: TPasSection); override;
     property OnFindUnit: TOnFindUnit read FOnFindUnit write FOnFindUnit;
     property Filename: string read FFilename write FFilename;
     property StreamResolver: TStreamResolver read FStreamResolver write FStreamResolver;
@@ -775,6 +776,13 @@ begin
   Result:=OnFindUnit(Self,AName,InFilename,NameExpr,InFileExpr);
 end;
 
+procedure TTestEnginePasResolver.UsedInterfacesFinished(Section: TPasSection);
+begin
+  if Section=nil then ;
+  // do not parse recursively
+  // using a queue
+end;
+
 { TCustomTestResolver }
 
 procedure TCustomTestResolver.SetUp;
@@ -796,6 +804,8 @@ begin
   {$IFDEF VerbosePasResolverMem}
   writeln('TTestResolver.TearDown ResolverEngine.Clear');
   {$ENDIF}
+  if ResolverEngine.Parser=Parser then
+    ResolverEngine.Parser:=nil;
   ResolverEngine.Clear;
   if FModules<>nil then
     begin
@@ -830,6 +840,9 @@ var
   CurResolver: TTestEnginePasResolver;
   Found: Boolean;
 begin
+  if ResolverEngine.Parser=nil then
+    ResolverEngine.Parser:=Parser;
+
   inherited ParseModule;
   repeat
     Found:=false;
@@ -837,27 +850,35 @@ begin
       begin
       CurResolver:=Modules[i];
       if CurResolver.Parser=nil then continue;
-      if CurResolver.Parser.CanParseContinue(Section) then
-        begin
-        {$IFDEF VerbosePasResolver}
-        writeln('TCustomTestResolver.ParseModule continue parsing section=',GetObjName(Section),' of ',CurResolver.Filename);
-        {$ENDIF}
-        Found:=true;
-        CurResolver.Parser.ParseContinue;
-        break;
-        end;
+      if not CurResolver.Parser.CanParseContinue(Section) then
+        continue;
+      {$IFDEF VerbosePasResolver}
+      writeln('TCustomTestResolver.ParseModule continue parsing section=',GetObjName(Section),' of ',CurResolver.Filename);
+      {$ENDIF}
+      Found:=true;
+      CurResolver.Parser.ParseContinue;
+      break;
       end;
   until not Found;
 
   for i:=0 to ModuleCount-1 do
     begin
     CurResolver:=Modules[i];
-    if CurResolver.CurrentParser.CurModule<>nil then
+    if CurResolver.Parser=nil then
+      begin
+      if CurResolver.CurrentParser<>nil then
+        Fail(CurResolver.Filename+' Parser<>CurrentParser Parser="'+GetObjName(CurResolver.Parser)+'" CurrentParser='+GetObjName(CurResolver.CurrentParser));
+      continue;
+      end;
+    if CurResolver.Parser.CurModule<>nil then
       begin
+      Section:=CurResolver.Parser.GetLastSection;
       {$IFDEF VerbosePasResolver}
-      writeln('TCustomTestResolver.ParseModule module not finished "',CurResolver.RootElement.Name,'"');
+      writeln('TCustomTestResolver.ParseModule module not finished "',GetObjName(CurResolver.RootElement),'" LastSection=',GetObjName(Section)+' PendingUsedIntf='+GetObjName(Section.PendingUsedIntf));
+      if (Section<>nil) and (Section.PendingUsedIntf<>nil) then
+        writeln('TCustomTestResolver.ParseModule PendingUsedIntf=',GetObjName(Section.PendingUsedIntf.Module));
       {$ENDIF}
-      Fail('module not finished "'+CurResolver.RootElement.Name+'"');
+      Fail('module not finished "'+GetObjName(CurResolver.RootElement)+'"');
       end;
     end;
 end;

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -83,8 +83,9 @@ type
     // single module hints
     procedure TestM_Hint_UnitNotUsed;
     procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
+    procedure TestM_Hint_UnitUsed;
+    procedure TestM_Hint_UnitUsedVarArgs;
     procedure TestM_Hint_ParameterNotUsed;
-    procedure TestM_HintsOff_ParameterNotUsed;
     procedure TestM_Hint_ParameterAssignedButNotReadVarParam;
     procedure TestM_Hint_ParameterNotUsed_Abstract;
     procedure TestM_Hint_ParameterNotUsedTypecast;
@@ -1146,6 +1147,40 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_UnitUsed;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    '']),
+    LinesToStr(['']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('begin');
+  Add('  i:=3;');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
+procedure TTestUseAnalyzer.TestM_Hint_UnitUsedVarArgs;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'var i: longint;',
+    '']),
+    LinesToStr(['']));
+
+  StartProgram(true);
+  Add('uses unit2;');
+  Add('procedure Writeln(); varargs;');
+  Add('begin end;');
+  Add('begin');
+  Add('  writeln(i);');
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
 begin
   StartProgram(true);
@@ -1158,11 +1193,6 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
-procedure TTestUseAnalyzer.TestM_HintsOff_ParameterNotUsed;
-begin
-
-end;
-
 procedure TTestUseAnalyzer.TestM_Hint_ParameterAssignedButNotReadVarParam;
 begin
   StartUnit(false);