Browse Source

pastojs: renamed aliasglobals to jsaliasglobals

git-svn-id: trunk@46805 -
Mattias Gaertner 4 years ago
parent
commit
1d3ea62674
2 changed files with 53 additions and 11 deletions
  1. 1 1
      packages/pastojs/src/fppas2js.pp
  2. 52 10
      packages/pastojs/tests/tcoptimizations.pas

+ 1 - 1
packages/pastojs/src/fppas2js.pp

@@ -2797,7 +2797,7 @@ procedure TPas2jsPasScanner.DoHandleOptimization(OptName, OptValue: string);
 
 
 begin
 begin
   case lowercase(OptName) of
   case lowercase(OptName) of
-  'aliasglobals':
+  'jsaliasglobals':
     HandleBoolean(coAliasGlobals,true);
     HandleBoolean(coAliasGlobals,true);
   else
   else
     DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization '+OptName]);
     DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization '+OptName]);

+ 52 - 10
packages/pastojs/tests/tcoptimizations.pas

@@ -56,7 +56,7 @@ type
 
 
   TTestOptimizations = class(TCustomTestOptimizations)
   TTestOptimizations = class(TCustomTestOptimizations)
   published
   published
-    // unit optimization: aliasglobals
+    // unit optimization: jsaliasglobals
     procedure TestOptAliasGlobals_Program;
     procedure TestOptAliasGlobals_Program;
     procedure TestOptAliasGlobals_Unit; // ToDo
     procedure TestOptAliasGlobals_Unit; // ToDo
     // ToDo: external var, const, class
     // ToDo: external var, const, class
