pastojs: parse units queued instead of recursively

git-svn-id: trunk@38415 -

packages/pastojs/src/fppas2js.pp

@@ -905,7 +905,8 @@ const
   po_Pas2js = po_Resolver+[
     po_AsmWhole,
     po_ResolveStandardTypes,
-    po_ExtClassConstWithoutExpr];
+    po_ExtClassConstWithoutExpr,
+    po_StopOnUnitInterface];
 
   btAllJSBaseTypes = [
     btChar,

packages/pastojs/src/pas2jscompiler.pp

@@ -230,7 +230,6 @@ type
     FShowDebug: boolean;
     FUseAnalyzer: TPasAnalyzer;
     FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
-    procedure FPasResolverContinueParsing(Sender: TObject);
     function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
     function GetUsedByCount(Section: TUsedBySection): integer;
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
@@ -260,6 +259,7 @@ type
     procedure OnPasTreeCheckSrcName(const Element: TPasElement);
     procedure OpenFile(aFilename: string);// beware: this changes FileResolver.BaseDirectory
     procedure ParsePascal;
+    procedure ParsePascalContinue;
     procedure CreateJS;
     function GetPasFirstSection: TPasSection;
     function GetPasImplSection: TPasSection;
@@ -309,6 +309,7 @@ type
     FFileCache: TPas2jsFilesCache;
     FFileCacheAutoFree: boolean;
     FFiles: TAVLTree; // tree of TPas2jsCompilerFile sorted for PasFilename
+    FParsingModules: TFPList; // list of TPas2jsCompilerFile ordered by uses sections
     FHasShownLogo: boolean;
     FLog: TPas2jsLogger;
     FMainFile: TPas2jsCompilerFile;
@@ -340,6 +341,8 @@ type
       ): boolean;
     procedure AddDefinesForTargetPlatform;
     procedure AddDefinesForTargetProcessor;
+    procedure AddParsingModule(aFile: TPas2jsCompilerFile);
+    procedure RemoveParsingModule(aFile: TPas2jsCompilerFile);
     procedure CfgSyntaxError(const Msg: string);
     procedure ConditionEvalLog(Sender: TCondDirectiveEvaluator;
       Args: array of const);
@@ -373,6 +376,7 @@ type
     // DoWriteJSFile: return false to use the default write function.
     function DoWriteJSFile(const DestFilename: String; aWriter: TPas2JSMapper): Boolean; virtual;
     procedure Compile(StartTime: TDateTime);
+    procedure ParseQueue;
     function MarkNeedBuilding(aFile: TPas2jsCompilerFile; Checked: TAVLTree;
       var SrcFileCount: integer): boolean;
     procedure OptimizeProgram(aFile: TPas2jsCompilerFile); virtual;
@@ -671,7 +675,6 @@ begin
   FPasFilename:=aPasFilename;
   FPasResolver:=TPas2jsCompilerResolver.Create;
   FPasResolver.Owner:=Self;
-  FPasResolver.OnContinueParsing:=@FPasResolverContinueParsing;
   FPasResolver.OnFindModule:=@OnPasTreeFindModule;
   FPasResolver.OnCheckSrcName:=@OnPasTreeCheckSrcName;
   FPasResolver.OnLog:=@OnPasResolverLog;
@@ -808,19 +811,6 @@ begin
   Result:=TPas2jsCompilerFile(FUsedBy[Section][Index]);
 end;
 
-procedure TPas2jsCompilerFile.FPasResolverContinueParsing(Sender: TObject);
-begin
-  try
-    Parser.ParseContinueImplementation;
-  except
-    on E: ECompilerTerminate do
-      raise;
-    on E: Exception do
-      HandleException(E);
-  end;
-  ParserFinished;
-end;
-
 function TPas2jsCompilerFile.GetUsedByCount(Section: TUsedBySection): integer;
 begin
   Result:=FUsedBy[Section].Count;
@@ -997,6 +987,8 @@ end;
 procedure TPas2jsCompilerFile.ParserFinished;
 begin
   try
+    Compiler.RemoveParsingModule(Self);
+
     if ShowDebug then
     begin
       Log.LogPlain('Pas-Module:');
