diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 922ecfcf31..1c4d93e49f 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -123,11 +123,11 @@ resourcestring SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Records'; SParserNoFieldsAllowedInX = 'Fields are not allowed in %s'; SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers'; - SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.'; - SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.'; - SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.'; - SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.'; - SErrRecordTypesNotAllowed = 'Record types not allowed at this location.'; + SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location'; + SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location'; + SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location'; + SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location'; + SErrRecordTypesNotAllowed = 'Record types not allowed at this location'; SParserTypeNotAllowedHere = 'Type "%s" not allowed here'; SParserNotAnOperand = 'Not an operand: (%d : %s)'; SParserArrayPropertiesCannotHaveDefaultValue = 'Array properties cannot have default value'; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 91007f2de6..dfdfbafd21 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -25422,7 +25422,8 @@ begin RaiseNotSupported(El,AContext,20190105104054); // local record type elevated to global scope Src:=TJSSourceElements(AContext.JSElement); - VarSt:=CreateVarStatement(TransformElToJSName(El,AContext),Call,El); + JSName:=TransformElToJSName(El,AContext); + VarSt:=CreateVarStatement(JSName,Call,El); AddToSourceElements(Src,VarSt); // keep Result=nil // add parameter: parent = null Call.AddArg(CreateLiteralNull(El)); @@ -25459,7 +25460,7 @@ begin FuncContext.ThisVar.Element:=El; FuncContext.ThisVar.Kind:=cvkGlobal; - if coShortRefGlobals in Options then + if (coShortRefGlobals in Options) and not (El.Parent is TProcedureBody) then begin // $lt = this; JSName:=AContext.GetLocalName(El,[cvkGlobal]); diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index eb5cda8579..84b40b0411 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -63,6 +63,7 @@ type procedure TestOptShortRefGlobals_GenericFunction; procedure TestOptShortRefGlobals_SameUnit_EnumType; procedure TestOptShortRefGlobals_SameUnit_ClassType; + procedure TestOptShortRefGlobals_SameUnit_RecordType; // Whole Program Optimization procedure TestWPO_OmitLocalVar; @@ -619,7 +620,7 @@ begin 'end;', '']); ConvertUnit; - CheckSource('TestOptShortRefGlobals_SameUnit_EnumType', + CheckSource('TestOptShortRefGlobals_SameUnit_ClassType', LinesToStr([ 'var $impl = $mod.$impl;', 'var $lt = null;', @@ -667,6 +668,115 @@ begin ''])); end; +procedure TTestOptimizations.TestOptShortRefGlobals_SameUnit_RecordType; +begin + StartUnit(true,[supTObject]); + Add([ + '{$optimization JSShortRefGlobals}', + '{$modeswitch advancedrecords}', + 'interface', + 'type', + ' TAnt = record', + ' type', + ' TLeg = record', + ' l: word;', + ' end;', + ' procedure Run;', + ' Leg: TLeg;', + ' end;', + 'implementation', + 'type', + ' TBird = record', + ' b: word;', + ' end;', + 'procedure TAnt.Run;', + 'type', + ' TFoot = record', + ' f: word;', + ' end;', + 'var', + ' b: TBird;', + ' l: TLeg;', + ' a: TAnt;', + ' f: TFoot;', + 'begin', + ' b.b:=1;', + ' l.l:=2;', + ' a.Leg.l:=3;', + ' f.f:=4;', + 'end;', + '']); + ConvertUnit; + CheckSource('TestOptShortRefGlobals_SameUnit_RecordType', + LinesToStr([ + 'var $impl = $mod.$impl;', + 'var $lt = null;', + 'var $lt1 = null;', + 'var $lt2 = null;', + 'rtl.recNewT(this, "TAnt", function () {', + ' $lt = this;', + ' rtl.recNewT($lt, "TLeg", function () {', + ' $lt1 = this;', + ' this.l = 0;', + ' this.$eq = function (b) {', + ' return this.l === b.l;', + ' };', + ' this.$assign = function (s) {', + ' this.l = s.l;', + ' return this;', + ' };', + ' });', + ' this.$new = function () {', + ' var r = Object.create(this);', + ' r.Leg = $lt1.$new();', + ' return r;', + ' };', + ' this.$eq = function (b) {', + ' return this.Leg.$eq(b.Leg);', + ' };', + ' this.$assign = function (s) {', + ' this.Leg.$assign(s.Leg);', + ' return this;', + ' };', + ' var TFoot = rtl.recNewT(null, "", function () {', + ' this.f = 0;', + ' this.$eq = function (b) {', + ' return this.f === b.f;', + ' };', + ' this.$assign = function (s) {', + ' this.f = s.f;', + ' return this;', + ' };', + ' });', + ' this.Run = function () {', + ' var b = $lt2.$new();', + ' var l = $lt1.$new();', + ' var a = $lt.$new();', + ' var f = TFoot.$new();', + ' b.b = 1;', + ' l.l = 2;', + ' a.Leg.l = 3;', + ' f.f = 4;', + ' };', + '}, true);', + '']), + LinesToStr([ + '']), + LinesToStr([ + 'rtl.recNewT($impl, "TBird", function () {', + ' $lt2 = this;', + ' this.b = 0;', + ' this.$eq = function (b) {', + ' return this.b === b.b;', + ' };', + ' this.$assign = function (s) {', + ' this.b = s.b;', + ' return this;', + ' };', + '});', + ''])); +end; + procedure TTestOptimizations.TestWPO_OmitLocalVar; begin StartProgram(false);