@@ -203,8 +203,11 @@ procedure TTestOptimizations.TestOptAliasGlobals_Program;
 begin
 begin
   AddModuleWithIntfImplSrc('UnitA.pas',
   AddModuleWithIntfImplSrc('UnitA.pas',
   LinesToStr([
   LinesToStr([
+    'type',
+    '  TColor = (red,green,blue);',
+    '  TColors = set of TColor;',
     'const',
     'const',
-    '  cWidth = 17;',
+    '  cRedBlue = [red,blue];',
     'type',
     'type',
     '  TBird = class',
     '  TBird = class',
     '  public',
     '  public',
@@ -221,7 +224,7 @@ begin
 
 
   StartProgram(true,[supTObject]);
   StartProgram(true,[supTObject]);
   Add([
   Add([
-  '{$optimization AliasGlobals}',
+  '{$optimization JSAliasGlobals}',
   'uses unita;',
   'uses unita;',
   'type',
   'type',
   '  TEagle = class(TBird)',
   '  TEagle = class(TBird)',
@@ -233,6 +236,7 @@ begin
   'var',
   'var',
   '  e: TEagle;',
   '  e: TEagle;',
   '  r: TRec;',
   '  r: TRec;',
+  '  c: TColors;',
   'begin',
   'begin',
   '  e:=TEagle.Create;',
   '  e:=TEagle.Create;',
   '  b:=TBird.Create;',
   '  b:=TBird.Create;',
@@ -242,6 +246,7 @@ begin
   '  r.x:=e.Run;',
   '  r.x:=e.Run;',
   '  r.x:=e.Run();',
   '  r.x:=e.Run();',
   '  r.x:=e.Run(4);',
   '  r.x:=e.Run(4);',
+  '  c:=cRedBlue;',
   '']);
   '']);
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestOptAliasGlobals_Program',
   CheckSource('TestOptAliasGlobals_Program',
@@ -257,6 +262,7 @@ begin
     '});',
     '});',
     'this.e = null;',
     'this.e = null;',
     'this.r = $ltr1.$new();',
     'this.r = $ltr1.$new();',
+    'this.c = {};',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
     '$mod.e = $mod.TEagle.$create("Create");',
     '$mod.e = $mod.TEagle.$create("Create");',
@@ -267,22 +273,20 @@ begin
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(5);',
     '$mod.r.x = $mod.e.$class.Run(4);',
     '$mod.r.x = $mod.e.$class.Run(4);',
+    '$mod.c = rtl.refSet($lmr.cRedBlue);',
     '']));
     '']));
 end;
 end;
 
 
 procedure TTestOptimizations.TestOptAliasGlobals_Unit;
 procedure TTestOptimizations.TestOptAliasGlobals_Unit;
 begin
 begin
-  exit;
-
   AddModuleWithIntfImplSrc('UnitA.pas',
   AddModuleWithIntfImplSrc('UnitA.pas',
   LinesToStr([
   LinesToStr([
-    'const',
-    '  cWidth = 17;',
     'type',
     'type',
     '  TBird = class',
     '  TBird = class',
     '  public',
     '  public',
     '    class var Span: word;',
     '    class var Span: word;',
     '    class procedure Fly(w: word); virtual; abstract;',
     '    class procedure Fly(w: word); virtual; abstract;',
+    '    class procedure Swim; static;',
     '  end;',
     '  end;',
     '  TRecA = record',
     '  TRecA = record',
     '    x: word;',
     '    x: word;',
@@ -290,16 +294,16 @@ begin
     'var Bird: TBird;',
     'var Bird: TBird;',
     '']),
     '']),
   LinesToStr([
   LinesToStr([
+    'class procedure TBird.Swim; begin end;',
     '']));
     '']));
   AddModuleWithIntfImplSrc('UnitB.pas',
   AddModuleWithIntfImplSrc('UnitB.pas',
   LinesToStr([
   LinesToStr([
-    'const',
-    '  cHeight = 23;',
     'type',
     'type',
     '  TAnt = class',
     '  TAnt = class',
     '  public',
     '  public',
     '    class var Legs: word;',
     '    class var Legs: word;',
     '    class procedure Run(w: word); virtual; abstract;',
     '    class procedure Run(w: word); virtual; abstract;',
+    '    class procedure Walk; static;',
     '  end;',
     '  end;',
     '  TRecB = record',
     '  TRecB = record',
     '    y: word;',
     '    y: word;',
@@ -307,10 +311,11 @@ begin
     'var Ant: TAnt;',
     'var Ant: TAnt;',
     '']),
     '']),
   LinesToStr([
   LinesToStr([
+    'class procedure TAnt.Walk; begin end;',
     '']));
     '']));
   StartUnit(true,[supTObject]);
   StartUnit(true,[supTObject]);
   Add([
   Add([
-  '{$optimization AliasGlobals}',
+  '{$optimization JSAliasGlobals}',
   'interface',
   'interface',
   'uses unita;',
   'uses unita;',
   'type',
   'type',
@@ -341,12 +346,49 @@ begin
   '  Bird:=TBird.Create;',
   '  Bird:=TBird.Create;',
   '  Ant:=TAnt.Create;',
   '  Ant:=TAnt.Create;',
   '  TRedAnt.RedAntRecA.x:=TRedAnt.RedAntRecB.y;',
   '  TRedAnt.RedAntRecA.x:=TRedAnt.RedAntRecB.y;',
+  '  Ant.Walk;',
+  '  RedAnt.Walk;',
+  '  RedAnt.Run(17);',
   '']);
   '']);
   ConvertUnit;
   ConvertUnit;
   CheckSource('TestOptAliasGlobals_Unit',
   CheckSource('TestOptAliasGlobals_Unit',
     LinesToStr([
     LinesToStr([
+    'var $impl = $mod.$impl;',
+    'var $lmr = pas.UnitA;',
+    'var $ltr = $lmr.TBird;',
+    'var $ltr1 = $lmr.TRecA;',
+    'var $lmr1 = pas.UnitB;',
+    'var $ltr2 = $lmr1.TAnt;',
+    'rtl.createClass($mod, "TEagle", $ltr, function () {',
+    '  this.EagleRec = $ltr1.$new();',
+    '  this.Fly = function (w) {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '$impl.Eagle = $mod.TEagle.$create("Create");',
+    '$impl.RedAnt = $impl.TRedAnt.$create("Create");',
+    '$lmr.Bird = $ltr.$create("Create");',
+    '$lmr1.Ant = $ltr2.$create("Create");',
+    '$impl.TRedAnt.RedAntRecA.x = $impl.TRedAnt.RedAntRecB.y;',
+    '$lmr1.Ant.Walk();',
+    '$impl.RedAnt.Walk();',
+    '$impl.RedAnt.$class.Run(17);',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
+    'var $lmr = pas.UnitB;',
+    'var $ltr = $lmr.TAnt;',
+    'var $lmr1 = pas.UnitA;',
+    'var $ltr1 = $lmr1.TRecA;',
+    'var $ltr2 = $lmr.TRecB;',
+    'rtl.createClass($impl, "TRedAnt", $ltr, function () {',
+    '  this.RedAntRecA = $ltr1.$new();',
+    '  this.RedAntRecB = $ltr2.$new();',
+    '  this.Run = function (w) {',
+    '  };',
+    '});',
+    '$impl.Eagle = null;',
+    '$impl.RedAnt = null;',
     '']));
     '']));
 end;
 end;