paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-06 02:27:48 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed record member type

Browse Source
This commit is contained in:
mattias 2020-12-11 20:04:43 +00:00
parent 91e7558f0f
commit 6050bfe6e4
3 changed files with 42 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/packages/pastojs/src/fppas2js.pp
View File

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

38
compiler/packages/pastojs/tests/tcmodules.pas
View File

@ -831,6 +831,7 @@ type
Procedure TestRTTI_ClassOf;
Procedure TestRTTI_Record;
Procedure TestRTTI_RecordAnonymousArray;
Procedure TestRTTI_Record_ClassVarType;
Procedure TestRTTI_LocalTypes;
Procedure TestRTTI_TypeInfo_BaseTypes;
Procedure TestRTTI_TypeInfo_Type_BaseTypes;
@ -12159,7 +12160,7 @@ begin
' };',
'});',
'rtl.recNewT(this, "TPoint", function () {',
' rtl.createClass(this, "TBird", this.TObject, function () {',
' rtl.createClass(this, "TBird", $mod.TObject, function () {',
' this.DoIt = function () {',
' this.DoIt();',
' this.DoIt();',
@ -30345,6 +30346,41 @@ begin
'']));
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;
begin
WithTypeInfo:=true;

2
compiler/packages/pastojs/tests/tcoptimizations.pas
View File

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