pastojs: filer: generic class

git-svn-id: trunk@43960 -

packages/fcl-passrc/src/pasresolver.pp

@@ -27915,7 +27915,8 @@ begin
   Templates:=GetProcTemplateTypes(Proc);
   if (Templates<>nil) and (Templates.Count>0) then
     exit(false);
-  if ProcScope.SpecializedFromItem=nil then exit(true);
+  if ProcScope.SpecializedFromItem=nil then
+    exit(true);
   Params:=ProcScope.SpecializedFromItem.Params;
   for i:=0 to length(Params)-1 do
     if Params[i] is TPasGenericTemplateType then exit(false);

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1079,6 +1079,7 @@ function TPasAnalyzer.CanSkipGenericProc(DeclProc: TPasProcedure): boolean;
 
 var
   Templates: TFPList;
+  Parent: TPasElement;
 begin
   Result:=false;
   if ScopeModule=nil then
@@ -1093,14 +1094,29 @@ begin
     Templates:=Resolver.GetProcTemplateTypes(DeclProc);
     if (Templates<>nil) and (Templates.Count>0) then
       begin
-      // generic template
+      // generic procedure
       if paoSkipGenericProc in Options then
-        exit(true); //
+        exit(true); // emit no hints for generic proc
       // -> analyze
       end
     else if not Resolver.IsFullySpecialized(DeclProc) then
       // half specialized -> skip
-      exit(true);
+      exit(true)
+    else if paoSkipGenericProc in Options then
+      begin
+      Parent:=DeclProc.Parent;
+      while Parent<>nil do
+        begin
+        if (Parent is TPasGenericType) then
+          begin
+          Templates:=TPasGenericType(Parent).GenericTemplateTypes;
+          if (Templates<>nil) and (Templates.Count>0) then
+            // procedure of a generic parent -> emit no hints
+            exit(true);
+          end;
+        Parent:=Parent.Parent;
+        end;
+      end;
     end;
 end;
 

packages/pastojs/src/pas2jsfiler.pp

@@ -3721,7 +3721,7 @@ begin
     Templ:=TPasGenericTemplateType(GenericTemplateTypes[i]);
     TemplObj:=TJSONObject.Create;
     Arr.Add(TemplObj);
-    TemplObj.Add('Name',Templ.Name);
+    WritePasElement(TemplObj,Templ,aContext);
     WriteElementArray(TemplObj,Parent,'Constraints',Templ.Constraints,aContext,true);
     end;
 end;
@@ -6300,7 +6300,7 @@ var
 begin
   if not ReadArray(Obj,'Declarations',Arr,Decls) then exit;
   {$IFDEF VerbosePCUFiler}
-  writeln('TPCUReader.ReadDeclarations ',GetObjName(Section),' ',Arr.Count);
+  writeln('TPCUReader.ReadDeclarations ',GetObjName(Decls),' ',Arr.Count);
   {$ENDIF}
   for i:=0 to Arr.Count-1 do
     begin
@@ -7551,6 +7551,7 @@ begin
       RaiseMsg(20190720224130,Parent,IntToStr(i));
     GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,Parent));
     GenericTemplateTypes.Add(GenType);
+    ReadPasElement(TemplObj,GenType,aContext);
     ReadElementArray(TemplObj,Parent,'Constraints',GenType.Constraints,
       {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
       aContext);

packages/pastojs/tests/tcfiler.pas

@@ -1171,10 +1171,20 @@ begin
   //writeln('TCustomTestPrecompile.CheckRestoredElement Checking Parent... Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
   CheckRestoredReference(Path+'.Parent',Orig.Parent,Rest.Parent);
 
+  C:=Orig.ClassType;
   //writeln('TCustomTestPrecompile.CheckRestoredElement Checking CustomData... Orig=',GetObjName(Orig),' Rest=',GetObjName(Rest));
-  CheckRestoredCustomData(Path+'.CustomData',Rest,Orig.CustomData,Rest.CustomData,Flags);
+  if C=TPasGenericTemplateType then
+    begin
+    // TPasGenericParamsScope is only needed during parsing
+    if Orig.CustomData=nil then
+    else if not (Orig.CustomData is TPasGenericParamsScope) then
+      Fail(Path+'Orig.CustomData='+GetObjName(Orig.CustomData))
+    else if Rest.CustomData<>nil then
+      CheckRestoredCustomData(Path+'.CustomData',Rest,Orig.CustomData,Rest.CustomData,Flags);
+    end
+  else
+    CheckRestoredCustomData(Path+'.CustomData',Rest,Orig.CustomData,Rest.CustomData,Flags);
 
-  C:=Orig.ClassType;
   if C=TUnaryExpr then
     CheckRestoredUnaryExpr(Path,TUnaryExpr(Orig),TUnaryExpr(Rest),Flags)
   else if C=TBinaryExpr then
@@ -2671,8 +2681,6 @@ end;
 
 procedure TTestPrecompile.TestPC_GenericClass;
 begin
-  exit;
-
   StartUnit(false);
   Add([
   'interface',
@@ -2681,10 +2689,10 @@ begin
   '  end;',
   '  generic TBird<T> = class',
   '    a: T;',
-  '    generic function Run<T>(a: T): T;',
+  '    function Run: T;',
   '  end;',
   'implementation',
-  'function TBird.Run<T>(a: T): T;',
+  'function TBird.Run: T;',
   'var b: T;',
   'begin',
   '  b:=a; Result:=b;',