paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-20 14:19:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

pastojs: fixed typeinfo path of inline specialize type

Browse Source
This commit is contained in:
mattias 2020-11-28 11:43:03 +00:00
parent 5236a86500
commit dab747c65d
2 changed files with 65 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -19465,6 +19465,8 @@ var
Bracket: TJSBracketMemberExpression; Bracket: TJSBracketMemberExpression;
begin begin
El:=ResolveSimpleAliasType(El); El:=ResolveSimpleAliasType(El);
if El is TPasSpecializeType then
El:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
aName:=GetTypeInfoName(El,AContext,ErrorEl); aName:=GetTypeInfoName(El,AContext,ErrorEl);
if aName=GetBIName(pbivnRTTILocal) then if aName=GetBIName(pbivnRTTILocal) then
Result:=CreatePrimitiveDotExpr(aName,El) Result:=CreatePrimitiveDotExpr(aName,El)

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

@ -843,6 +843,7 @@ type
Procedure TestRTTI_Interface_COM; Procedure TestRTTI_Interface_COM;
Procedure TestRTTI_ClassHelper; Procedure TestRTTI_ClassHelper;
Procedure TestRTTI_ExternalClass; Procedure TestRTTI_ExternalClass;
Procedure TestRTTI_Unit;
// Resourcestring // Resourcestring
Procedure TestResourcestringProgram; Procedure TestResourcestringProgram;
@ -30675,7 +30676,7 @@ begin
Add('{$modeswitch externalclass}'); Add('{$modeswitch externalclass}');
Add('type'); Add('type');
Add(' TRec = record end;'); Add(' TRec = record end;');
// ToDo: ^PRec // ToDo: ^TRec
Add(' TObject = class end;'); Add(' TObject = class end;');
Add(' TClass = class of tobject;'); Add(' TClass = class of tobject;');
Add('var'); Add('var');
@ -30685,7 +30686,7 @@ begin
Add(' tiClass: ttypeinfoclass;'); Add(' tiClass: ttypeinfoclass;');
Add(' aClass: tclass;'); Add(' aClass: tclass;');
Add(' tiClassRef: ttypeinfoclassref;'); Add(' tiClassRef: ttypeinfoclassref;');
// ToDo: ^PRec // ToDo: ^TRec
Add(' tiPointer: ttypeinfopointer;'); Add(' tiPointer: ttypeinfopointer;');
Add('begin'); Add('begin');
Add(' tirecord:=typeinfo(trec);'); Add(' tirecord:=typeinfo(trec);');
@ -31104,6 +31105,66 @@ begin
''])); '']));
end; end;
procedure TTestModule.TestRTTI_Unit;
begin
WithTypeInfo:=true;
AddModuleWithIntfImplSrc('unit2.pas',
LinesToStr([
'{$mode delphi}',
'type',
' TWordArray = array of word;',
' TArray<T> = array of T;',
'']),
'');
StartUnit(true,[supTypeInfo,supTInterfacedObject]);
Add([
'{$mode delphi}',
'interface',
'uses unit2;',
'type',
' IBird = interface',
' function Swoop: TWordArray;',
' function Glide: TArray<word>;',
' end;',
'procedure Fly;',
'implementation',
'procedure Fly;',
'var',
' ta: tTypeInfoDynArray;',
' ti: tTypeInfoInterface;',
'begin',
' ta:=typeinfo(TWordArray);',
' ta:=typeinfo(TArray<word>);',
' ti:=typeinfo(IBird);',
'end;',
'']);
ConvertUnit;
CheckSource('TestRTTI_ExternalClass',
LinesToStr([ // statements
'rtl.createInterface(',
' this,',
' "IBird",',
' "{3B98AAAC-6116-3E17-AA85-F16786D85B09}",',
' ["Swoop", "Glide"],',
' pas.system.IUnknown,',
' function () {',
' var $r = this.$rtti;',
' $r.addMethod("Swoop", 1, null, pas.unit2.$rtti["TWordArray"]);',
' $r.addMethod("Glide", 1, null, pas.unit2.$rtti["TArray<System.Word>"]);',
' }',
');',
'this.Fly = function () {',
' var ta = null;',
' var ti = null;',
' ta = pas.unit2.$rtti["TWordArray"];',
' ta = pas.unit2.$rtti["TArray<System.Word>"];',
' ti = $mod.$rtti["IBird"];',
'};',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestModule.TestResourcestringProgram; procedure TTestModule.TestResourcestringProgram;
begin begin
AddModuleWithIntfImplSrc('unit2.pas', AddModuleWithIntfImplSrc('unit2.pas',