pastojs: started writing module

git-svn-id: trunk@38129 -

packages/pastojs/src/fppas2js.pp

@@ -3935,7 +3935,7 @@ begin
     // add "var $mod = this;"
     IntfContext.ThisPas:=El;
     if El.CustomData is TPasModuleScope then
-      IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).ScannerBoolSwitches;
+      IntfContext.ScannerBoolSwitches:=TPasModuleScope(El.CustomData).BoolSwitches;
     ModVarName:=FBuiltInNames[pbivnModule];
     IntfContext.AddLocalVar(ModVarName,El);
     AddToSourceElements(Src,CreateVarStatement(ModVarName,
@@ -9389,11 +9389,11 @@ begin
     BodyJS:=FD.Body;
     FuncContext:=TFunctionContext.Create(ImplProc,FD.Body,AContext);
     try
-      FuncContext.ScannerBoolSwitches:=ImplProcScope.ScannerBoolSwitches;
+      FuncContext.ScannerBoolSwitches:=ImplProcScope.BoolSwitches;
       FirstSt:=nil;
       LastSt:=nil;
 
-      if (bsRangeChecks in ImplProcScope.ScannerBoolSwitches)
+      if (bsRangeChecks in ImplProcScope.BoolSwitches)
           and (AContext.Resolver<>nil) then
         for i:=0 to El.ProcType.Args.Count-1 do
           begin

packages/pastojs/tests/tcfiler.pas

@@ -44,6 +44,16 @@ type
     procedure TearDown; override;
     procedure WriteReadUnit; virtual;
     procedure StartParsing; override;
+    procedure CheckRestoredResolver(Original, Restored: TPas2JSResolver); virtual;
+    procedure CheckRestoredDeclarations(const Path: string; Orig, Rest: TPasDeclarations); virtual;
+    procedure CheckRestoredSection(const Path: string; Orig, Rest: TPasSection); virtual;
+    procedure CheckRestoredModule(const Path: string; Orig, Rest: TPasModule); virtual;
+    procedure CheckRestoredModuleScope(const Path: string; El: TPasElement; Orig, Rest: TPasModuleScope); virtual;
+    procedure CheckRestoredIdentifierScope(const Path: string; El: TPasElement; Orig, Rest: TPasIdentifierScope); virtual;
+    procedure CheckRestoredSectionScope(const Path: string; El: TPasElement; Orig, Rest: TPasSectionScope); virtual;
+    procedure CheckRestoredCustomData(const Path: string; El: TPasElement; Orig, Rest: TObject); virtual;
+    procedure CheckRestoredElement(const Path: string; Orig, Rest: TPasElement); virtual;
+    procedure CheckRestoredReference(const Path: string; Orig, Rest: TPasElement); virtual;
   public
     property PJUWriter: TPJUWriter read FPJUWriter write FPJUWriter;
     property PJUReader: TPJUReader read FPJUReader write FPJUReader;
@@ -97,7 +107,7 @@ procedure TCustomTestPrecompile.WriteReadUnit;
 var
   ms: TMemoryStream;
   PJU: string;
-  ReadResolver: TPas2JSResolver;
+  ReadResolver: TTestEnginePasResolver;
   ReadFileResolver: TFileResolver;
   ReadScanner: TPascalScanner;
   ReadParser: TPasParser;
@@ -105,6 +115,10 @@ begin
   FPJUWriter:=TPJUWriter.Create;
   FPJUReader:=TPJUReader.Create;
   ms:=TMemoryStream.Create;
+  ReadParser:=nil;
+  ReadScanner:=nil;
+  ReadResolver:=nil;
+  ReadFileResolver:=nil;
   try
     try
       PJUWriter.OnGetSrc:=@OnFilerGetSrc;
@@ -115,7 +129,7 @@ begin
         {$IFDEF VerbosePas2JS}
         writeln('TCustomTestPrecompile.WriteReadUnit WRITE failed');
         {$ENDIF}
-        Fail('Write failed: '+E.Message);
+        Fail('Write failed('+E.ClassName+'): '+E.Message);
       end;
     end;
 
@@ -129,28 +143,27 @@ begin
 
       ReadFileResolver:=TFileResolver.Create;
       ReadScanner:=TPascalScanner.Create(ReadFileResolver);
-      ReadResolver:=TPas2JSResolver.Create;
+      ReadResolver:=TTestEnginePasResolver.Create;
       ReadParser:=TPasParser.Create(ReadScanner,ReadFileResolver,ReadResolver);
       ReadResolver.CurrentParser:=ReadParser;
-      try
-        ms.Position:=0;
-        PJUReader.ReadPJU(ReadResolver,ms);
-      finally
-        ReadParser.Free;
-        ReadScanner.Free;
-        ReadResolver.Free; // free parser before resolver
-        ReadFileResolver.Free;
-      end;
+      ms.Position:=0;
+      PJUReader.ReadPJU(ReadResolver,ms);
     except
       on E: Exception do
       begin
         {$IFDEF VerbosePas2JS}
         writeln('TCustomTestPrecompile.WriteReadUnit READ failed');
         {$ENDIF}
-        Fail('Read failed: '+E.Message);
+        Fail('Read failed('+E.ClassName+'): '+E.Message);
       end;
     end;
+
+    CheckRestoredResolver(Engine,ReadResolver);
   finally
+    ReadParser.Free;
+    ReadScanner.Free;
+    ReadResolver.Free; // free parser before resolver
+    ReadFileResolver.Free;
     ms.Free;
   end;
 end;
@@ -167,6 +180,196 @@ begin
   // ToDo: defines
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredResolver(Original,
+  Restored: TPas2JSResolver);
+begin
+  AssertNotNull('CheckRestoredResolver Original',Original);
+  AssertNotNull('CheckRestoredResolver Restored',Restored);
+  if Original.ClassType<>Restored.ClassType then
+    Fail('CheckRestoredResolver Original='+Original.ClassName+' Restored='+Restored.ClassName);
+  CheckRestoredElement('RootElement',Original.RootElement,Restored.RootElement);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredDeclarations(const Path: string;
+  Orig, Rest: TPasDeclarations);
+var
+  i: Integer;
+  OrigDecl, RestDecl: TPasElement;
+  SubPath: String;
+begin
+  for i:=0 to Orig.Declarations.Count-1 do
+    begin
+    OrigDecl:=TPasElement(Orig.Declarations[i]);
+    if i>=Rest.Declarations.Count then
+      AssertEquals(Path+': Declarations.Count',Orig.Declarations.Count,Rest.Declarations.Count);
+    RestDecl:=TPasElement(Rest.Declarations[i]);
+    SubPath:=Path+'['+IntToStr(i)+']';
+    if OrigDecl.Name<>'' then
+      SubPath:=SubPath+OrigDecl.Name
+    else
+      SubPath:=SubPath+'?noname?';
+    CheckRestoredElement(SubPath,OrigDecl,RestDecl);
+    end;
+  AssertEquals(Path+': Declarations.Count',Orig.Declarations.Count,Rest.Declarations.Count);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredSection(const Path: string; Orig,
+  Rest: TPasSection);
+begin
+  if length(Orig.UsesClause)>0 then
+    ; // ToDo
+  CheckRestoredDeclarations(Path,Rest,Orig);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredModule(const Path: string; Orig,
+  Rest: TPasModule);
+begin
+  if not (Orig.CustomData is TPasModuleScope) then
+    Fail(Path+'.CustomData is not TPasModuleScope'+GetObjName(Orig.CustomData));
+
+  CheckRestoredElement(Path+'.InterfaceSection',Orig.InterfaceSection,Rest.InterfaceSection);
+  CheckRestoredElement(Path+'.ImplementationSection',Orig.ImplementationSection,Rest.ImplementationSection);
+  if Orig is TPasProgram then
+    CheckRestoredElement(Path+'.ProgramSection',TPasProgram(Orig).ProgramSection,TPasProgram(Rest).ProgramSection)
+  else if Orig is TPasLibrary then
+    CheckRestoredElement(Path+'.LibrarySection',TPasLibrary(Orig).LibrarySection,TPasLibrary(Rest).LibrarySection);
+  CheckRestoredElement(Path+'.InitializationSection',Orig.InitializationSection,Rest.InitializationSection);
+  CheckRestoredElement(Path+'.FinalizationSection',Orig.FinalizationSection,Rest.FinalizationSection);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredModuleScope(const Path: string;
+  El: TPasElement; Orig, Rest: TPasModuleScope);
+begin
+  AssertEquals(Path+': FirstName',Orig.FirstName,Rest.FirstName);
+  if Orig.Flags<>Rest.Flags then
+    Fail(Path+': Flags');
+  if Orig.BoolSwitches<>Rest.BoolSwitches then
+    Fail(Path+': BoolSwitches');
+  CheckRestoredReference(Path+'.AssertClass',Orig.AssertClass,Rest.AssertClass);
+  CheckRestoredReference(Path+'.AssertDefConstructor',Orig.AssertDefConstructor,Rest.AssertDefConstructor);
+  CheckRestoredReference(Path+'.AssertMsgConstructor',Orig.AssertMsgConstructor,Rest.AssertMsgConstructor);
+  CheckRestoredReference(Path+'.RangeErrorClass',Orig.RangeErrorClass,Rest.RangeErrorClass);
+  CheckRestoredReference(Path+'.RangeErrorConstructor',Orig.RangeErrorConstructor,Rest.RangeErrorConstructor);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredIdentifierScope(
+  const Path: string; El: TPasElement; Orig, Rest: TPasIdentifierScope);
+begin
+  // ToDo
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredSectionScope(const Path: string;
+  El: TPasElement; Orig, Rest: TPasSectionScope);
+var
+  i: Integer;
+  OrigUses, RestUses: TPasSectionScope;
+begin
+  AssertEquals(Path+' UsesScopes.Count',Orig.UsesScopes.Count,Rest.UsesScopes.Count);
+  for i:=0 to Orig.UsesScopes.Count-1 do
+    begin
+    OrigUses:=TPasSectionScope(Orig.UsesScopes[i]);
+    if not (TObject(Rest.UsesScopes[i]) is TPasSectionScope) then
+      Fail(Path+': Uses['+IntToStr(i)+'] Rest='+GetObjName(TObject(Rest.UsesScopes[i])));
+    RestUses:=TPasSectionScope(Rest.UsesScopes[i]);
+    if OrigUses.ClassType<>RestUses.ClassType then
+      Fail(Path+': Uses['+IntToStr(i)+'] Orig='+GetObjName(OrigUses)+' Rest='+GetObjName(RestUses));
+    CheckRestoredReference(Path+': Uses['+IntToStr(i)+']',OrigUses.Element,RestUses.Element);
+    end;
+  AssertEquals(Path+': Finished',Orig.Finished,Rest.Finished);
+  CheckRestoredIdentifierScope(Path,El,Orig,Rest);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredCustomData(const Path: string;
+  El: TPasElement; Orig, Rest: TObject);
+var
+  C: TClass;
+begin
+  if Orig=nil then
+    begin
+    if Rest<>nil then
+      Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
+    exit;
+    end
+  else if Rest=nil then
+    Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
+  if Orig.ClassType<>Rest.ClassType then
+    Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
+
+  C:=Orig.ClassType;
+  if C=TPasModuleScope then
+    CheckRestoredModuleScope(Path+'[TPasModuleScope]',El,TPasModuleScope(Orig),TPasModuleScope(Rest))
+  else if C=TPasSectionScope then
+    CheckRestoredSectionScope(Path+'[TPasSectionScope]',El,TPasSectionScope(Orig),TPasSectionScope(Rest))
+  else
+    Fail(Path+': unknown CustomData '+GetObjName(Orig));
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredElement(const Path: string; Orig,
+  Rest: TPasElement);
+var
+  C: TClass;
+begin
+  if Orig=nil then
+    begin
+    if Rest<>nil then
+      Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
+    exit;
+    end
+  else if Rest=nil then
+    Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
+  if Orig.ClassType<>Rest.ClassType then
+    Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
+
+  AssertEquals(Path+': Name',Orig.Name,Rest.Name);
+  AssertEquals(Path+': SourceFilename',Orig.SourceFilename,Rest.SourceFilename);
+  AssertEquals(Path+': SourceLinenumber',Orig.SourceLinenumber,Rest.SourceLinenumber);
+  //AssertEquals(Path+': SourceEndLinenumber',Orig.SourceEndLinenumber,Rest.SourceEndLinenumber);
+  if Orig.Visibility<>Rest.Visibility then
+    Fail(Path+': Visibility '+PJUMemberVisibilityNames[Orig.Visibility]+' '+PJUMemberVisibilityNames[Rest.Visibility]);
+  if Orig.Hints<>Rest.Hints then
+    Fail(Path+': Hints');
+  AssertEquals(Path+': HintMessage',Orig.HintMessage,Rest.HintMessage);
+
+  if Orig.Parent=nil then
+    begin
+    if Rest.Parent<>nil then
+      Fail(Path+': Orig.Parent=nil Rest.Parent='+GetObjName(Rest.Parent));
+    end
+  else if Rest.Parent=nil then
+    Fail(Path+': Orig.Parent='+GetObjName(Orig.Parent)+' Rest.Parent=nil')
+  else if Orig.Parent.ClassType<>Rest.Parent.ClassType then
+    Fail(Path+': Orig.Parent='+GetObjName(Orig.Parent)+' Rest.Parent='+GetObjName(Rest.Parent));
+
+  CheckRestoredCustomData(Path+'.CustomData',Rest,Orig.CustomData,Rest.CustomData);
+
+  C:=Orig.ClassType;
+  if (C=TPasModule)
+      or (C=TPasProgram)
+      or (C=TPasLibrary) then
+    CheckRestoredModule(Path,TPasModule(Orig),TPasModule(Rest))
+  else if C.InheritsFrom(TPasSection) then
+    CheckRestoredSection(Path,TPasSection(Orig),TPasSection(Rest))
+  else
+    Fail(Path+': unknown class '+C.ClassName);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredReference(const Path: string;
+  Orig, Rest: TPasElement);
+begin
+  if Orig=nil then
+    begin
+    if Rest<>nil then
+      Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
+    exit;
+    end
+  else if Rest=nil then
+    Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
+  if Orig.ClassType<>Rest.ClassType then
+    Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
+  AssertEquals(Path+': Name',Orig.Name,Rest.Name);
+  CheckRestoredReference(Path+'.Parent',Orig.Parent,Rest.Parent);
+end;
+
 { TTestPrecompile }
 
 procedure TTestPrecompile.Test_Base256VLQ;