pastojs: filer: write final switches, test overloads

git-svn-id: trunk@38534 -

packages/pastojs/src/pas2jscompiler.pp

@@ -1205,7 +1205,8 @@ begin
     JS:=Converter.ConvertPasElement(PasModule,PascalResolver);
     Converter.Options:=Converter.Options-[coStoreImplJS];
 
-    Writer.WritePCU(PascalResolver,Converter,Compiler.PrecompileInitialFlags,ms,false);
+    Writer.WritePCU(PascalResolver,Converter,Compiler.PrecompileInitialFlags,ms,
+      {$IFDEF DisablePCUCompressed}false{$ELSE}true{$ENDIF});
     {$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
     writeln('TPas2jsCompilerFile.WritePCU precompiled ',PCUFilename);
     {$ENDIF}

packages/pastojs/tests/tcfiler.pas

@@ -145,9 +145,11 @@ type
     procedure TestPC_Proc_UTF8;
     procedure TestPC_Class;
     procedure TestPC_Initialization;
+    procedure TestPC_BoolSwitches;
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
+    procedure TestPC_UseIndirectUnit;
   end;
 
 function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer;
@@ -478,12 +480,22 @@ end;
 
 procedure TCustomTestPrecompile.CheckRestoredResolver(Original,
   Restored: TPas2JSResolver);
+var
+  OrigParser, RestParser: TPasParser;
 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);
+  OrigParser:=Original.CurrentParser;
+  RestParser:=Restored.CurrentParser;
+  if OrigParser.Options<>RestParser.Options then
+    Fail('CheckRestoredResolver Parser.Options');
+  if OrigParser.Scanner.CurrentBoolSwitches<>RestParser.Scanner.CurrentBoolSwitches then
+    Fail('CheckRestoredResolver Scanner.BoolSwitches');
+  if OrigParser.Scanner.CurrentModeSwitches<>RestParser.Scanner.CurrentModeSwitches then
+    Fail('CheckRestoredResolver Scanner.ModeSwitches');
 end;
 
 procedure TCustomTestPrecompile.CheckRestoredDeclarations(const Path: string;
@@ -1719,6 +1731,32 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_BoolSwitches;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  '{$R+}',
+  '{$C+}',
+  'type',
+  '  TObject = class',
+  '{$C-}',
+  '    procedure DoIt;',
+  '  end;',
+  '{$C+}',
+  'implementation',
+  '{$R-}',
+  'procedure TObject.DoIt;',
+  'begin',
+  'end;',
+  '{$C-}',
+  'initialization',
+  '{$R+}',
+  'end.',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_UseUnit;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',
@@ -1789,6 +1827,37 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_UseIndirectUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '    i: longint;',
+    '  end;']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    'var o: TObject;']),
+    LinesToStr([
+    '']));
+
+  StartUnit(true);
+  Add([
+  'interface',
+  'uses unit1;',
+  'implementation',
+  'initialization',
+  '  o.i:=3;',
+  'end.',
+  '']);
+  WriteReadUnit;
+end;
+
 Initialization
   RegisterTests([TTestPrecompile]);
 end.

packages/pastojs/tests/tcprecompile.pas

@@ -25,22 +25,33 @@ interface
 
 uses
   Classes, SysUtils,
-  fpcunit, testregistry,
+  fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler,
-  tcunitsearch, tcmodules, Pas2jsFileUtils;
+  tcunitsearch, tcmodules;
 
 type
 
-  { TTestCLI_Precompile }
+  { TCustomTestCLI_Precompile }
 
-  TTestCLI_Precompile = class(TCustomTestCLI)
+  TCustomTestCLI_Precompile = class(TCustomTestCLI)
+  private
+    FFormat: TPas2JSPrecompileFormat;
   protected
     procedure CheckPrecompile(MainFile, UnitPaths: string;
       SharedParams: TStringList = nil;
       FirstRunParams: TStringList = nil;
       SecondRunParams: TStringList = nil);
+  public
+    constructor Create; override;
+    property Format: TPas2JSPrecompileFormat read FFormat write FFormat;
+  end;
+
+  { TTestCLI_Precompile }
+
+  TTestCLI_Precompile = class(TCustomTestCLI_Precompile)
   published
     procedure TestPCU_EmptyUnit;
     procedure TestPCU_ParamNS;
+    procedure TestPCU_Overloads;
     procedure TestPCU_UnitCycle;
   end;
 
@@ -56,9 +67,9 @@ begin
   for i:=Low(Lines) to High(Lines) do Result.Add(Lines[i]);
 end;
 
-{ TTestCLI_Precompile }
+{ TCustomTestCLI_Precompile }
 
-procedure TTestCLI_Precompile.CheckPrecompile(MainFile, UnitPaths: string;
+procedure TCustomTestCLI_Precompile.CheckPrecompile(MainFile, UnitPaths: string;
   SharedParams: TStringList; FirstRunParams: TStringList;
   SecondRunParams: TStringList);
 var
@@ -77,8 +88,8 @@ begin
       Params.Assign(SharedParams);
     if FirstRunParams<>nil then
       Params.AddStrings(FirstRunParams);
-    Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JUpcu','-FU'+UnitOutputDir]);
+    Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JU'+Format.Ext,'-FU'+UnitOutputDir]);
-    AssertFileExists('units/system.pcu');
+    AssertFileExists('units/system.'+Format.Ext);
     JSFilename:=UnitOutputDir+PathDelim+ExtractFilenameOnly(MainFile)+'.js';
     AssertFileExists(JSFilename);
     JSFile:=FindFile(JSFilename);
@@ -108,6 +119,14 @@ begin
   end;
 end;
 
+constructor TCustomTestCLI_Precompile.Create;
+begin
+  inherited Create;
+  FFormat:=PrecompileFormats.FindExt('pcu');
+end;
+
+{ TTestCLI_Precompile }
+
 procedure TTestCLI_Precompile.TestPCU_EmptyUnit;
 begin
   AddUnit('src/system.pp',[''],['']);
@@ -129,6 +148,43 @@ begin
   CheckPrecompile('test1.pas','src',LinesToList(['-NSfoo']));
 end;
 
+procedure TTestCLI_Precompile.TestPCU_Overloads;
+begin
+  AddUnit('src/system.pp',['type integer = longint;'],['']);
+  AddUnit('src/unit1.pp',
+  ['var i: integer;',
+   'procedure DoIt(j: integer); overload;',
+   'procedure DoIt(b: boolean);'],
+  ['procedure DoIt(j: integer);',
+   'begin',
+   '  i:=j;',
+   'end;',
+   'procedure DoIt(b: boolean);',
+   'begin',
+   '  i:=3;',
+   'end;']);
+  AddUnit('src/unit2.pp',
+  ['uses unit1;',
+  'procedure DoIt(s: string); overload;'],
+  ['procedure DoIt(s: string);',
+   'begin',
+   '  unit1.i:=j;',
+   'end;']);
+  AddFile('test1.pas',[
+    'uses unit1;',
+    'procedure DoIt(d: double); overload;',
+    'begin',
+    '  unit1.i:=j;',
+    'end;',
+    'begin',
+    '  DoIt(3);',
+    '  DoIt(''abc'');',
+    '  Do1(true);',
+    '  Do1(3.3);',
+    'end.']);
+  CheckPrecompile('test1.pas','src');
+end;
+
 procedure TTestCLI_Precompile.TestPCU_UnitCycle;
 begin
   AddUnit('src/system.pp',['type integer = longint;'],['']);