Browse Source

pas2js: not storing specialized elements

git-svn-id: trunk@44219 -
Mattias Gaertner 5 years ago
parent
commit
b802ee6450

+ 185 - 174
packages/fcl-passrc/src/pasresolver.pp

@@ -1666,7 +1666,6 @@ type
     procedure FinishProcedureType(El: TPasProcedureType); virtual;
     procedure FinishMethodDeclHeader(Proc: TPasProcedure); virtual;
     procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
-    procedure FinishSpecializations(Scope: TPasGenericScope); virtual;
     procedure FinishExceptOnExpr; virtual;
     procedure FinishExceptOnStatement; virtual;
     procedure FinishWithDo(El: TPasImplWithDo); virtual;
@@ -1794,8 +1793,6 @@ type
       CheckConstraints: boolean);
     function CreateInferenceTypesForCall(Params: TParamsExpr;
       TargetProc: TPasProcedure): TFPList;
-    function GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
-      Params: TFPList): TPasElement;
     function CheckGenericConstraintFitsParam(ParamType: TPasType;
       SpecializedItem: TPRSpecializedItem; // set to specialize constraints
       TemplType: TPasGenericTemplateType; ConEl: TPasElement;
@@ -2323,6 +2320,10 @@ type
     function GetTypeParameterCount(aType: TPasGenericType): integer;
     function GetGenericConstraintKeyword(El: TPasElement): TToken;
     function GetGenericConstraintErrorEl(ConstraintEl, TemplType: TPasElement): TPasElement;
+    function GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
+      Params: TFPList): TPasElement; virtual;
+    procedure FinishSpecializedClassOrRecIntf(Scope: TPasGenericScope); virtual;
+    procedure FinishSpecializations(Scope: TPasGenericScope); virtual;
     function IsFullySpecialized(El: TPasGenericType): boolean; overload;
     function IsFullySpecialized(Proc: TPasProcedure): boolean; overload;
     function IsInterfaceType(const ResolvedEl: TPasResolverResult;
@@ -6102,9 +6103,10 @@ var
 begin
   if TopScope.Element<>El then
     RaiseNotYetImplemented(20190801232042,El);
-  Scope:=El.CustomData as TPasRecordScope;
-  Scope.GenericStep:=psgsInterfaceParsed;
   PopScope;
+
+  Scope:=El.CustomData as TPasRecordScope;
+  FinishSpecializedClassOrRecIntf(Scope);
 end;
 
 procedure TPasResolver.FinishClassType(El: TPasClassType);
@@ -6133,9 +6135,6 @@ var
   ProcName, IntfProcName: String;
   Expr: TPasExpr;
   SectionScope: TPasSectionScope;
-  SpecializedItems: TObjectList;
-  SpecializedItem: TPRSpecializedTypeItem;
-  OldScopeState: TScopeStashState;
 begin
   Resolutions:=nil;
   ClassScope:=nil;
@@ -6301,32 +6300,7 @@ begin
     PopGenericParamScope(El);
 
   if not El.IsForward then
-    begin
-    ClassScope.GenericStep:=psgsInterfaceParsed;
-    SpecializedItems:=ClassScope.SpecializedItems;
-    if SpecializedItems<>nil then
-      // finish interfaces of started specializations
-      for i:=0 to SpecializedItems.Count-1 do
-        begin
-        SpecializedItem:=TPRSpecializedTypeItem(SpecializedItems[i]);
-        SpecializedItem.GenericEl:=El;
-        if SpecializedItem.Step<>prssNone then continue;
-        InitSpecializeScopes(El,OldScopeState);
-        {$IFDEF VerbosePasResolver}
-        WriteScopesShort('TPasResolver.FinishClassType Finishing specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
-        {$ENDIF}
-        SpecializeGenericIntf(SpecializedItem);
-
-        {$IFDEF VerbosePasResolver}
-        WriteScopesShort('TPasResolver.FinishClassType Finished specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
-        {$ENDIF}
-
-        RestoreSpecializeScopes(OldScopeState);
-        {$IFDEF VerbosePasResolver}
-        WriteScopesShort('TPasResolver.FinishClassType RestoreStashedScopes '+GetObjName(SpecializedItem.SpecializedType));
-        {$ENDIF}
-        end;
-    end;
+    FinishSpecializedClassOrRecIntf(ClassScope);
 end;
 
 procedure TPasResolver.FinishClassOfType(El: TPasClassOfType);
@@ -7361,17 +7335,6 @@ begin
   {$ENDIF}
 end;
 
-procedure TPasResolver.FinishSpecializations(Scope: TPasGenericScope);
-var
-  SpecializedItems: TObjectList;
-  i: Integer;
-begin
-  SpecializedItems:=Scope.SpecializedItems;
-  if SpecializedItems=nil then exit;
-  for i:=0 to SpecializedItems.Count-1 do
-    SpecializeGenericImpl(TPRSpecializedItem(SpecializedItems[i]));
-end;
-
 procedure TPasResolver.FinishExceptOnExpr;
 var
   El: TPasImplExceptOn;
@@ -15840,135 +15803,6 @@ begin
   end;
 end;
 
-function TPasResolver.GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
-  Params: TFPList): TPasElement;
-var
-  Data: TPasSpecializeTypeData;
-  GenScope: TPasGenericScope;
-  GenericTemplateList: TFPList;
-  i, j: Integer;
-  Param: TPasElement;
-  ParamsResolved: TPasTypeArray;
-  ResolvedEl: TPasResolverResult;
-  SpecializedElList: TObjectList;
-  Item: TPRSpecializedItem;
-  SrcModule: TPasModule;
-  SrcModuleScope: TPasModuleScope;
-  SrcResolver: TPasResolver;
-  IsSelf: Boolean;
-  GenericType: TPasGenericType;
-  GenericProc: TPasProcedure;
-  ProcScope: TPasProcedureScope;
-begin
-  Result:=nil;
-  if El.CustomData<>nil then
-    RaiseNotYetImplemented(20190726142522,El);
-
-  // check if there is already such a specialization
-  GenScope:=nil;
-  GenericType:=nil;
-  GenericProc:=nil;
-  if GenericEl is TPasGenericType then
-    begin
-    GenericType:=TPasGenericType(GenericEl);
-    if not (GenericEl.CustomData is TPasGenericScope) then
-      RaiseMsg(20190726194316,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
-        [GetTypeDescription(GenericType)],El);
-    GenScope:=TPasGenericScope(GenericEl.CustomData);
-
-    if (not (GenericType is TPasClassType))
-        and (GenScope.GenericStep<psgsInterfaceParsed) then
-      RaiseMsg(20190807205038,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
-        [GetTypeDescription(GenericType)],El);
-    GenericTemplateList:=GenericType.GenericTemplateTypes;
-    end
-  else if GenericEl is TPasProcedure then
-    begin
-    GenericProc:=TPasProcedure(GenericEl);
-    if not (GenericProc.CustomData is TPasProcedureScope) then
-      RaiseMsg(20190919132733,nIdentifierNotFound,sIdentifierNotFound,
-        [GenericProc.Name],El);
-    ProcScope:=TPasProcedureScope(GenericProc.CustomData);
-    if ProcScope.DeclarationProc<>nil then
-      RaiseNotYetImplemented(20190920182602,El);
-    GenScope:=ProcScope;
-
-    if GenScope.GenericStep<psgsInterfaceParsed then
-      RaiseMsg(20190920120649,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
-        [GetElementDbgPath(GenericProc)],El);
-    GenericTemplateList:=GetProcTemplateTypes(GenericProc);
-    end
-  else
-    RaiseNotYetImplemented(20190919132603,GenericEl);
-
-  SpecializedElList:=GenScope.SpecializedItems;
-  if GenericTemplateList=nil then
-    RaiseMsg(20190905111703,nXExpectedButYFound,sXExpectedButYFound,
-      ['generic templates',GenericEl.Name],El);
-  if GenericTemplateList.Count<>Params.Count then
-    RaiseMsg(20190905111704,nXExpectedButYFound,sXExpectedButYFound,
-      ['type with '+IntToStr(Params.Count)+' generic template(s)',
-       GenericEl.Name+GetGenericParamCommas(GenericTemplateList.Count)],El);
-
-  SetLength(ParamsResolved,Params.Count);
-  IsSelf:=true;
-  for i:=0 to Params.Count-1 do
-    begin
-    Param:=TPasElement(Params[i]);
-    ComputeElement(Param,ResolvedEl,[rcType]);
-    ParamsResolved[i]:=ResolvedEl.LoTypeEl;
-    if ResolvedEl.LoTypeEl<>TPasType(GenericTemplateList[i]) then
-      IsSelf:=false;
-    end;
-  if IsSelf then
-    exit(GenericEl);
-
-  if SpecializedElList=nil then
-    begin
-    SpecializedElList:=TObjectList.Create(true);
-    if GenScope<>nil then
-      GenScope.SpecializedItems:=SpecializedElList
-    else
-      RaiseNotYetImplemented(20190919133159,El);
-    end;
-  i:=SpecializedElList.Count-1;
-  Item:=nil;
-  while i>=0 do
-    begin
-    Item:=TPRSpecializedItem(SpecializedElList[i]);
-    j:=length(Item.Params)-1;
-    while j>=0 do
-      begin
-      if not IsSameType(Item.Params[j],ParamsResolved[j],prraNone)
-          and (CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone)>cExact) then
-        break;
-      dec(j);
-      end;
-    if j<0 then
-      break;
-    Item:=nil;
-    dec(i);
-    end;
-  if Item=nil then
-    begin
-    // new specialization
-    SrcModule:=GenericEl.GetModule;
-    SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
-    SrcResolver:=SrcModuleScope.Owner as TPasResolver;
-    Item:=SrcResolver.CreateSpecializedItem(El,GenericEl,ParamsResolved)
-    end;
-
-  Result:=Item.SpecializedEl;
-
-  if El.ClassType=TPasSpecializeType then
-    begin
-    Data:=TPasSpecializeTypeData.Create;
-    // add to free list
-    AddResolveData(El,Data,lkModule);
-    Data.SpecializedType:=Result as TPasGenericType;
-    end;
-end;
-
 function TPasResolver.CheckGenericConstraintFitsParam(ParamType: TPasType;
   SpecializedItem: TPRSpecializedItem; TemplType: TPasGenericTemplateType;
   ConEl: TPasElement; Operation: TPRTemplateCompOp; ErrorPos: TPasElement
@@ -28088,6 +27922,183 @@ begin
     Result:=TemplType;
 end;
 
+function TPasResolver.GetSpecializedEl(El: TPasElement; GenericEl: TPasElement;
+  Params: TFPList): TPasElement;
+var
+  Data: TPasSpecializeTypeData;
+  GenScope: TPasGenericScope;
+  GenericTemplateList: TFPList;
+  i, j: Integer;
+  Param: TPasElement;
+  ParamsResolved: TPasTypeArray;
+  ResolvedEl: TPasResolverResult;
+  SpecializedElList: TObjectList;
+  Item: TPRSpecializedItem;
+  SrcModule: TPasModule;
+  SrcModuleScope: TPasModuleScope;
+  SrcResolver: TPasResolver;
+  IsSelf: Boolean;
+  GenericType: TPasGenericType;
+  GenericProc: TPasProcedure;
+  ProcScope: TPasProcedureScope;
+begin
+  Result:=nil;
+  if El.CustomData<>nil then
+    RaiseNotYetImplemented(20190726142522,El);
+
+  // check if there is already such a specialization
+  GenScope:=nil;
+  GenericType:=nil;
+  GenericProc:=nil;
+  if GenericEl is TPasGenericType then
+    begin
+    GenericType:=TPasGenericType(GenericEl);
+    if not (GenericEl.CustomData is TPasGenericScope) then
+      RaiseMsg(20190726194316,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
+        [GetTypeDescription(GenericType)],El);
+    GenScope:=TPasGenericScope(GenericEl.CustomData);
+
+    if (not (GenericType is TPasClassType))
+        and (GenScope.GenericStep<psgsInterfaceParsed) then
+      RaiseMsg(20190807205038,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
+        [GetTypeDescription(GenericType)],El);
+    GenericTemplateList:=GenericType.GenericTemplateTypes;
+    end
+  else if GenericEl is TPasProcedure then
+    begin
+    GenericProc:=TPasProcedure(GenericEl);
+    if not (GenericProc.CustomData is TPasProcedureScope) then
+      RaiseMsg(20190919132733,nIdentifierNotFound,sIdentifierNotFound,
+        [GenericProc.Name],El);
+    ProcScope:=TPasProcedureScope(GenericProc.CustomData);
+    if ProcScope.DeclarationProc<>nil then
+      RaiseNotYetImplemented(20190920182602,El);
+    GenScope:=ProcScope;
+
+    if GenScope.GenericStep<psgsInterfaceParsed then
+      RaiseMsg(20190920120649,nTypeXIsNotYetCompletelyDefined,sTypeXIsNotYetCompletelyDefined,
+        [GetElementDbgPath(GenericProc)],El);
+    GenericTemplateList:=GetProcTemplateTypes(GenericProc);
+    end
+  else
+    RaiseNotYetImplemented(20190919132603,GenericEl);
+
+  SpecializedElList:=GenScope.SpecializedItems;
+  if GenericTemplateList=nil then
+    RaiseMsg(20190905111703,nXExpectedButYFound,sXExpectedButYFound,
+      ['generic templates',GenericEl.Name],El);
+  if GenericTemplateList.Count<>Params.Count then
+    RaiseMsg(20190905111704,nXExpectedButYFound,sXExpectedButYFound,
+      ['type with '+IntToStr(Params.Count)+' generic template(s)',
+       GenericEl.Name+GetGenericParamCommas(GenericTemplateList.Count)],El);
+
+  SetLength(ParamsResolved,Params.Count);
+  IsSelf:=true;
+  for i:=0 to Params.Count-1 do
+    begin
+    Param:=TPasElement(Params[i]);
+    ComputeElement(Param,ResolvedEl,[rcType]);
+    ParamsResolved[i]:=ResolvedEl.LoTypeEl;
+    if ResolvedEl.LoTypeEl<>TPasType(GenericTemplateList[i]) then
+      IsSelf:=false;
+    end;
+  if IsSelf then
+    exit(GenericEl);
+
+  if SpecializedElList=nil then
+    begin
+    SpecializedElList:=TObjectList.Create(true);
+    if GenScope<>nil then
+      GenScope.SpecializedItems:=SpecializedElList
+    else
+      RaiseNotYetImplemented(20190919133159,El);
+    end;
+  i:=SpecializedElList.Count-1;
+  Item:=nil;
+  while i>=0 do
+    begin
+    Item:=TPRSpecializedItem(SpecializedElList[i]);
+    j:=length(Item.Params)-1;
+    while j>=0 do
+      begin
+      if not IsSameType(Item.Params[j],ParamsResolved[j],prraNone)
+          and (CheckElTypeCompatibility(Item.Params[j],ParamsResolved[j],prraNone)>cExact) then
+        break;
+      dec(j);
+      end;
+    if j<0 then
+      break;
+    Item:=nil;
+    dec(i);
+    end;
+  if Item=nil then
+    begin
+    // new specialization
+    SrcModule:=GenericEl.GetModule;
+    SrcModuleScope:=SrcModule.CustomData as TPasModuleScope;
+    SrcResolver:=SrcModuleScope.Owner as TPasResolver;
+    Item:=SrcResolver.CreateSpecializedItem(El,GenericEl,ParamsResolved)
+    end;
+
+  Result:=Item.SpecializedEl;
+
+  if El.ClassType=TPasSpecializeType then
+    begin
+    Data:=TPasSpecializeTypeData.Create;
+    // add to free list
+    AddResolveData(El,Data,lkModule);
+    Data.SpecializedType:=Result as TPasGenericType;
+    end;
+end;
+
+procedure TPasResolver.FinishSpecializedClassOrRecIntf(Scope: TPasGenericScope);
+var
+  El: TPasGenericType;
+  SpecializedItems: TObjectList;
+  i: Integer;
+  SpecializedItem: TPRSpecializedTypeItem;
+  OldScopeState: TScopeStashState;
+begin
+  El:=Scope.Element as TPasGenericType;
+  if Scope.GenericStep<>psgsNone then
+    RaiseNotYetImplemented(20200219124544,El);
+  Scope.GenericStep:=psgsInterfaceParsed;
+  SpecializedItems:=Scope.SpecializedItems;
+  if SpecializedItems<>nil then
+    // finish interfaces of started specializations
+    for i:=0 to SpecializedItems.Count-1 do
+      begin
+      SpecializedItem:=TPRSpecializedTypeItem(SpecializedItems[i]);
+      SpecializedItem.GenericEl:=El;
+      if SpecializedItem.Step<>prssNone then continue;
+      InitSpecializeScopes(El,OldScopeState);
+      {$IFDEF VerbosePasResolver}
+      WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf Finishing specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
+      {$ENDIF}
+      SpecializeGenericIntf(SpecializedItem);
+
+      {$IFDEF VerbosePasResolver}
+      WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf Finished specialize interface: '+GetObjName(SpecializedItem.SpecializedType));
+      {$ENDIF}
+
+      RestoreSpecializeScopes(OldScopeState);
+      {$IFDEF VerbosePasResolver}
+      WriteScopesShort('TPasResolver.FinishSpecializedClassOrRecIntf RestoreStashedScopes '+GetObjName(SpecializedItem.SpecializedType));
+      {$ENDIF}
+      end;
+end;
+
+procedure TPasResolver.FinishSpecializations(Scope: TPasGenericScope);
+var
+  SpecializedItems: TObjectList;
+  i: Integer;
+begin
+  SpecializedItems:=Scope.SpecializedItems;
+  if SpecializedItems=nil then exit;
+  for i:=0 to SpecializedItems.Count-1 do
+    SpecializeGenericImpl(TPRSpecializedItem(SpecializedItems[i]));
+end;
+
 function TPasResolver.IsFullySpecialized(El: TPasGenericType): boolean;
 var
   GenScope: TPasGenericScope;

+ 29 - 2
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -172,7 +172,8 @@ type
     procedure TestGenMethod_TemplNameDifferFail;
     procedure TestGenMethod_ImplConstraintFail;
     procedure TestGenMethod_NestedSelf;
-    procedure TestGenMethod_OverloadTypeParamCnt;
+    procedure TestGenMethod_OverloadTypeParamCntObjFPC;
+    procedure TestGenMethod_OverloadTypeParamCntDelphi;
     procedure TestGenMethod_OverloadArgs;
   end;
 
@@ -2628,7 +2629,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCnt;
+procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCntObjFPC;
 begin
   StartProgram(false);
   Add([
@@ -2653,6 +2654,32 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCntDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class',
+  '    procedure {#A}Run<T>(a: T); overload;',
+  '    procedure {#B}Run<M,N>(a: M); overload;',
+  '  end;',
+  'procedure TObject.Run<T>(a: T);',
+  'begin',
+  'end;',
+  'procedure TObject.Run<M,N>(a: M);',
+  'begin',
+  '  {@A}Run<M>(a);',
+  '  {@B}Run<double,char>(1.3);',
+  'end;',
+  'var obj: TObject;',
+  'begin',
+  '  obj.{@A}Run<word>(3);',
+  '  obj.{@B}Run<word,char>(4);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenMethod_OverloadArgs;
 begin
   StartProgram(false);

+ 53 - 3
packages/pastojs/src/pas2jsfiler.pp

@@ -3265,6 +3265,13 @@ end;
 
 procedure TPCUWriter.WriteElement(Obj: TJSONObject;
   El: TPasElement; aContext: TPCUWriterContext);
+
+  function IsSpecialized(GenEl: TPasGenericType): boolean;
+  begin
+    Result:=(GenEl.CustomData is TPasGenericScope)
+        and (TPasGenericScope(GenEl.CustomData).SpecializedFromItem<>nil);
+  end;
+
 var
   C: TClass;
   Kind: TPasExprKind;
@@ -3384,6 +3391,7 @@ begin
     end
   else if C=TPasArrayType then
     begin
+    if IsSpecialized(TPasGenericType(El)) then exit;
     Obj.Add('Type','ArrType');
     WriteArrayType(Obj,TPasArrayType(El),aContext);
     end
@@ -3414,11 +3422,13 @@ begin
     end
   else if C=TPasRecordType then
     begin
+    if IsSpecialized(TPasGenericType(El)) then exit;
     Obj.Add('Type','Record');
     WriteRecordType(Obj,TPasRecordType(El),aContext);
     end
   else if C=TPasClassType then
     begin
+    if IsSpecialized(TPasGenericType(El)) then exit;
     Obj.Add('Type',PCUObjKindNames[TPasClassType(El).ObjKind]);
     WriteClassType(Obj,TPasClassType(El),aContext);
     end
@@ -3429,6 +3439,7 @@ begin
     end
   else if C=TPasProcedureType then
     begin
+    if IsSpecialized(TPasGenericType(El)) then exit;
     Obj.Add('Type','ProcType');
     WriteProcedureType(Obj,TPasProcedureType(El),aContext);
     end
@@ -3743,9 +3754,19 @@ end;
 
 procedure TPCUWriter.WriteSpecializeType(Obj: TJSONObject;
   El: TPasSpecializeType; aContext: TPCUWriterContext);
+var
+  SpecTypeData: TPasSpecializeTypeData;
+  SpecType: TPasGenericType;
 begin
   WriteAliasType(Obj,El,aContext);
-  WriteElementList(Obj,El,'Params',El.Params,aContext);
+  WriteElementList(Obj,El,'Params',El.Params,aContext,true);
+  if not (El.CustomData is TPasSpecializeTypeData) then
+    RaiseMsg(20200219122421,El,GetObjName(El.CustomData));
+  SpecTypeData:=TPasSpecializeTypeData(El.CustomData);
+  SpecType:=SpecTypeData.SpecializedType;
+  if SpecType=nil then
+    RaiseMsg(20200219122520,El,GetObjName(El.CustomData));
+  Obj.Add('SpecName',SpecType.Name);
 end;
 
 procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
@@ -3753,7 +3774,7 @@ procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
 begin
   WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
   WriteExpr(Obj,Expr,'Name',Expr.NameExpr,aContext);
-  WriteElementList(Obj,Expr,'Params',Expr.Params,aContext);
+  WriteElementList(Obj,Expr,'Params',Expr.Params,aContext,true);
 end;
 
 procedure TPCUWriter.WriteRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -7575,11 +7596,36 @@ end;
 
 procedure TPCUReader.ReadSpecializeType(Obj: TJSONObject;
   El: TPasSpecializeType; aContext: TPCUReaderContext);
+var
+  GenType: TPasGenericType;
+  GenericTemplateTypes: TFPList;
+  SpecType: TPasElement;
+  ExpName: string;
 begin
   ReadAliasType(Obj,El,aContext);
+  if not (El.DestType is TPasGenericType) then
+    RaiseMsg(20200219121250,El,GetObjPath(El.DestType));
+  GenType:=TPasGenericType(El.DestType);
+  GenericTemplateTypes:=GenType.GenericTemplateTypes;
+  if (GenericTemplateTypes=nil) or (GenericTemplateTypes.Count=0) then
+    RaiseMsg(20200219121415,El,GetObjPath(El.DestType));
+
   ReadElementList(Obj,El,'Params',El.Params,
     {$IFDEF CheckPasTreeRefCount}'TPasSpecializeType.Params'{$ELSE}true{$ENDIF},
     aContext);
+  if El.Params.Count=0 then
+    RaiseMsg(20200219121447,El);
+  if El.Params.Count<>GenType.GenericTemplateTypes.Count then
+    RaiseMsg(20200219121521,El,GetObjPath(GenType));
+
+  // specialize
+  SpecType:=Resolver.GetSpecializedEl(El,GenType,El.Params);
+
+  // check old specialized name is the same
+  if not ReadString(Obj,'SpecName',ExpName,El) then
+    RaiseMsg(20200219122919,El);
+  if ExpName<>SpecType.Name then
+    RaiseMsg(20200219123003,El,'Expected="'+ExpName+'", but found "'+SpecType.Name+'"');
 end;
 
 procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
@@ -7731,6 +7777,8 @@ begin
     aContext);
 
   ReadRecordScope(Obj,Scope,aContext);
+  Resolver.FinishSpecializedClassOrRecIntf(Scope);
+  Resolver.FinishSpecializations(Scope);
 end;
 
 function TPCUReader.ReadClassInterfaceType(Obj: TJSONObject;
@@ -8067,7 +8115,6 @@ begin
     {$IFDEF CheckPasTreeRefCount}'TPasClassType.Members'{$ELSE}true{$ENDIF},
     aContext);
 
-
   if Scope<>nil then
     begin
     ReadClassScopeAbstractProcs(Obj,Scope);
@@ -8089,6 +8136,9 @@ begin
         Parent:=Parent.Parent;
         end;
       end;
+
+    Resolver.FinishSpecializedClassOrRecIntf(Scope);
+    Resolver.FinishSpecializations(Scope);
     end;
 end;
 

+ 90 - 24
packages/pastojs/tests/tcfiler.pas

@@ -31,7 +31,7 @@ uses
 
 type
   TPCCheckFlag = (
-    PCCGeneric
+    PCCGeneric // inside generic proc body
     );
   TPCCheckFlags = set of TPCCheckFlag;
 
@@ -81,6 +81,7 @@ type
     procedure CheckRestoredScopeRefs(const Path: string; Orig, Rest: TPasScopeReferences; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredPropertyScope(const Path: string; Orig, Rest: TPasPropertyScope; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredGenericParamScope(const Path: string; Orig, Rest: TPasGenericParamsScope; Flags: TPCCheckFlags); virtual;
+    procedure CheckRestoredSpecializeTypeData(const Path: string; Orig, Rest: TPasSpecializeTypeData; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredResolvedReference(const Path: string; Orig, Rest: TResolvedReference; Flags: TPCCheckFlags); virtual;
     procedure CheckRestoredEvalValue(const Path: string; Orig, Rest: TResEvalValue); virtual;
     procedure CheckRestoredCustomData(const Path: string; RestoredEl: TPasElement; Orig, Rest: TObject; Flags: TPCCheckFlags); virtual;
@@ -195,7 +196,6 @@ type
     procedure TestPC_ClassInterface;
     procedure TestPC_Attributes;
 
-    procedure TestPC_GenericClass; // ToDo
     procedure TestPC_GenericFunction_Assign;
     procedure TestPC_GenericFunction_Asm;
     procedure TestPC_GenericFunction_RepeatUntil;
@@ -209,6 +209,15 @@ type
     procedure TestPC_GenericFunction_TryExcept;
     procedure TestPC_GenericFunction_LocalProc;
     procedure TestPC_GenericFunction_AnonymousProc;
+    procedure TestPC_GenericClass;
+    procedure TestPC_GenericMethod;
+    procedure TestPC_SpecializeClassSameUnit; // ToDo
+    // ToDo: specialize
+    // ToDo: inline specialize in unit interface
+    // ToDo: inline specialize in unit implementation
+    // ToDo: inline specialize in proc decl
+    // ToDo: inline specialize in proc body
+    // ToDo: constraints
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
@@ -958,6 +967,13 @@ begin
   if Flags=[] then ;
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredSpecializeTypeData(
+  const Path: string; Orig, Rest: TPasSpecializeTypeData; Flags: TPCCheckFlags);
+begin
+  if Flags<>[] then ;
+  CheckRestoredReference(Path+'.SpecializedType',Orig.SpecializedType,Rest.SpecializedType);
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredResolvedReference(
   const Path: string; Orig, Rest: TResolvedReference; Flags: TPCCheckFlags);
 var
@@ -1088,6 +1104,8 @@ begin
     CheckRestoredPropertyScope(Path+'[TPasPropertyScope]',TPasPropertyScope(Orig),TPasPropertyScope(Rest),Flags)
   else if C=TPasGenericParamsScope then
     CheckRestoredGenericParamScope(Path+'[TPasGenericParamScope]',TPasGenericParamsScope(Orig),TPasGenericParamsScope(Rest),Flags)
+  else if C=TPasSpecializeTypeData then
+    CheckRestoredSpecializeTypeData(Path+'[TPasSpecializeTypeData]',TPasSpecializeTypeData(Orig),TPasSpecializeTypeData(Rest),Flags)
   else if C.InheritsFrom(TResEvalValue) then
     CheckRestoredEvalValue(Path+'['+Orig.ClassName+']',TResEvalValue(Orig),TResEvalValue(Rest))
   else
@@ -2679,28 +2697,6 @@ begin
   WriteReadUnit;
 end;
 
-procedure TTestPrecompile.TestPC_GenericClass;
-begin
-  StartUnit(false);
-  Add([
-  'interface',
-  'type',
-  '  TObject = class',
-  '  end;',
-  '  generic TBird<T> = class',
-  '    a: T;',
-  '    function Run: T;',
-  '  end;',
-  'implementation',
-  'function TBird.Run: T;',
-  'var b: T;',
-  'begin',
-  '  b:=a; Result:=b;',
-  'end;',
-  '']);
-  WriteReadUnit;
-end;
-
 procedure TTestPrecompile.TestPC_GenericFunction_Assign;
 begin
   StartUnit(false);
@@ -3011,6 +3007,76 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_GenericClass;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  generic TBird<T> = class',
+  '    a: T;',
+  '    function Run: T;',
+  '  end;',
+  'implementation',
+  'function TBird.Run: T;',
+  'var b: T;',
+  'begin',
+  '  b:=a; Result:=b;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_GenericMethod;
+begin
+  StartUnit(false);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird = class',
+  '    function Run<T>(a: T): T;',
+  '  end;',
+  'implementation',
+  'function TBird.Run<T>(a: T): T;',
+  'var b: T;',
+  'begin',
+  '  b:=a;',
+  '  Result:=b;',
+  'end;',
+  '']);
+  WriteReadUnit;
+end;
+
+procedure TTestPrecompile.TestPC_SpecializeClassSameUnit;
+begin
+  exit;
+
+  StartUnit(false);
+  Add([
+  '{$mode delphi}',
+  'interface',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TBird<T> = class',
+  '    a: T;',
+  '  end;',
+  '  TBigBird = TBIrd<double>;',
+  'var',
+  '  b: TBigBird;',
+  'implementation',
+  'begin',
+  '  b.a:=1.3;',
+  'end.',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_UseUnit;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',

+ 1 - 1
packages/pastojs/tests/tcgenerics.pas

@@ -60,7 +60,7 @@ type
     procedure TestGenProc_TypeInfo;
     procedure TestGenProc_Infer_Widen;
     procedure TestGenProc_Infer_PassAsArg;
-    // ToDo: FuncName:=
+    // ToDo: FuncName:= instead of Result:=
 
     // generic methods
     procedure TestGenMethod_ObjFPC;