pastojs: typeinfo(GenTemplateType)

git-svn-id: trunk@43223 -

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -144,6 +144,7 @@ type
     procedure TestGenProc_TypeParamCntOverloadNoParams;
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
     // ToDo: NestedResultAssign
+    procedure TestGenProc_OverloadsOtherUnit;
 
     // generic function infer types
     procedure TestGenProc_Infer_NeedExplicitFail;
@@ -2147,6 +2148,30 @@ begin
   CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
 end;
 
+procedure TTestResolveGenerics.TestGenProc_OverloadsOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('ns1.unit2.pp',
+    LinesToStr([
+    'var i2: longint;']),
+    LinesToStr([
+    '']));
+
+  AddModuleWithIntfImplSrc('ns1.unit1.pp',
+    LinesToStr([
+    'uses unit2;',
+    'var j1: longint;']),
+    LinesToStr([
+    '']));
+
+  StartProgram(true);
+  Add([
+  'uses unit1;',
+  'begin',
+  '  if j1=0 then ;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
 begin
   StartProgram(false);

packages/pastojs/src/fppas2js.pp

@@ -4853,6 +4853,9 @@ var
   TypeEl: TPasType;
   FoundClass: TPasClassType;
   ScopeDepth: Integer;
+  TemplType: TPasGenericTemplateType;
+  ConEl: TPasElement;
+  ConToken: TToken;
 begin
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
@@ -4932,7 +4935,32 @@ begin
         TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
       end
     else if C=TPasPointerType then
-      TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
+      TIName:=Pas2JSBuiltInNames[pbitnTIPointer]
+    else if C=TPasGenericTemplateType then
+      begin
+      TemplType:=TPasGenericTemplateType(TypeEl);
+      if length(TemplType.Constraints)>0 then
+        begin
+        ConEl:=TemplType.Constraints[0];
+        ConToken:=GetGenericConstraintKeyword(ConEl);
+        case ConToken of
+        tkrecord: TIName:=Pas2JSBuiltInNames[pbitnTIRecord];
+        tkclass,tkConstructor: TIName:=Pas2JSBuiltInNames[pbitnTIClass];
+        else
+          if not (ConEl is TPasType) then
+            RaiseNotYetImplemented(20191018180031,ConEl,GetObjPath(Param));
+          if ConEl is TPasClassType then
+            TIName:=Pas2JSBuiltInNames[pbitnTIClass]
+          else
+            RaiseNotYetImplemented(20191018180131,ConEl,GetObjPath(Param));
+        end;
+        end;
+      if TIName='' then
+        begin
+        // generic template without constraints
+        TIName:=Pas2JSBuiltInNames[pbitnTI];
+        end;
+      end;
     end
   else if ParamResolved.BaseType=btSet then
     begin
@@ -4961,7 +4989,7 @@ begin
     else if ParamResolved.BaseType in [btChar,btBoolean] then
       TIName:=Pas2JSBuiltInNames[pbitnTI]
     end;
-  //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
+  //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName,' ',GetObjName(TypeEl));
   if TIName='' then
     begin
     {$IFDEF VerbosePas2JS}

packages/pastojs/tests/tcgenerics.pas

@@ -52,6 +52,7 @@ type
     procedure TestGenProc_Overload;
     procedure TestGenProc_Forward;
     procedure TestGenProc_Infer_OverloadForward;
+    procedure TestGenProc_TypeInfo;
     // ToDo: FuncName:=
 
     // generic methods
@@ -1024,6 +1025,49 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGenProc_TypeInfo;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  '{$modeswitch implicitfunctionspecialization}',
+  'type',
+  '  TTypeInfo = class external name ''rtl.tTypeInfo''',
+  '  end;',
+  '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
+  '  end;',
+  'generic procedure Run<S>(a: S);',
+  'var',
+  '  p: TTypeInfo;',
+  'begin',
+  '  p:=TypeInfo(S);',
+  '  p:=TypeInfo(a);',
+  'end;',
+  'begin',
+  '  Run(word(3));',
+  '  Run(''foo'');',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_TypeInfo',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a) {',
+    '  var p = null;',
+    '  p = rtl.word;',
+    '  p = rtl.word;',
+    '};',
+    'this.Run$s1 = function (a) {',
+    '  var p = null;',
+    '  p = rtl.string;',
+    '  p = rtl.string;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Run$s0(3);',
+    '$mod.Run$s1("foo");',
+    '']));
+end;
+
 procedure TTestGenerics.TestGenMethod_ObjFPC;
 begin
   StartProgram(false);