paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 03:39:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: renamed aliasglobals to jsaliasglobals

Browse Source 
git-svn-id: trunk@46805 -
This commit is contained in:
Mattias Gaertner 2020-09-09 10:39:29 +00:00
parent c8f592d260
commit 1d3ea62674
2 changed files with 53 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/pastojs/src/fppas2js.pp
View File

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

62
packages/pastojs/tests/tcoptimizations.pas
View File

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