diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 77447d848e..23397538f3 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -15177,7 +15177,8 @@ begin end;// end of init function // for specialization: add RTTI name - if (Scope.JSName<>'') and (Scope.JSName<>El.Name) and HasTypeInfo(El,AContext) then + if ((Scope.JSName<>'') and (Scope.JSName<>El.Name)) + or (El.Parent is TPasMembersType) then begin Call.AddArg(CreateLiteralString(El,GetTypeInfoName(El,AContext,El))); end; diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas index d0fa2ffeb8..4ecd7c43bf 100644 --- a/packages/pastojs/tests/tcgenerics.pas +++ b/packages/pastojs/tests/tcgenerics.pas @@ -27,7 +27,7 @@ type Procedure TestGen_ClassEmpty; Procedure TestGen_Class_EmptyMethod; Procedure TestGen_Class_TList; - Procedure TestGen_Class_TCustomList; + Procedure TestGen_Class_TCustomList; // ToDo: with Self do Result:=Method() Procedure TestGen_ClassAncestor; Procedure TestGen_Class_TypeInfo; Procedure TestGen_Class_TypeOverload; // ToDo TBird, TBird, TBird @@ -37,12 +37,13 @@ type Procedure TestGen_Class_ClassConstructor; Procedure TestGen_Class_TypeCastSpecializesWarn; Procedure TestGen_Class_TypeCastSpecializesJSValueNoWarn; - procedure TestGen_Class_VarArgsOfType; procedure TestGen_Class_OverloadsInUnit; procedure TestGen_ClassForward_CircleRTTI; + procedure TestGen_Class_Nested_RTTI; Procedure TestGen_Class_ClassVarRecord_UnitImpl; // generic external class + procedure TestGen_ExtClass_VarArgsOfType; procedure TestGen_ExtClass_Array; procedure TestGen_ExtClass_GenJSValueAssign; procedure TestGen_ExtClass_AliasMemberType; @@ -365,7 +366,7 @@ begin ' };', '});', 'rtl.createClass(this, "TBird$G1", this.TObject, function () {', - '});', + '}, "TBird");', 'this.a = null;', 'this.b = null;', '']), @@ -403,7 +404,7 @@ begin ' var Result = 0;', ' return Result;', ' };', - '});', + '}, "TBird");', 'this.a = null;', '']), LinesToStr([ // $mod.$main @@ -479,7 +480,7 @@ begin ' this.FItems.splice(2, 0, w);', ' this.FItems.splice(2, 3);', ' };', - '});', + '}, "TList");', 'this.l = null;', 'this.w = 0;', '']), @@ -511,7 +512,7 @@ begin 'function TList.Add: word;', 'begin', ' Result:=PrepareAddingItem;', - //' Result:=Self.PrepareAddingItem;', + ' Result:=Self.PrepareAddingItem;', //' with Self do Result:=PrepareAddingItem;', 'end;', 'var l: TWordList;', @@ -531,14 +532,15 @@ begin ' var Result = 0;', ' return Result;', ' };', - '});', + '}, "TCustomList");', 'rtl.createClass(this, "TList$G1", this.TCustomList$G2, function () {', ' this.Add = function () {', ' var Result = 0;', ' Result = this.PrepareAddingItem();', + ' Result = this.PrepareAddingItem();', ' return Result;', ' };', - '});', + '}, "TList");', 'this.l = null;', '']), LinesToStr([ // $mod.$main @@ -568,9 +570,9 @@ begin ' };', '});', 'rtl.createClass(this, "TBird$G2", this.TObject, function () {', - '});', + '}, "TBird");', 'rtl.createClass(this, "TEagle$G1", this.TBird$G2, function () {', - '});', + '}, "TEagle");', 'this.a = null;', '']), LinesToStr([ // $mod.$main @@ -684,7 +686,7 @@ begin '});', 'rtl.createClass(this, "TBird$G1", this.TObject, function () {', ' this.fSize = 0;', - '});', + '}, "TBird");', '']), LinesToStr([ // $mod.$main '$mod.TBird$G1.fSize = 3 + $mod.TBird$G1.fSize;', @@ -750,7 +752,7 @@ begin ' this.Run();', ' $mod.TPoint$G1.Run();', ' };', - '});', + '}, "TPoint");', 'this.p = null;', '']), LinesToStr([ // $mod.$main @@ -800,13 +802,13 @@ begin ' this.x = 0;', ' this.Fly = function () {', ' };', - '});', + '}, "TPoint");', 'this.r = null;', 'rtl.createClass(this, "TPoint$G2", this.TObject, function () {', ' this.x = 0;', ' this.Fly = function () {', ' };', - '});', + '}, "TPoint");', 'this.s = null;', '']), LinesToStr([ // $mod.$main @@ -858,13 +860,13 @@ begin ' $mod.TObject.$init.call(this);', ' this.F = 0;', ' };', - '});', + '}, "TBird");', 'rtl.createClass(this, "TBird$G2", this.TObject, function () {', ' this.$init = function () {', ' $mod.TObject.$init.call(this);', ' this.F = "";', ' };', - '});', + '}, "TBird");', 'this.w = null;', 'this.c = null;', '']), @@ -906,13 +908,13 @@ begin ' $mod.TObject.$init.call(this);', ' this.F = 0;', ' };', - '});', + '}, "TBird");', 'rtl.createClass(this, "TBird$G2", this.TObject, function () {', ' this.$init = function () {', ' $mod.TObject.$init.call(this);', ' this.F = undefined;', ' };', - '});', + '}, "TBird");', 'this.w = null;', 'this.a = null;', '']), @@ -923,45 +925,6 @@ begin CheckResolverUnexpectedHints(); end; -procedure TTestGenerics.TestGen_Class_VarArgsOfType; -begin - StartProgram(false); - Add([ - '{$mode objfpc}', - '{$modeswitch externalclass}', - 'type', - ' TJSObject = class external name ''Object''', - ' end;', - ' generic TGJSSet = class external name ''Set''', - ' constructor new(aElement1: T); varargs of T; overload;', - ' function bind(thisArg: TJSObject): T; varargs of T;', - ' end;', - ' TJSWordSet = specialize TGJSSet;', - 'var', - ' s: TJSWordSet;', - ' w: word;', - 'begin', - ' s:=TJSWordSet.new(3);', - ' s:=TJSWordSet.new(3,5);', - ' w:=s.bind(nil);', - ' w:=s.bind(nil,6);', - ' w:=s.bind(nil,7,8);', - '']); - ConvertProgram; - CheckSource('TestGen_Class_VarArgsOfType', - LinesToStr([ // statements - 'this.s = null;', - 'this.w = 0;', - '']), - LinesToStr([ // $mod.$main - '$mod.s = new Set(3);', - '$mod.s = new Set(3, 5);', - '$mod.w = $mod.s.bind(null);', - '$mod.w = $mod.s.bind(null, 6);', - '$mod.w = $mod.s.bind(null, 7, 8);', - ''])); -end; - procedure TTestGenerics.TestGen_Class_OverloadsInUnit; begin StartProgram(true,[supTObject]); @@ -1013,7 +976,7 @@ begin ' this.Create$2 = function (b) {', ' return this;', ' };', - ' });', + ' }, "TBird");', ' rtl.createClass(this, "TBird$G2", pas.system.TObject, function () {', ' this.c = 13;', ' var c$1 = 14;', @@ -1024,7 +987,7 @@ begin ' this.Create$2 = function (b) {', ' return this;', ' };', - ' });', + ' }, "TBird");', '});', ''])); CheckSource('TestGen_Class_OverloadsInUnit', @@ -1115,6 +1078,57 @@ begin ''])); end; +procedure TTestGenerics.TestGen_Class_Nested_RTTI; +begin + WithTypeInfo:=true; + StartProgram(true,[supTObject]); + AddModuleWithIntfImplSrc('UnitA.pas', + LinesToStr([ + 'type', + ' generic TAnt = class', + ' type', + ' TLeg = class', + ' published', + ' Size: T;', + ' end;', + ' end;', + ' TBoolAnt = specialize TAnt;', + '']), + LinesToStr([ + ''])); + Add([ + 'uses UnitA;', + 'var', + ' BoolLeg: TBoolAnt.TLeg;', + 'begin', + ' if typeinfo(TBoolAnt.TLeg)=nil then ;', + '']); + ConvertProgram; + CheckUnit('UnitA.pas', + LinesToStr([ // statements + 'rtl.module("UnitA", ["system"], function () {', + ' var $mod = this;', + ' $mod.$rtti.$Class("TAnt");', + ' rtl.createClass(this, "TAnt$G1", pas.system.TObject, function () {', + ' rtl.createClass(this, "TLeg", pas.system.TObject, function () {', + ' this.$init = function () {', + ' pas.system.TObject.$init.call(this);', + ' this.Size = false;', + ' };', + ' var $r = this.$rtti;', + ' $r.addField("Size", rtl.boolean);', + ' }, "TAnt.TLeg");', + ' }, "TAnt");', + '});'])); + CheckSource('TestGen_Class_Nested_RTTI', + LinesToStr([ // statements + 'this.BoolLeg = null;', + '']), + LinesToStr([ // $mod.$main + 'if (pas.UnitA.$rtti["TAnt.TLeg"] === null) ;', + ''])); +end; + procedure TTestGenerics.TestGen_Class_ClassVarRecord_UnitImpl; begin StartProgram(true,[supTObject]); @@ -1151,7 +1165,7 @@ begin ' this.x = $impl.TBird.$new();', ' this.a = rtl.arraySetLength(null, $impl.TBird, 2);', ' };', - ' });', + ' }, "TAnt");', ' $mod.$implcode = function () {', ' rtl.recNewT($impl, "TBird", function () {', ' this.b = 0;', @@ -1168,7 +1182,8 @@ begin ' $mod.$init = function () {', ' $impl.f.x.b = $impl.f.x.b + 10;', ' };', - '}, []);'])); + '}, []);', + ''])); CheckSource('TestGen_Class_ClassVarRecord_UnitImpl', LinesToStr([ // statements 'pas.UnitA.TAnt$G1.$initSpec();', @@ -1177,6 +1192,45 @@ begin ''])); end; +procedure TTestGenerics.TestGen_ExtClass_VarArgsOfType; +begin + StartProgram(false); + Add([ + '{$mode objfpc}', + '{$modeswitch externalclass}', + 'type', + ' TJSObject = class external name ''Object''', + ' end;', + ' generic TGJSSet = class external name ''Set''', + ' constructor new(aElement1: T); varargs of T; overload;', + ' function bind(thisArg: TJSObject): T; varargs of T;', + ' end;', + ' TJSWordSet = specialize TGJSSet;', + 'var', + ' s: TJSWordSet;', + ' w: word;', + 'begin', + ' s:=TJSWordSet.new(3);', + ' s:=TJSWordSet.new(3,5);', + ' w:=s.bind(nil);', + ' w:=s.bind(nil,6);', + ' w:=s.bind(nil,7,8);', + '']); + ConvertProgram; + CheckSource('TestGen_ExtClass_VarArgsOfType', + LinesToStr([ // statements + 'this.s = null;', + 'this.w = 0;', + '']), + LinesToStr([ // $mod.$main + '$mod.s = new Set(3);', + '$mod.s = new Set(3, 5);', + '$mod.w = $mod.s.bind(null);', + '$mod.w = $mod.s.bind(null, 6);', + '$mod.w = $mod.s.bind(null, 7, 8);', + ''])); +end; + procedure TTestGenerics.TestGen_ExtClass_Array; begin StartProgram(false); @@ -1431,10 +1485,17 @@ begin ' this.$final = function () {', ' };', '});', - 'rtl.createInterface(this, "IBird$G2", "{33AB51C6-6240-3BDF-B4B0-D48A593EAB0A}", ["GetSize", "SetSize", "DoIt"], this.IUnknown);', + 'rtl.createInterface(', + ' this,', + ' "IBird$G2",', + ' "{33AB51C6-6240-3BDF-B4B0-D48A593EAB0A}",', + ' ["GetSize", "SetSize", "DoIt"],', + ' this.IUnknown,', + ' "IBird"', + ');', 'rtl.createClass(this, "TBird$G1", this.TObject, function () {', ' rtl.addIntf(this, $mod.IBird$G2);', - '});', + '}, "TBird");', 'this.BirdIntf = null;', '']), LinesToStr([ // $mod.$main @@ -1463,7 +1524,14 @@ begin ConvertProgram; CheckSource('TestGen_ClassInterface_InterfacedObject', LinesToStr([ // statements - 'rtl.createInterface(this, "IComparer$G2", "{505778ED-F783-4456-9691-32F419CC5E18}", ["Compare"], pas.system.IUnknown);', + 'rtl.createInterface(', + ' this,', + ' "IComparer$G2",', + ' "{505778ED-F783-4456-9691-32F419CC5E18}",', + ' ["Compare"],', + ' pas.system.IUnknown,', + ' "IComparer"', + ');', 'this.aComparer = null;', 'rtl.createClass(this, "TComparer$G1", pas.system.TInterfacedObject, function () {', ' this.Compare = function (Left, Right) {', @@ -1472,7 +1540,7 @@ begin ' };', ' rtl.addIntf(this, $mod.IComparer$G2);', ' rtl.addIntf(this, pas.system.IUnknown);', - '});', + '}, "TComparer");', '']), LinesToStr([ // $mod.$main 'rtl.setIntfP($mod, "aComparer", rtl.queryIntfT($mod.TComparer$G1.$create("Create"), $mod.IComparer$G2), true);', @@ -1549,7 +1617,7 @@ begin ' };', '});', 'rtl.createClass(this, "TBird$G1", this.TObject, function () {', - '});', + '}, "TBird");', 'this.b = null;', '']), LinesToStr([ // $mod.$main @@ -1592,13 +1660,13 @@ begin ' this.Fly = function () {', ' $impl.DoIt();', ' };', - ' });', + ' }, "TBird");', ' this.b = null;', ' rtl.createClass(this, "TBird$G2", pas.system.TObject, function () {', ' this.Fly = function () {', ' $impl.DoIt();', ' };', - ' });', + ' }, "TBird");', ' $mod.$implcode = function () {', ' $impl.DoIt = function () {', ' var b = null;', @@ -1646,7 +1714,7 @@ begin ' var i = 0;', ' i = this.m;', ' };', - '});', + '}, "TBird");', 'this.b = null;', '']), LinesToStr([ // $mod.$main @@ -1694,7 +1762,7 @@ begin ' $mod.o.Field = 3;', ' if (4 === $mod.o.Field) ;', ' };', - '});', + '}, "TBird");', 'this.b = null;', '']), LinesToStr([ // $mod.$main diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 899da0629b..ee8d14c966 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -11964,7 +11964,7 @@ begin ' this.Glob();', ' this.Glob();', ' };', - ' });', + ' }, "TPoint.TBird");', ' this.$eq = function (b) {', ' return true;', ' };', @@ -16395,7 +16395,7 @@ begin ' this.FId = i;', ' return Result;', ' };', - ' });', + ' }, "TBird.TLeg");', ' this.DoIt = function (b) {', ' var Result = null;', ' Result.Create();', diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 84b40b0411..99260c9f92 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -634,7 +634,7 @@ begin ' $lt = this;', ' rtl.createClass(this, "TLeg", $lt4, function () {', ' $lt1 = this;', - ' });', + ' }, "TAnt.TLeg");', ' this.$init = function () {', ' $lt4.$init.call(this);', ' this.Bird = null;', diff --git a/packages/pastojs/tests/tcsrcmap.pas b/packages/pastojs/tests/tcsrcmap.pas index 9351ba31fa..560d775627 100644 --- a/packages/pastojs/tests/tcsrcmap.pas +++ b/packages/pastojs/tests/tcsrcmap.pas @@ -16,7 +16,7 @@ Examples: ./testpas2js --suite=TTestSrcMap.TestEmptyProgram } -unit tcsrcmap; +unit TCSrcMap; {$mode objfpc}{$H+} diff --git a/packages/pastojs/tests/testpas2js.lpi b/packages/pastojs/tests/testpas2js.lpi index 97d1d48f1b..2fcca50564 100644 --- a/packages/pastojs/tests/testpas2js.lpi +++ b/packages/pastojs/tests/testpas2js.lpi @@ -64,6 +64,7 @@ + diff --git a/packages/pastojs/tests/testpas2js.pp b/packages/pastojs/tests/testpas2js.pp index 5808b95be0..0437a3978c 100644 --- a/packages/pastojs/tests/testpas2js.pp +++ b/packages/pastojs/tests/testpas2js.pp @@ -20,8 +20,8 @@ uses {$IFDEF EnableMemCheck} MemCheck, {$ENDIF} - Classes, consoletestrunner, tcconverter, TCModules, tcoptimizations, tcsrcmap, - tcfiler, tcunitsearch, tcprecompile, TCGenerics; + Classes, consoletestrunner, tcconverter, TCModules, TCSrcMap, + TCFiler, TCUnitSearch, TCOptimizations, TCGenerics, TCPrecompile; type diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js index 5bea040c60..65595ed7b5 100644 --- a/utils/pas2js/dist/rtl.js +++ b/utils/pas2js/dist/rtl.js @@ -286,15 +286,14 @@ var rtl = { }, initClass: function(c,parent,name,initfn,rttiname){ - if (!rttiname) rttiname = name; parent[name] = c; c.$class = c; // Note: o.$class === Object.getPrototypeOf(o) - c.$classname = rttiname; + c.$classname = rttiname?rttiname:name; parent = rtl.initStruct(c,parent,name); c.$fullname = parent.$name+'.'+name; // rtti if (rtl.debug_rtti) rtl.debug('initClass '+c.$fullname); - var t = c.$module.$rtti.$Class(rttiname,{ "class": c }); + var t = c.$module.$rtti.$Class(c.$classname,{ "class": c }); c.$rtti = t; if (rtl.isObject(c.$ancestor)) t.ancestor = c.$ancestor.$rtti; if (!t.ancestor) t.ancestor = null; @@ -402,7 +401,7 @@ var rtl = { } }, - createHelper: function(parent,name,ancestor,initfn){ + createHelper: function(parent,name,ancestor,initfn,rttiname){ // create a helper, // ancestor must be null or a helper, var c = null; @@ -415,11 +414,11 @@ var rtl = { }; parent[name] = c; c.$class = c; // Note: o.$class === Object.getPrototypeOf(o) - c.$classname = name; + c.$classname = rttiname?rttiname:name; parent = rtl.initStruct(c,parent,name); c.$fullname = parent.$name+'.'+name; // rtti - var t = c.$module.$rtti.$Helper(c.$name,{ "helper": c }); + var t = c.$module.$rtti.$Helper(c.$classname,{ "helper": c }); c.$rtti = t; if (rtl.isObject(ancestor)) t.ancestor = ancestor.$rtti; if (!t.ancestor) t.ancestor = null;