pastojs: bool and modeswitches for sections

git-svn-id: trunk@39430 -

packages/pastojs/src/fppas2js.pp

@@ -1278,6 +1278,7 @@ type
     AccessContext: TConvertContext;
     TmpVarCount: integer;
     ScannerBoolSwitches: TBoolSwitches;
+    ScannerModeSwitches: TModeSwitches;
     constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); virtual;
     function GetRootModule: TPasModule;
     function GetNonDotContext: TConvertContext;
@@ -4848,6 +4849,7 @@ begin
     Access:=aParent.Access;
     AccessContext:=aParent.AccessContext;
     ScannerBoolSwitches:=aParent.ScannerBoolSwitches;
+    ScannerModeSwitches:=aParent.ScannerModeSwitches;
     end;
 end;
 
@@ -10876,6 +10878,7 @@ var
   I : Integer;
   P: TPasElement;
   C: TClass;
+  SectionScope: TPas2JSSectionScope;
 begin
   Result:=nil;
   {
@@ -10892,6 +10895,14 @@ begin
   IsFunction:=IsProcBody and (El.Parent is TPasFunction);
   IsAssembler:=IsProcBody and (TProcedureBody(El).Body is TPasImplAsmStatement);
   HasResult:=IsFunction and not IsAssembler;
+
+  if (AContext.Resolver<>nil) and (El is TPasSection) then
+    begin
+    SectionScope:=El.CustomData as TPas2JSSectionScope;
+    AContext.ScannerBoolSwitches:=SectionScope.BoolSwitches;
+    AContext.ScannerModeSwitches:=SectionScope.ModeSwitches;
+    end;
+
   SLFirst:=nil;
   SLLast:=nil;
   ResultEl:=nil;

packages/pastojs/src/pas2jsfiler.pp

@@ -2543,6 +2543,12 @@ begin
   Scope:=TPas2JSSectionScope(CheckElScope(Section,20180206121825,TPas2JSSectionScope));
   if not Scope.Finished then
     RaiseMsg(20180206130333,Section);
+
+  WriteBoolSwitches(Obj,'BoolSwitches',Scope.BoolSwitches,aContext.BoolSwitches);
+  aContext.BoolSwitches:=Scope.BoolSwitches;
+  WriteModeSwitches(Obj,'ModeSwitches',Scope.ModeSwitches,aContext.ModeSwitches);
+  aContext.ModeSwitches:=Scope.ModeSwitches;
+
   if Scope.UsesScopes.Count<>length(Section.UsesClause) then
     RaiseMsg(20180206122222,Section);
   Arr:=nil;
@@ -3681,6 +3687,7 @@ begin
   // Mode: TModeSwitch: auto derived
   WriteProcScopeFlags(Obj,'SFlags',Scope.Flags,[]);
   WriteBoolSwitches(Obj,'BoolSwitches',Scope.BoolSwitches,aContext.BoolSwitches);
+  WriteModeSwitches(Obj,'ModeSwitches',Scope.ModeSwitches,aContext.ModeSwitches);
 end;
 
 procedure TPCUWriter.WriteProcedure(Obj: TJSONObject; El: TPasProcedure;
@@ -5326,6 +5333,8 @@ procedure TPCUReader.ReadSectionScope(Obj: TJSONObject;
 begin
   ReadIdentifierScope(Obj,Scope,aContext);
   // not needed: Scope ElevatedLocals
+  Scope.BoolSwitches:=ReadBoolSwitches(Obj,Scope.Element,'BoolSwitches',aContext.BoolSwitches);
+  Scope.ModeSwitches:=ReadModeSwitches(Obj,Scope.Element,'ModeSwitches',aContext.ModeSwitches);
 end;
 
 procedure TPCUReader.ReadSection(Obj: TJSONObject; Section: TPasSection;
@@ -5356,8 +5365,11 @@ begin
   ReadUsedUnitsFinish(Obj,Section,aContext);
   // read scope, needs external refs
   ReadSectionScope(Obj,Scope,aContext);
+  aContext.BoolSwitches:=Scope.BoolSwitches;
+  aContext.ModeSwitches:=Scope.ModeSwitches;
   // read declarations, needs external refs
   ReadDeclarations(Obj,Section,aContext);
+
   Scope.Finished:=true;
   if Section is TInterfaceSection then
     begin
@@ -6260,6 +6272,7 @@ var
   OldBoolSwitches: TBoolSwitches;
   Prog: TPasProgram;
   Lib: TPasLibrary;
+  OldModeSwitches: TModeSwitches;
 begin
   Result:=false;
   {$IFDEF VerbosePCUFiler}
@@ -6270,6 +6283,7 @@ begin
 
   OldBoolSwitches:=aContext.BoolSwitches;
   aContext.BoolSwitches:=ModScope.BoolSwitches;
+  OldModeSwitches:=aContext.ModeSwitches;
   try
     // read sections
     if aModule.ClassType=TPasProgram then
@@ -6315,6 +6329,7 @@ begin
       end;
   finally
     aContext.BoolSwitches:=OldBoolSwitches;
+    aContext.ModeSwitches:=OldModeSwitches;
   end;
 
   ResolvePending;
@@ -7219,15 +7234,9 @@ begin
   // ClassScope: TPasClassScope; auto derived
   // Scope.SelfArg only valid for method implementation
 
-  if msDelphi in aContext.ModeSwitches then
-    Scope.Mode:=msDelphi
-  else if msObjfpc in aContext.ModeSwitches then
-    Scope.Mode:=msObjfpc
-  else
-    RaiseMsg(20180213220335,Scope.Element);
-
   Scope.Flags:=ReadProcScopeFlags(Obj,Proc,'SFlags',[]);
   Scope.BoolSwitches:=ReadBoolSwitches(Obj,Proc,'BoolSwitches',aContext.BoolSwitches);
+  Scope.ModeSwitches:=ReadModeSwitches(Obj,Proc,'ModeSwitches',aContext.ModeSwitches);
 
   //ReadIdentifierScope(Obj,Scope,aContext);
 end;

packages/pastojs/tests/tcfiler.pas

@@ -656,6 +656,10 @@ var
   i: Integer;
   OrigUses, RestUses: TPas2JSSectionScope;
 begin
+  if Orig.BoolSwitches<>Rest.BoolSwitches then
+    Fail(Path+'.BoolSwitches Orig='+BoolSwitchesToStr(Orig.BoolSwitches)+' Rest='+BoolSwitchesToStr(Rest.BoolSwitches));
+  if Orig.ModeSwitches<>Rest.ModeSwitches then
+    Fail(Path+'.ModeSwitches');
   AssertEquals(Path+' UsesScopes.Count',Orig.UsesScopes.Count,Rest.UsesScopes.Count);
   for i:=0 to Orig.UsesScopes.Count-1 do
     begin
@@ -794,11 +798,12 @@ begin
 
     CheckRestoredScopeReference(Path+'.ClassScope',Orig.ClassScope,Rest.ClassScope);
     CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
-    AssertEquals(Path+'.Mode',PCUModeSwitchNames[Orig.Mode],PCUModeSwitchNames[Rest.Mode]);
     if Orig.Flags<>Rest.Flags then
       Fail(Path+'.Flags');
     if Orig.BoolSwitches<>Rest.BoolSwitches then
       Fail(Path+'.BoolSwitches');
+    if Orig.ModeSwitches<>Rest.ModeSwitches then
+      Fail(Path+'.ModeSwitches');
 
     //CheckRestoredIdentifierScope(Path,Orig,Rest);
     end

packages/pastojs/tests/tcmodules.pas

@@ -21850,10 +21850,13 @@ begin
   '  b:=1;',
   'end;',
   '{$R-}',
+  'procedure DoSome;',
   'begin',
   '  DoIt(w);',
   '  b:=w;',
   '  b:=2;',
+  'end;',
+  'begin',
   '{$R+}',
   '']);
   ConvertProgram;
@@ -21867,11 +21870,13 @@ begin
     '  rtl.rc($mod.b += $mod.w, 0, 255);',
     '  $mod.b = 1;',
     '};',
+    'this.DoSome = function () {',
+    '  $mod.DoIt($mod.w);',
+    '  $mod.b = $mod.w;',
+    '  $mod.b = 2;',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.DoIt($mod.w);',
-    '$mod.b = rtl.rc($mod.w,0,255);',
-    '$mod.b = 2;',
     '']));
 end;
 