@@ -1031,20 +1023,16 @@ begin
   if ShowDebug then
     Log.LogPlain(['Debug: Parsing Pascal "',PasFilename,'"...']);
   if FPasModule<>nil then
-    raise ECompilerTerminate.Create('TPas2jsCompilerFile.ParsePascal '+PasFilename);
+    Compiler.RaiseInternalError(20180305190321,PasFilename);
   try
-    // parse Pascal
+    Compiler.AddParsingModule(Self);
     PascalResolver.InterfaceOnly:=IsForeign;
     if IsMainFile then
       Parser.ParseMain(FPasModule)
     else
       Parser.ParseSubModule(FPasModule);
-    if PasModule.CustomData=nil then
-      PasModule.CustomData:=Self;
-    if (FPasModule.ImplementationSection<>nil)
-        and (FPasModule.ImplementationSection.PendingUsedIntf<>nil) then
-      exit;
-    ParserFinished;
+    if Parser.CurModule=nil then
+      ParserFinished;
   except
     on E: ECompilerTerminate do
       raise;
@@ -1055,6 +1043,24 @@ begin
     PasModule.CustomData:=Self;
 end;
 
+procedure TPas2jsCompilerFile.ParsePascalContinue;
+begin
+  if ShowDebug then
+    Log.LogPlain(['Debug: Continue parsing Pascal "',PasFilename,'"...']);
+  if FPasModule=nil then
+    Compiler.RaiseInternalError(20180305190338,PasFilename);
+  try
+    Parser.ParseContinue;
+    if Parser.CurModule=nil then
+      ParserFinished;
+  except
+    on E: ECompilerTerminate do
+      raise;
+    on E: Exception do
+      HandleException(E);
+  end;
+end;
+
 procedure TPas2jsCompilerFile.CreateJS;
 begin
   try
@@ -1404,7 +1410,7 @@ begin
 
     // parse Pascal
     aFile.ParsePascal;
-    // beware: the parser may not yet have finished due to unit cycles
+    // beware: the parser may not yet have finished
   end;
 
   Result:=aFile.PasModule;
@@ -1451,6 +1457,18 @@ begin
   end;
 end;
 
+procedure TPas2jsCompiler.AddParsingModule(aFile: TPas2jsCompilerFile);
+begin
+  if FParsingModules.IndexOf(aFile)>=0 then
+    exit;
+  FParsingModules.Add(aFile);
+end;
+
+procedure TPas2jsCompiler.RemoveParsingModule(aFile: TPas2jsCompilerFile);
+begin
+  FParsingModules.Remove(aFile);
+end;
+
 procedure TPas2jsCompiler.ConditionEvalLog(Sender: TCondDirectiveEvaluator;
   Args: array of const);
 begin
@@ -1510,6 +1528,7 @@ begin
     if MainFile=nil then exit;
     // parse and load Pascal files recursively
     FMainFile.ParsePascal;
+    ParseQueue;
 
     // whole program optimization
     if MainFile.PasModule is TPasProgram then
@@ -1547,6 +1566,50 @@ begin
   end;
 end;
 
+procedure TPas2jsCompiler.ParseQueue;
+var
+  i: Integer;
+  aFile: TPas2jsCompilerFile;
+  Found: Boolean;
+  Section: TPasSection;
+begin
+  // parse til exception or all modules have finished
+  repeat
+    {$IFDEF VerbosePasResolver}
+    writeln('TPas2jsCompiler.ParseQueue FParsingModules.Count=',FParsingModules.Count);
+    {$ENDIF}
+    Found:=false;
+    for i:=0 to FParsingModules.Count-1 do
+      begin
+      aFile:=TPas2jsCompilerFile(FParsingModules[i]);
+      if not aFile.Parser.CanParseContinue(Section) then
+        continue;
+      Found:=true;
+      {$IFDEF VerbosePasResolver}
+      writeln('TPas2jsCompiler.ParseQueue aFile=',aFile.PasFilename,' Section=',GetObjName(Section));
+      {$ENDIF}
+      aFile.ParsePascalContinue;
+      break;
+      end;
+  until not Found;
+  {$IFDEF VerbosePasResolver}
+  writeln('TPas2jsCompiler.ParseQueue END FParsingModules.Count=',FParsingModules.Count);
+  {$ENDIF}
+
+  // check consistency
+  for i:=0 to FParsingModules.Count-1 do
+    begin
+    aFile:=TPas2jsCompilerFile(FParsingModules[i]);
+    if aFile.Parser.CurModule<>nil then
+      begin
+      {$IFDEF VerbosePasResolver}
+      writeln('TPas2jsCompiler.ParseQueue aFile=',aFile.PasFilename,' was not finished');
+      {$ENDIF}
+      RaiseInternalError(20180305185342,aFile.PasFilename);
+      end;
+    end;
+end;
+
 function TPas2jsCompiler.MarkNeedBuilding(aFile: TPas2jsCompilerFile;
   Checked: TAVLTree; var SrcFileCount: integer): boolean;
 
