Parcourir la source

pastojs: fixed typeinfo path of inline specialize type

git-svn-id: trunk@47614 -
Mattias Gaertner il y a 4 ans
Parent
commit
3808d9c7b6
2 fichiers modifiés avec 65 ajouts et 2 suppressions
  1. 2 0
      packages/pastojs/src/fppas2js.pp
  2. 63 2
      packages/pastojs/tests/tcmodules.pas

+ 2 - 0
packages/pastojs/src/fppas2js.pp

@@ -19467,6 +19467,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)

+ 63 - 2
packages/pastojs/tests/tcmodules.pas

@@ -843,6 +843,7 @@ type
     Procedure TestRTTI_Interface_COM;
     Procedure TestRTTI_ClassHelper;
     Procedure TestRTTI_ExternalClass;
+    Procedure TestRTTI_Unit;
 
     // Resourcestring
     Procedure TestResourcestringProgram;
@@ -30681,7 +30682,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');
@@ -30691,7 +30692,7 @@ begin
   Add('  tiClass: ttypeinfoclass;');
   Add('  aClass: tclass;');
   Add('  tiClassRef: ttypeinfoclassref;');
-  // ToDo: ^PRec
+  // ToDo: ^TRec
   Add('  tiPointer: ttypeinfopointer;');
   Add('begin');
   Add('  tirecord:=typeinfo(trec);');
@@ -31110,6 +31111,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',