pas2js: typeinfo(specialization)

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@44220 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 87 insertions, 7 deletions

diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas
index 15fab81629..1d529bec23 100644
--- a/packages/fcl-passrc/src/pasuseanalyzer.pas
+++ b/packages/fcl-passrc/src/pasuseanalyzer.pas
@@ -1173,12 +1173,13 @@ var
   C: TClass;
   Members, Args: TFPList;
   i: Integer;
-  Member: TPasElement;
+  Member, Param: TPasElement;
   MemberResolved: TPasResolverResult;
   Prop: TPasProperty;
   ProcType: TPasProcedureType;
   ClassEl: TPasClassType;
   ArrType: TPasArrayType;
+  SpecType: TPasSpecializeType;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
@@ -1270,7 +1271,18 @@ begin
       UseSubEl(TPasFunctionType(El).ResultEl.ResultType);
     end
   else if C=TPasSpecializeType then
-    UseSubEl(TPasSpecializeType(El).DestType)
+    begin
+    SpecType:=TPasSpecializeType(El);
+    // SpecType.DestType is the generic type, which is never used
+    if SpecType.CustomData is TPasSpecializeTypeData then
+      UseSubEl(TPasSpecializeTypeData(El.CustomData).SpecializedType);
+    for i:=0 to SpecType.Params.Count-1 do
+      begin
+      Param:=TPasElement(SpecType.Params[i]);
+      if Param is TPasGenericTemplateType then continue;
+      UseSubEl(Param);
+      end;
+    end
   else if C=TPasGenericTemplateType then
     begin
     if ScopeModule=nil then
@@ -2385,7 +2397,7 @@ var
   i: Integer;
 begin
   if not MarkElementAsUsed(El) then exit;
-  // El.DestType is TPasGenericType, which is never be used
+  // El.DestType is the generic type, which is never used
   if El.CustomData is TPasSpecializeTypeData then
     UseElType(El,TPasSpecializeTypeData(El.CustomData).SpecializedType,Mode);
   for i:=0 to El.Params.Count-1 do
@@ -2690,7 +2702,7 @@ begin
         begin
         // declaration was never used
         if IsSpecializedGenericType(Decl) then
-          continue;
+          continue; // no hints for not used specializations
         EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
           sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
         end;
@@ -2726,7 +2738,7 @@ begin
           begin
           SpecEl:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
           if FindElement(SpecEl)<>nil then
-            exit; // a specialization of this generic type is used
+            exit; // a specialization of this generic type is used -> the generic is used
           end;
       end;
 
@@ -2832,7 +2844,7 @@ begin
     ImplProc:=ProcScope.ImplProc;
   if (ProcScope.ClassRecScope<>nil)
       and (ProcScope.ClassRecScope.SpecializedFromItem<>nil) then
-    exit; // specialized proc
+    exit; // no hints for not used specializations
 
   if not PAElementExists(DeclProc) then
     begin
diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas
index be514310fe..59dd40c03a 100644
--- a/packages/fcl-passrc/tests/tcuseanalyzer.pas
+++ b/packages/fcl-passrc/tests/tcuseanalyzer.pas
@@ -159,6 +159,7 @@ type
     procedure TestWP_TypeInfo;
     procedure TestWP_TypeInfo_PropertyEnumType;
     procedure TestWP_TypeInfo_Alias;
+    procedure TestWP_TypeInfo_Specialize;
     procedure TestWP_ForInClass;
     procedure TestWP_AssertSysUtils;
     procedure TestWP_RangeErrorSysUtils;
@@ -2825,6 +2826,30 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_TypeInfo_Specialize;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TProc<T> = procedure(a: T) of object;',
+  '  TWordProc = specialize TProc<word>;',
+  '  {$M+}',
+  '  TPersistent = class',
+  '  private',
+  '    FWordProc: TWordProc;',
+  '  published',
+  '    property Proc: TWordProc read FWordProc write FWordProc;',
+  '  end;',
+  '  {$M-}',
+  'var',
+  '  {#p_notypeinfo}p: pointer;',
+  'begin',
+  '  p:=typeinfo(TPersistent);',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestWP_ForInClass;
 begin
   StartProgram(false);
diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp
index d9f646071e..d8410b96c7 100644
--- a/packages/pastojs/src/fppas2js.pp
+++ b/packages/pastojs/src/fppas2js.pp
@@ -23879,6 +23879,16 @@ begin
   El:=ResolveSimpleAliasType(El);
   if El=nil then
     RaiseInconsistency(20170409172756,El);
+  C:=El.ClassType;
+
+  if C=TPasSpecializeType then
+    begin
+    if not (El.CustomData is TPasSpecializeTypeData) then
+      RaiseInconsistency(20200220113319,El);
+    El:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
+    C:=El.ClassType;
+    end;
+
   if (El=AContext.PasElement) and not Full then
     begin
     // referring to itself
@@ -23891,7 +23901,6 @@ begin
     else
       RaiseNotSupported(ErrorEl,AContext,20170905150746,'cannot typeinfo itself');
     end;
-  C:=El.ClassType;
   if C=TPasUnresolvedSymbolRef then
     begin
     if El.Name='' then
diff --git a/packages/pastojs/tests/tcgenerics.pas b/packages/pastojs/tests/tcgenerics.pas
index 9a6aec2c8e..0b78e3db56 100644
--- a/packages/pastojs/tests/tcgenerics.pas
+++ b/packages/pastojs/tests/tcgenerics.pas
@@ -41,6 +41,7 @@ type
     procedure TestGen_ExtClass_Array;
     procedure TestGen_ExtClass_GenJSValueAssign;
     procedure TestGen_ExtClass_AliasMemberType;
+    Procedure TestGen_ExtClass_RTTI;
 
     // statements
     Procedure TestGen_InlineSpec_Constructor;
@@ -844,6 +845,39 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ExtClass_RTTI;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  generic TGJSSET<T> = class external name ''SET''',
+  '    A: T;',
+  '  end;',
+  '  TJSSet = specialize TGJSSET<JSValue>;',
+  '  TJSSetEventProc = reference to procedure(value : JSValue; key: NativeInt; set_: TJSSet);',
+  'var p: Pointer;',
+  'begin',
+  '  p:=typeinfo(TJSSetEventProc);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ExtClass_RTTI',
+    LinesToStr([ // statements
+    '$mod.$rtti.$ExtClass("TGJSSET$G1", {',
+    '  jsclass: "SET"',
+    '});',
+    '$mod.$rtti.$RefToProcVar("TJSSetEventProc", {',
+    '  procsig: rtl.newTIProcSig([["value", rtl.jsvalue], ["key", rtl.nativeint], ["set_", $mod.$rtti["TGJSSET$G1"]]])',
+    '});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TJSSetEventProc"];',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_InlineSpec_Constructor;
 begin
   StartProgram(false);