paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-06 07:07:54 +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;
begin
El:=ResolveSimpleAliasType(El);
if El is TPasSpecializeType then
El:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
aName:=GetTypeInfoName(El,AContext,ErrorEl);
if aName=GetBIName(pbivnRTTILocal) then
Result:=CreatePrimitiveDotExpr(aName,El)

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

@ -843,6 +843,7 @@ type
Procedure TestRTTI_Interface_COM;
Procedure TestRTTI_ClassHelper;
Procedure TestRTTI_ExternalClass;
Procedure TestRTTI_Unit;
// Resourcestring
Procedure TestResourcestringProgram;
@ -30675,7 +30676,7 @@ begin
Add('{$modeswitch externalclass}');
Add('type');
Add(' TRec = record end;');
// ToDo: ^PRec
// ToDo: ^TRec
Add(' TObject = class end;');
Add(' TClass = class of tobject;');
Add('var');
@ -30685,7 +30686,7 @@ begin
Add(' tiClass: ttypeinfoclass;');
Add(' aClass: tclass;');
Add(' tiClassRef: ttypeinfoclassref;');
// ToDo: ^PRec
// ToDo: ^TRec
Add(' tiPointer: ttypeinfopointer;');
Add('begin');
Add(' tirecord:=typeinfo(trec);');
@ -31104,6 +31105,66 @@ begin
'']));
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;
begin
AddModuleWithIntfImplSrc('unit2.pas',