pastojs: shortrefglobals: local recordtype

git-svn-id: trunk@46969 -

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';

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]);

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);