Browse Source

pastojs: fixed a.call(typeinfo())

git-svn-id: trunk@38720 -
Mattias Gaertner 7 years ago
parent
commit
c17f030e34

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

@@ -3204,6 +3204,7 @@ var
   jbt: TPas2jsBaseType;
   jbt: TPas2jsBaseType;
   TypeEl: TPasType;
   TypeEl: TPasType;
   FoundClass: TPasClassType;
   FoundClass: TPasClassType;
+  ScopeDepth: Integer;
 begin
 begin
   Param:=Params.Params[0];
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
   ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
@@ -3302,6 +3303,7 @@ begin
         TIName:=Pas2JSBuiltInNames[pbitnTIEnum];
         TIName:=Pas2JSBuiltInNames[pbitnTIEnum];
       end;
       end;
     end;
     end;
+  //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
   if TIName='' then
   if TIName='' then
     begin
     begin
     {$IFDEF VerbosePas2JS}
     {$IFDEF VerbosePas2JS}
@@ -3311,10 +3313,12 @@ begin
     end;
     end;
 
 
   // search for TIName
   // search for TIName
+  ResetSubScopes(ScopeDepth);
   FindData:=Default(TPRFindData);
   FindData:=Default(TPRFindData);
   FindData.ErrorPosEl:=Params;
   FindData.ErrorPosEl:=Params;
   Abort:=false;
   Abort:=false;
   IterateElements(TIName,@OnFindFirstElement,@FindData,Abort);
   IterateElements(TIName,@OnFindFirstElement,@FindData,Abort);
+  RestoreSubScopes(ScopeDepth);
   {$IFDEF VerbosePas2JS}
   {$IFDEF VerbosePas2JS}
   writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName="',TIName,'" FindData.Found="',GetObjName(FindData.Found),'"');
   writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName="',TIName,'" FindData.Found="',GetObjName(FindData.Found),'"');
   {$ENDIF}
   {$ENDIF}

+ 9 - 0
packages/pastojs/tests/tcmodules.pas

@@ -18392,6 +18392,7 @@ begin
   'begin',
   'begin',
   '  t:=TypeInfo(Self);',
   '  t:=TypeInfo(Self);',
   '  t:=TypeInfo(Result);',
   '  t:=TypeInfo(Result);',
+  '  t:=TypeInfo(TObject);',
   'end;',
   'end;',
   'class function TObject.ClassType: TClass;',
   'class function TObject.ClassType: TClass;',
   'var t: TTypeInfoClass;',
   'var t: TTypeInfoClass;',
@@ -18424,6 +18425,7 @@ begin
     '    var t = null;',
     '    var t = null;',
     '    t = this.$rtti;',
     '    t = this.$rtti;',
     '    t = Result.$rtti;',
     '    t = Result.$rtti;',
+    '    t = $mod.$rtti["TObject"];',
     '    return Result;',
     '    return Result;',
     '  };',
     '  };',
     '  this.ClassType = function () {',
     '  this.ClassType = function () {',
@@ -18461,12 +18463,15 @@ begin
   '  end;',
   '  end;',
   '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
   '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
   '  TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
   '  TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
+  'procedure DoIt(t: TTypeInfoInterface); begin end;',
   'var',
   'var',
   '  i: IBird;',
   '  i: IBird;',
   '  t: TTypeInfoInterface;',
   '  t: TTypeInfoInterface;',
   'begin',
   'begin',
   '  t:=TypeInfo(IBird);',
   '  t:=TypeInfo(IBird);',
   '  t:=TypeInfo(i);',
   '  t:=TypeInfo(i);',
+  '  DoIt(t);',
+  '  DoIt(TypeInfo(IBird));',
   '']);
   '']);
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestRTTI_Interface_Corba',
   CheckSource('TestRTTI_Interface_Corba',
@@ -18493,12 +18498,16 @@ begin
     '    $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
     '    $r.addProperty("Item", 3, rtl.longint, "GetItem", "SetItem");',
     '  }',
     '  }',
     ');',
     ');',
+    'this.DoIt = function (t) {',
+    '};    ',
     'this.i = null;',
     'this.i = null;',
     'this.t = null;',
     'this.t = null;',
     '']),
     '']),
     LinesToStr([ // $mod.$main
     LinesToStr([ // $mod.$main
     '$mod.t = $mod.$rtti["IBird"];',
     '$mod.t = $mod.$rtti["IBird"];',
     '$mod.t = $mod.i.$rtti;',
     '$mod.t = $mod.i.$rtti;',
+    '$mod.DoIt($mod.t);',
+    '$mod.DoIt($mod.$rtti["IBird"]);',
     '']));
     '']));
 end;
 end;
 
 

+ 2 - 0
packages/pastojs/tests/tcprecompile.pas

@@ -385,6 +385,8 @@ begin
 end;
 end;
 
 
 Initialization
 Initialization
+  {$IFDEF EnablePas2jsPrecompiled}
   RegisterTests([TTestCLI_Precompile]);
   RegisterTests([TTestCLI_Precompile]);
+  {$ENDIF}
 end.
 end.