@@ -3014,6 +3077,7 @@ begin
   //FConditionEval.OnEvalFunction:=@ConditionEvalFunction;
 
   FFiles:=TAVLTree.Create(@CompareCompilerFilesPasFile);
+  FParsingModules:=TFPList.Create;
   FUnits:=TAVLTree.Create(@CompareCompilerFilesPasUnitname);
 
   InitParamMacros;
@@ -3026,6 +3090,7 @@ begin
 
   FMainFile:=nil;
   FreeAndNil(FUnits);
+  FreeAndNil(FParsingModules);
   FFiles.FreeAndClear;
   FreeAndNil(FFiles);
 
@@ -3116,6 +3181,7 @@ begin
 
   FMainFile:=nil;
   FUnits.Clear;
+  FParsingModules.Clear;
   FFiles.FreeAndClear;
 
   FCompilerExe:='';

packages/pastojs/src/pas2jsfiler.pp

@@ -78,7 +78,8 @@ const
     'CheckModeSwitches',
     'CheckCondFunction',
     'StopOnErrorDirective',
-    'ExtClassConstWithoutExpr');
+    'ExtClassConstWithoutExpr',
+    'StopOnUnitInterface');
 
   PJUDefaultModeSwitches: TModeSwitches = [
     msObjfpc,
@@ -4234,6 +4235,7 @@ var
   i: Integer;
 begin
   Section:=Scope.Element as TPasSection;
+  Scope.UsesFinished:=true;
   Scope.Finished:=true;
   Data:=Obj.Find('Uses');
   if Data<>nil then

packages/pastojs/tests/tcmodules.pas

@@ -108,6 +108,7 @@ type
     Procedure Add(Line: string); virtual;
     Procedure Add(const Lines: array of string);
     Procedure StartParsing; virtual;
+    procedure ParseModuleQueue; virtual;
     procedure ParseModule; virtual;
     procedure ParseProgram; virtual;
     procedure ParseUnit; virtual;
@@ -140,7 +141,7 @@ type
     procedure HandlePasResolveError(E: EPasResolve);
     procedure HandlePas2JSError(E: EPas2JS);
     procedure HandleException(E: Exception);
-    procedure RaiseException(E: Exception);
+    procedure FailException(E: Exception);
     procedure WriteSources(const aFilename: string; aRow, aCol: integer);
     function IndexOfResolver(const Filename: string): integer;
     function GetResolver(const Filename: string): TTestEnginePasResolver;
@@ -922,8 +923,10 @@ begin
   InitScanner(FScanner);
 
   FEngine:=AddModule(Filename);
+  FEngine.Scanner:=FScanner;
 
   FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
+  FEngine.Parser:=FParser;
   Parser.Options:=po_tcmodules;
 
   FModule:=Nil;
@@ -968,8 +971,6 @@ begin
     FModule:=nil;
     end;
   FreeAndNil(FSource);
-  FreeAndNil(FParser);
-  FreeAndNil(FScanner);
   FreeAndNil(FFileResolver);
   if FModules<>nil then
     begin
@@ -1005,6 +1006,30 @@ begin
   Writeln(Src);
 end;
 
+procedure TCustomTestModule.ParseModuleQueue;
+var
+  i: Integer;
+  CurResolver: TTestEnginePasResolver;
+  Found: Boolean;
+  Section: TPasSection;
+begin
+  // parse til exception or all modules finished
+  while not SkipTests do
+    begin
+    Found:=false;
+    for i:=0 to ResolverCount-1 do
+      begin
+      CurResolver:=Resolvers[i];
+      if CurResolver.CurrentParser=nil then continue;
+      if not CurResolver.CurrentParser.CanParseContinue(Section) then continue;
+      CurResolver.Parser.ParseContinue;
+      Found:=true;
+      break;
+      end;
+    if not Found then break;
+    end;
+end;
+
 procedure TCustomTestModule.ParseModule;
 begin
   if SkipTests then exit;
@@ -1012,6 +1037,7 @@ begin
   try
     StartParsing;
     Parser.ParseMain(FModule);
+    ParseModuleQueue;
   except
     on E: Exception do
       HandleException(E);
@@ -1475,7 +1501,7 @@ begin
   writeln('ERROR: TCustomTestModule.HandleScannerError '+E.ClassName+':'+E.Message
     +' '+Scanner.CurFilename
     +'('+IntToStr(Scanner.CurRow)+','+IntToStr(Scanner.CurColumn)+')');
-  RaiseException(E);
+  FailException(E);
 end;
 
 procedure TCustomTestModule.HandleParserError(E: EParserError);
@@ -1486,7 +1512,7 @@ begin
     +' '+E.Filename+'('+IntToStr(E.Row)+','+IntToStr(E.Column)+')'
     +' MainModuleScannerLine="'+Scanner.CurLine+'"'
     );