@@ -21892,10 +21897,13 @@ begin
   '  b:=1;',
   'end;',
   '{$R-}',
+  'procedure DoSome;',
   'begin',
   '  DoIt(w);',
   '  b:=w;',
   '  b:=2;',
+  'end;',
+  'begin',
   '{$R+}',
   '']);
   ConvertProgram;
@@ -21909,11 +21917,13 @@ begin
     '  rtl.rc($mod.b += $mod.w, 1, 10);',
     '  $mod.b = 1;',
     '};',
+    'this.DoSome = function () {',
+    '  $mod.DoIt($mod.w);',
+    '  $mod.b = $mod.w;',
+    '  $mod.b = 2;',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.DoIt($mod.w);',
-    '$mod.b = rtl.rc($mod.w, 1, 10);',
-    '$mod.b = 2;',
     '']));
 end;
 
@@ -21932,10 +21942,13 @@ begin
   '  p:=succ(e);',
   'end;',
   '{$R-}',
+  'procedure DoSome;',
   'begin',
   '  DoIt(e);',
   '  e:=TEnum(1);',
   '  e:=pred(e);',
+  'end;',
+  'begin',
   '{$R+}',
   '']);
   ConvertProgram;
@@ -21954,11 +21967,13 @@ begin
     '  p = 0;',
     '  p = rtl.rc($mod.e + 1, 0, 1);',
     '};',
