Ver código fonte

pastojs: fixed record member type

mattias 4 anos atrás
pai
commit
6050bfe6e4

+ 4 - 4
compiler/packages/pastojs/src/fppas2js.pp

@@ -26319,14 +26319,14 @@ begin
         end
         end
       else if C=TPasConst then
       else if C=TPasConst then
         begin
         begin
-        NewEl:=ConvertConst(TPasConst(P),aContext);
+        NewEl:=ConvertConst(TPasConst(P),FuncContext);
         IsComplex:=true;
         IsComplex:=true;
         end
         end
       else if C=TPasProperty then
       else if C=TPasProperty then
-        NewEl:=ConvertProperty(TPasProperty(P),AContext)
+        NewEl:=ConvertProperty(TPasProperty(P),FuncContext)
       else if C.InheritsFrom(TPasType) then
       else if C.InheritsFrom(TPasType) then
         begin
         begin
-        NewEl:=CreateTypeDecl(TPasType(P),aContext);
+        NewEl:=CreateTypeDecl(TPasType(P),FuncContext);
         if (C=TPasRecordType) or (C=TPasClassType) then
         if (C=TPasRecordType) or (C=TPasClassType) then
           IsComplex:=true;
           IsComplex:=true;
         end
         end
@@ -26334,7 +26334,7 @@ begin
         begin
         begin
         if (C=TPasClassConstructor)
         if (C=TPasClassConstructor)
            or (C=TPasClassDestructor) then
            or (C=TPasClassDestructor) then
-          AddGlobalClassMethod(AContext,TPasProcedure(P))
+          AddGlobalClassMethod(FuncContext,TPasProcedure(P))
         else
         else
           begin
           begin
           Methods.Add(P);
           Methods.Add(P);

+ 37 - 1
compiler/packages/pastojs/tests/tcmodules.pas

@@ -831,6 +831,7 @@ type
     Procedure TestRTTI_ClassOf;
     Procedure TestRTTI_ClassOf;
     Procedure TestRTTI_Record;
     Procedure TestRTTI_Record;
     Procedure TestRTTI_RecordAnonymousArray;
     Procedure TestRTTI_RecordAnonymousArray;
+    Procedure TestRTTI_Record_ClassVarType;
     Procedure TestRTTI_LocalTypes;
     Procedure TestRTTI_LocalTypes;
     Procedure TestRTTI_TypeInfo_BaseTypes;
     Procedure TestRTTI_TypeInfo_BaseTypes;
     Procedure TestRTTI_TypeInfo_Type_BaseTypes;
     Procedure TestRTTI_TypeInfo_Type_BaseTypes;
@@ -12159,7 +12160,7 @@ begin
     '  };',
     '  };',
     '});',
     '});',
     'rtl.recNewT(this, "TPoint", function () {',
     'rtl.recNewT(this, "TPoint", function () {',
-    '  rtl.createClass(this, "TBird", this.TObject, function () {',
+    '  rtl.createClass(this, "TBird", $mod.TObject, function () {',
     '    this.DoIt = function () {',
     '    this.DoIt = function () {',
     '      this.DoIt();',
     '      this.DoIt();',
     '      this.DoIt();',
     '      this.DoIt();',
@@ -30345,6 +30346,41 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestRTTI_Record_ClassVarType;
+begin
+  WithTypeInfo:=true;
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  TPoint = record',
+  '    type TProc = procedure(w: word);',
+  '    class var p: TProc;',
+  '  end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestRTTI_Record_ClassVarType',
+    LinesToStr([ // statements
+    'rtl.recNewT(this, "TPoint", function () {',
+    '  $mod.$rtti.$ProcVar("TPoint.TProc", {',
+    '    procsig: rtl.newTIProcSig([["w", rtl.word]])',
+    '  });',
+    '  this.p = null;',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '  var $r = $mod.$rtti.$Record("TPoint", {});',
+    '  $r.addField("p", $mod.$rtti["TPoint.TProc"]);',
+    '}, true);',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_LocalTypes;
 procedure TTestModule.TestRTTI_LocalTypes;
 begin
 begin
   WithTypeInfo:=true;
   WithTypeInfo:=true;

+ 1 - 1
compiler/packages/pastojs/tests/tcoptimizations.pas

@@ -1496,7 +1496,7 @@ begin
     'var $lt2 = null;',
     'var $lt2 = null;',
     'rtl.recNewT(this, "TAnt", function () {',
     'rtl.recNewT(this, "TAnt", function () {',
     '  $lt = this;',
     '  $lt = this;',
-    '  rtl.recNewT($lt, "TLeg", function () {',
+    '  rtl.recNewT(this, "TLeg", function () {',
     '    $lt1 = this;',
     '    $lt1 = this;',
     '    this.l = 0;',
     '    this.l = 0;',
     '    this.$eq = function (b) {',
     '    this.$eq = function (b) {',