-  RaiseException(E);
+  FailException(E);
 end;
 
 procedure TCustomTestModule.HandlePasResolveError(E: EPasResolve);
@@ -1498,7 +1524,7 @@ begin
   WriteSources(P.FileName,P.Row,P.Column);
   writeln('ERROR: TCustomTestModule.HandlePasResolveError '+E.ClassName+':'+E.Message
     +' '+P.FileName+'('+IntToStr(P.Row)+','+IntToStr(P.Column)+')');
-  RaiseException(E);
+  FailException(E);
 end;
 
 procedure TCustomTestModule.HandlePas2JSError(E: EPas2JS);
@@ -1511,7 +1537,7 @@ begin
   writeln('ERROR: TCustomTestModule.HandlePas2JSError '+E.ClassName+':'+E.Message
     +' '+E.PasElement.SourceFilename
     +'('+IntToStr(Row)+','+IntToStr(Col)+')');
-  RaiseException(E);
+  FailException(E);
 end;
 
 procedure TCustomTestModule.HandleException(E: Exception);
@@ -1532,11 +1558,11 @@ begin
       WriteSources('',0,0);
       writeln('ERROR: TCustomTestModule.HandleException '+E.ClassName+':'+E.Message);
       end;
-    RaiseException(E);
+    FailException(E);
     end;
 end;
 
-procedure TCustomTestModule.RaiseException(E: Exception);
+procedure TCustomTestModule.FailException(E: Exception);
 var
   MsgNumber: Integer;
 begin

packages/pastojs/tests/tcunitsearch.pas

@@ -127,6 +127,7 @@ type
   TTestCLI_UnitSearch = class(TCustomTestCLI)
   published
     procedure TestUS_Program;
+    procedure TestUS_UsesEmptyFileFail;
 
     procedure TestUS_UsesInFile;
     procedure TestUS_UsesInFile_Duplicate;
@@ -522,6 +523,16 @@ begin
   Compile(['test1.pas','-va']);
 end;
 
+procedure TTestCLI_UnitSearch.TestUS_UsesEmptyFileFail;
+begin
+  AddFile('system.pp','');
+  AddFile('test1.pas',[
+    'begin',
+    'end.']);
+  Compile(['test1.pas',''],ExitCodeSyntaxError);
+  AssertEquals('ErrorMsg','Expected "unit"',ErrorMsg);
+end;
+
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile;
 begin
   AddUnit('system.pp',[''],['']);
@@ -577,7 +588,7 @@ begin
     'begin',
     'end.']);
   Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
-  AssertEquals('ErrorMsg','Duplicate file found: "/home/user/sub/unit1.pas" and "/home/user/unit1.pas"',ErrorMsg);
+  AssertEquals('ErrorMsg','Duplicate file found: "/home/user/unit1.pas" and "/home/user/sub/unit1.pas"',ErrorMsg);
 end;
 
 Initialization