+    'this.DoSome = function () {',
+    '  $mod.DoIt($mod.e);',
+    '  $mod.e = 1;',
+    '  $mod.e = $mod.e - 1;',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.DoIt($mod.e);',
-    '$mod.e = 1;',
-    '$mod.e = rtl.rc($mod.e-1, 0, 1);',
     '']));
 end;
 
@@ -21979,10 +21994,13 @@ begin
   '  p:=succ(e);',
   'end;',
   '{$R-}',
+  'procedure DoSome;',
   'begin',
   '  DoIt(e);',
-  '  e:=TEnumRg(1);',
+  '  e:=TEnum(1);',
   '  e:=pred(e);',
+  'end;',
+  'begin',
   '{$R+}',
   '']);
   ConvertProgram;
@@ -22001,11 +22019,13 @@ begin
     '  p = 0;',
     '  p = rtl.rc($mod.e + 1, 0, 1);',
     '};',
+    'this.DoSome = function () {',
+    '  $mod.DoIt($mod.e);',
+    '  $mod.e = 1;',
+    '  $mod.e = $mod.e - 1;',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.DoIt($mod.e);',
-    '$mod.e = 1;',
-    '$mod.e = rtl.rc($mod.e-1, 0, 1);',
     '']));
 end;
 
@@ -22024,10 +22044,13 @@ begin
   '  b:=''1'';',
   'end;',
   '{$R-}',
+  'procedure DoSome;',
   'begin',
   '  DoIt(w);',
   '  b:=w;',
   '  b:=''2'';',
+  'end;',
+  'begin',
   '{$R+}',
   '']);
   ConvertProgram;
@@ -22040,11 +22063,13 @@ begin
     '  $mod.b = rtl.rcc($mod.w, 0, 65535);',
     '  $mod.b = "1";',
     '};',
+    'this.DoSome = function () {',
+    '  $mod.DoIt($mod.w);',
+    '  $mod.b = $mod.w;',
+    '  $mod.b = "2";',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.DoIt($mod.w);',
-    '$mod.b = rtl.rcc($mod.w, 0, 65535);',
-    '$mod.b = "2";',
     '']));
 end;
 
@@ -22063,10 +22088,13 @@ begin
   '  b:=''1'';',
   'end;',
   '{$R-}',
+  'procedure DoSome;',
   'begin',
   '  DoIt(w);',
   '  b:=w;',
   '  b:=''2'';',
+  'end;',
+  'begin',
   '{$R+}',
   '']);
   ConvertProgram;
@@ -22079,11 +22107,13 @@ begin
     '  $mod.b = rtl.rcc($mod.w, 48, 57);',
     '  $mod.b = "1";',
     '};',
+    'this.DoSome = function () {',
+    '  $mod.DoIt($mod.w);',
+    '  $mod.b = $mod.w;',
+    '  $mod.b = "2";',
+    '};',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.DoIt($mod.w);',
-    '$mod.b = rtl.rcc($mod.w, 48, 57);',
-    '$mod.b = "2";',
     '']));
 end;
 

packages/pastojs/tests/tcprecompile.pas

@@ -56,6 +56,7 @@ type
     procedure TestPCU_UTF8BOM;
     procedure TestPCU_ParamNS;
     procedure TestPCU_Overloads;
+    procedure TestPCU_Overloads_MDelphi_ModeObjFPC;
     procedure TestPCU_UnitCycle;
     procedure TestPCU_ClassForward;
     procedure TestPCU_ClassConstructor;
@@ -220,6 +221,44 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
+procedure TTestCLI_Precompile.TestPCU_Overloads_MDelphi_ModeObjFPC;
+var
+  SharedParams: TStringList;
+begin
+  AddUnit('src/system.pp',[
+  'type',
+  '  integer = longint;',
+  '  TDateTime = type double;'],
+  ['']);
+  AddFile('src/unit1.pp',
+    LinesToStr([
+    'unit unit1;',
+    '{$mode objfpc}',
+    'interface',
+    'function DoIt(i: integer): TDateTime;', // no overload needed in ObjFPC
+    'function DoIt(i, j: integer): TDateTime;',
+    'implementation',
+    'function DoIt(i: integer): TDateTime;',
+    'begin',
+    '  Result:=i;',
+    'end;',
+    'function DoIt(i, j: integer): TDateTime;',
+    'begin',
+    '  Result:=i+j;',
+    'end;',
+    'end.']));
+  AddFile('test1.pas',[
+    'uses unit1;',
+    'var d: TDateTime;',
+    'begin',
+    '  d:=DoIt(3);',
+    '  d:=DoIt(4,5);',
+    'end.']);
+  SharedParams:=TStringList.Create;
+  SharedParams.Add('-MDelphi');
+  CheckPrecompile('test1.pas','src',SharedParams);
+end;
+
 procedure TTestCLI_Precompile.TestPCU_UnitCycle;
 begin
   AddUnit('src/system.pp',['type integer = longint;'],['']);