浏览代码

# revisions: 42502,42503,42504,42505,42506,42517,42518,42523,42524,42529,42532,42534,42544,42576,42577,42578,42592,42598,42599,42602,42608,42623,42624,42640,42644,42663,42664,42669,42678,42680,42688,42689,42690,42702,42703,42704,42712,42714,42715,42716,42721,42735,42736,,42502,42503,42504,42505,42506,42517,42518,42523,42524,42529,42532,42534,42544

git-svn-id: branches/fixes_3_2@43378 -
marco 5 年之前
父节点
当前提交
4e1f4bf7a1

+ 1 - 0
.gitattributes

@@ -7009,6 +7009,7 @@ packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
 packages/pastojs/tests/tcfiler.pas svneol=native#text/plain
+packages/pastojs/tests/tcgenerics.pas svneol=native#text/plain
 packages/pastojs/tests/tcmodules.pas svneol=native#text/plain
 packages/pastojs/tests/tcoptimizations.pas svneol=native#text/plain
 packages/pastojs/tests/tcprecompile.pas svneol=native#text/plain

+ 78 - 6
packages/fcl-passrc/src/pasresolveeval.pas

@@ -160,7 +160,7 @@ const
   nIllegalQualifierAfter = 3084;
   nIllegalQualifierInFrontOf = 3085;
   nIllegalQualifierWithin = 3086;
-  nMethodClassXInOtherUnitY = 3087;
+  nClassXNotFoundInThisModule = 3087;
   nClassMethodsMustBeStaticInX = 3088;
   nCannotMixMethodResolutionAndDelegationAtX = 3089;
   nImplementsDoesNotSupportArrayProperty = 3101;
@@ -193,6 +193,13 @@ const
   nConstraintXSpecifiedMoreThanOnce = 3127;
   nConstraintXAndConstraintYCannotBeTogether = 3128;
   nXIsNotAValidConstraint = 3129;
+  nWrongNumberOfParametersForGenericType = 3130;
+  nGenericsWithoutSpecializationAsType = 3131;
+  nDeclOfXDiffersFromPrevAtY = 3132;
+  nTypeParamXIsMissingConstraintY = 3133;
+  nTypeParamXIsNotCompatibleWithY = 3134;
+  nTypeParamXMustSupportIntfY = 3135;
+  nTypeParamsNotAllowedOnX = 3136;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -300,7 +307,7 @@ resourcestring
   sIllegalQualifierAfter = 'illegal qualifier "%s" after "%s"';
   sIllegalQualifierInFrontOf = 'illegal qualifier "%s" in front of "%s"';
   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
-  sMethodClassXInOtherUnitY = 'method class "%s" in other unit "%s"';
+  sClassXNotFoundInThisModule = 'class "%s" not found in this module';
   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
   sClassMethodsMustBeStaticInX = 'Class methods must be static in %s';
   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
@@ -330,9 +337,16 @@ resourcestring
   sIllegalExpressionAfterX = 'illegal expression after %s';
   sMethodHidesNonVirtualMethodExactly = 'method hides identifier at "%s". Use reintroduce';
   sDuplicatePublishedMethodXAtY = 'Duplicate published method "%s" at %s';
-  sConstraintXSpecifiedMoreThanOnce = 'Constraint ''%s'' specified more than once';
-  sConstraintXAndConstraintYCannotBeTogether = '''%s'' constraint and ''%s'' constraint cannot be specified together';
-  sXIsNotAValidConstraint = '''%s'' is not a valid constraint';
+  sConstraintXSpecifiedMoreThanOnce = 'Constraint "%s" specified more than once';
+  sConstraintXAndConstraintYCannotBeTogether = '"%s" constraint and "%s" constraint cannot be specified together';
+  sXIsNotAValidConstraint = '"%s" is not a valid constraint';
+  sWrongNumberOfParametersForGenericType = 'wrong number of parameters for generic type %s';
+  sGenericsWithoutSpecializationAsType = 'Generics without specialization cannot be used as a type for a %s';
+  sDeclOfXDiffersFromPrevAtY = 'Declaration of "%s" differs from previous declaration at %s';
+  sTypeParamXIsMissingConstraintY = 'Type parameter "%s" is missing constraint "%s"';
+  sTypeParamXIsNotCompatibleWithY = 'Type parameter "%s" is not compatible with type "%s"';
+  sTypeParamXMustSupportIntfY = 'Type parameter "%s" must support interface "%s"';
+  sTypeParamsNotAllowedOnX = 'Type parameters not allowed on %s';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
@@ -772,6 +786,8 @@ function CodePointToString(CodePoint: longword): String;
 function CodePointToUnicodeString(u: longword): UnicodeString;
 
 function GetObjName(o: TObject): string;
+function GetObjPath(o: TObject): string;
+function GetTypeParamCommas(Cnt: integer): string;
 function dbgs(const Flags: TResEvalFlags): string; overload;
 function dbgs(v: TResEvalValue): string; overload;
 
@@ -989,15 +1005,71 @@ begin
 end;
 
 function GetObjName(o: TObject): string;
+var
+  GenType: TPasGenericType;
 begin
   if o=nil then
     Result:='nil'
   else if o is TPasElement then
-    Result:=TPasElement(o).Name+':'+o.ClassName
+    begin
+    Result:=TPasElement(o).Name;
+    if o is TPasGenericType then
+      begin
+      GenType:=TPasGenericType(o);
+      if (GenType.GenericTemplateTypes<>nil)
+          and (GenType.GenericTemplateTypes.Count>0) then
+        Result:=Result+GetTypeParamCommas(GenType.GenericTemplateTypes.Count);
+      end;
+    Result:=Result+':'+o.ClassName;
+    end
   else
     Result:=o.ClassName;
 end;
 
+function GetObjPath(o: TObject): string;
+var
+  El: TPasElement;
+  GenType: TPasGenericType;
+begin
+  if o is TPasElement then
+    begin
+    El:=TPasElement(o);
+    Result:=':'+El.ClassName;
+    while El<>nil do
+      begin
+      if El<>o then
+        Result:='.'+Result;
+      if El is TPasGenericType then
+        begin
+        GenType:=TPasGenericType(El);
+        if (GenType.GenericTemplateTypes<>nil)
+            and (GenType.GenericTemplateTypes.Count>0) then
+          Result:=GetTypeParamCommas(GenType.GenericTemplateTypes.Count)+Result;
+        end;
+      if El.Name<>'' then
+        begin
+        if IsValidIdent(El.Name) then
+          Result:=El.Name+Result
+        else
+          Result:='"'+El.Name+'"'+Result;
+        end
+      else
+        Result:='['+El.ClassName+']'+Result;
+      El:=El.Parent;
+      end;
+    end
+  else
+    Result:=GetObjName(o);
+end;
+
+function GetTypeParamCommas(Cnt: integer): string;
+begin
+  if Cnt<=0 then
+    Result:=''
+  else
+    Result:='<'+StringOfChar(',',Cnt-1)+'>';
+end;
+
 function dbgs(const Flags: TResEvalFlags): string;
 var
   s: string;

文件差异内容过多而无法显示
+ 570 - 137
packages/fcl-passrc/src/pasresolver.pp


+ 151 - 171
packages/fcl-passrc/src/pastree.pp

@@ -102,7 +102,7 @@ type
   protected
     procedure Accept(Visitor: TPassTreeVisitor); virtual;
   public
-    Property CustomData : TObject Read FData Write FData;
+    Property CustomData: TObject Read FData Write FData;
   end;
   TPasElementBaseClass = class of TPasElementBase;
 
@@ -508,6 +508,7 @@ type
   public
     function ElementTypeName: string; override;
   end;
+  TPasTypeArray = array of TPasType;
 
   { TPasAliasType }
 
@@ -549,12 +550,33 @@ type
     function ElementTypeName: string; override;
   end;
 
-  { TPasClassOfType }
+  { TPasGenericTemplateType - type param of a generic }
 
-  TPasClassOfType = class(TPasAliasType)
+  TPasGenericTemplateType = Class(TPasType)
   public
-    function ElementTypeName: string; override;
-    function GetDeclaration(full: boolean) : string; override;
+    destructor Destroy; override;
+    function GetDeclaration(full : boolean) : string; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    procedure AddConstraint(Expr: TPasExpr);
+  Public
+    TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
+    Constraints: TPasExprArray;
+  end;
+
+  { TPasGenericType - abstract base class for all types which can be generics }
+
+  TPasGenericType = class(TPasType)
+  private
+    procedure ClearChildReferences(El: TPasElement; arg: pointer);
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
+  public
+    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType, can be nil
+    destructor Destroy; override;
+    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
+      const Arg: Pointer); override;
+    procedure SetGenericTemplates(AList: TFPList); virtual;
   end;
 
   { TPasSpecializeType DestType<Params> }
@@ -582,10 +604,16 @@ type
     function GetDeclaration(full : Boolean): string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    procedure AddParam(El: TPasElement);
   public
-    NameExpr: TPasExpr; // TPrimitiveExpr
-    Params: TFPList; // list of TPasType or TPasExpr
+    DestType: TPasSpecializeType;
+  end;
+
+  { TPasClassOfType }
+
+  TPasClassOfType = class(TPasAliasType)
+  public
+    function ElementTypeName: string; override;
+    function GetDeclaration(full: boolean) : string; override;
   end;
 
   { TPasRangeType }
@@ -605,27 +633,21 @@ type
 
   { TPasArrayType }
 
-  TPasArrayType = class(TPasType)
-  private
-    procedure ClearChildReferences(El: TPasElement; arg: pointer);
+  TPasArrayType = class(TPasGenericType)
   protected
     procedure SetParent(const AValue: TPasElement); override;
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
-    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
-      const Arg: Pointer); override;
   public
     IndexRange : string; // only valid if Parser po_arrayrangeexpr disabled
     Ranges: TPasExprArray; // only valid if Parser po_arrayrangeexpr enabled
     PackMode : TPackMode;
     ElType: TPasType;
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType, can be nil
     function IsGenericArray : Boolean;
     function IsPacked : Boolean;
     procedure AddRange(Range: TPasExpr);
-    procedure SetGenericTemplates(AList: TFPList); virtual;
   end;
 
   { TPasFileType }
@@ -701,22 +723,16 @@ type
 
   { TPasMembersType - base type for TPasRecordType and TPasClassType }
 
-  TPasMembersType = class(TPasType)
-  private
-    procedure ClearChildReferences(El: TPasElement; arg: pointer);
-  protected
-    procedure SetParent(const AValue: TPasElement); override;
+  TPasMembersType = class(TPasGenericType)
   public
     PackMode: TPackMode;
     Members: TFPList;
-    GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
     Constructor Create(const AName: string; AParent: TPasElement); override;
     Destructor Destroy; override;
     Function IsPacked: Boolean;
     Function IsBitPacked : Boolean;
     Procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    Procedure SetGenericTemplates(AList: TFPList); virtual;
   end;
 
   { TPasRecordType }
@@ -737,23 +753,9 @@ type
     Function IsAdvancedRecord : Boolean;
   end;
 
-  { TPasGenericTemplateType }
-
-  TPasGenericTemplateType = Class(TPasType)
-  public
-    destructor Destroy; override;
-    function GetDeclaration(full : boolean) : string; override;
-    procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
-      const Arg: Pointer); override;
-    procedure AddConstraint(Expr: TPasExpr);
-  Public
-    TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
-    Constraints: TPasExprArray;
-  end;
-
   TPasObjKind = (
     okObject, okClass, okInterface,
-    // okGeneric  removed in FPC 3.3.1  check instead GenericTemplateTypes.Count>0
+    // okGeneric  removed in FPC 3.3.1  check instead GenericTemplateTypes<>nil
     // okSpecialize removed in FPC 3.1.1
     okClassHelper,okRecordHelper,okTypeHelper,
     okDispInterface);
@@ -823,7 +825,7 @@ type
 
   { TPasProcedureType }
 
-  TPasProcedureType = class(TPasType)
+  TPasProcedureType = class(TPasGenericType)
   private
     function GetIsNested: Boolean;
     function GetIsOfObject: Boolean;
@@ -838,7 +840,7 @@ type
     function ElementTypeName: string; override;
     function GetDeclaration(full : boolean) : string; override;
     procedure GetArguments(List : TStrings);
-    function CreateArgument(const AName, AUnresolvedTypeName: string):TPasArgument;
+    function CreateArgument(const AName, AUnresolvedTypeName: string): TPasArgument; // not used by TPasParser
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
@@ -1047,11 +1049,11 @@ type
 
   { TProcedureNamePart }
 
-  TProcedureNamePart = record
+  TProcedureNamePart = class
     Name: string;
-    Templates: TFPList; // optional list of TPasGenericTemplateType, can nil!
+    Templates: TFPList; // optional list of TPasGenericTemplateType, can be nil!
   end;
-  TProcedureNameParts = array of TProcedureNamePart;
+  TProcedureNameParts = TFPList;
                         
   TProcedureBody = class;
 
@@ -1095,7 +1097,7 @@ type
     Function IsStatic : Boolean;
     Function IsForward: Boolean;
     Function GetProcTypeEnum: TProcType; virtual;
-    procedure SetNameParts(var Parts: TProcedureNameParts);
+    procedure SetNameParts(Parts: TProcedureNameParts);
     Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
     Property CallingConvention : TCallingConvention Read GetCallingConvention Write SetCallingConvention;
     Property MessageName : String Read FMessageName Write FMessageName;
@@ -1399,11 +1401,11 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    Elements: TFPList;    // list of TPasImplElement and maybe one TPasImplCaseElse
+    Elements: TFPList;    // list of TPasImplElement
   end;
   TPasImplBlockClass = class of TPasImplBlock;
 
-  { TPasImplStatement }
+  { TPasImplStatement - base class }
 
   TPasImplStatement = class(TPasImplBlock)
   public
@@ -1623,7 +1625,7 @@ type
     procedure ClearTypeReferences(aType: TPasElement); override;
   public
     VarEl: TPasVariable; // can be nil
-    TypeEl : TPasType;
+    TypeEl : TPasType; // if VarEl<>nil then TypeEl=VarEl.VarType
     Body: TPasImplElement;
     Function VariableName : String;
     Function TypeName: string;
@@ -1807,21 +1809,27 @@ procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
 var
   El: TPasElement;
   i, j: Integer;
+  Part: TProcedureNamePart;
 begin
-  for i := 0 to length(NameParts)-1 do
+  if NameParts=nil then exit;
+  for i := NameParts.Count-1 downto 0 do
     begin
-    with NameParts[i] do
-      if Templates<>nil then
+    Part:=TProcedureNamePart(NameParts[i]);
+    if Part.Templates<>nil then
+      begin
+      for j:=0 to Part.Templates.Count-1 do
         begin
-        for j:=0 to Templates.Count-1 do
-          begin
-          El:=TPasGenericTemplateType(Templates[j]);
-          El.Parent:=nil;
-          El.Release{$IFDEF CheckPasTreeRefCount}('TPasProcedure.NameParts'){$ENDIF};
-          end;
-        Templates.Free;
+        El:=TPasGenericTemplateType(Part.Templates[j]);
+        El.Parent:=nil;
+        El.Release{$IFDEF CheckPasTreeRefCount}('TPasProcedure.NameParts'){$ENDIF};
         end;
+      Part.Templates.Free;
+      Part.Templates:=nil;
+      end;
+    NameParts.Delete(i);
+    Part.Free;
     end;
+  NameParts.Free;
   NameParts:=nil;
 end;
 
@@ -1845,6 +1853,58 @@ begin
     end;
 end;
 
+{ TPasGenericType }
+
+procedure TPasGenericType.ClearChildReferences(El: TPasElement; arg: pointer);
+begin
+  El.ClearTypeReferences(Self);
+  if arg=nil then ;
+end;
+
+procedure TPasGenericType.SetParent(const AValue: TPasElement);
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all child references to this array (releasing loops)
+    ForEachCall(@ClearChildReferences,nil);
+    end;
+  inherited SetParent(AValue);
+end;
+
+destructor TPasGenericType.Destroy;
+begin
+  ReleaseGenericTemplateTypes(GenericTemplateTypes{$IFDEF CheckPasTreeRefCount},'TPasGenericType'{$ENDIF});
+  inherited Destroy;
+end;
+
+procedure TPasGenericType.ForEachCall(const aMethodCall: TOnForEachPasElement;
+  const Arg: Pointer);
+var
+  i: Integer;
+begin
+  inherited ForEachCall(aMethodCall, Arg);
+  if GenericTemplateTypes<>nil then
+    for i:=0 to GenericTemplateTypes.Count-1 do
+      ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
+end;
+
+procedure TPasGenericType.SetGenericTemplates(AList: TFPList);
+var
+  I: Integer;
+  El: TPasElement;
+begin
+  if GenericTemplateTypes=nil then
+    GenericTemplateTypes:=TFPList.Create;
+  For I:=0 to AList.Count-1 do
+    begin
+    El:=TPasElement(AList[i]);
+    El.Parent:=Self;
+    GenericTemplateTypes.Add(El);
+    end;
+  AList.Clear;
+end;
+
 { TPasGenericTemplateType }
 
 destructor TPasGenericTemplateType.Destroy;
@@ -1852,7 +1912,7 @@ var
   i: Integer;
 begin
   for i:=0 to length(Constraints)-1 do
-    Constraints[i].Release;
+    Constraints[i].Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
   Constraints:=nil;
   inherited Destroy;
 end;
@@ -1978,17 +2038,11 @@ constructor TInlineSpecializeExpr.Create(const AName: string;
 begin
   if AName='' then ;
   inherited Create(AParent, pekSpecialize, eopNone);
-  Params:=TFPList.Create;
 end;
 
 destructor TInlineSpecializeExpr.Destroy;
-var
-  i: Integer;
 begin
-  ReleaseAndNil(TPasElement(NameExpr));
-  for i:=0 to Params.Count-1 do
-    TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
-  FreeAndNil(Params);
+  ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
   inherited Destroy;
 end;
 
@@ -1998,34 +2052,15 @@ begin
 end;
 
 function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string;
-var
-  i: Integer;
 begin
-  Result:='specialize ';
-  Result:=Result+NameExpr.GetDeclaration(full);
-  Result:=Result+'<';
-  for i:=0 to Params.Count-1 do
-    begin
-    if i>0 then
-      Result:=Result+',';
-    Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
-    end;
+  Result:=DestType.GetDeclaration(full);
 end;
 
 procedure TInlineSpecializeExpr.ForEachCall(
   const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
-var
-  i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  ForEachChildCall(aMethodCall,Arg,NameExpr,false);
-  for i:=0 to Params.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
-end;
-
-procedure TInlineSpecializeExpr.AddParam(El: TPasElement);
-begin
-  Params.Add(El);
+  ForEachChildCall(aMethodCall,Arg,DestType,false);
 end;
 
 { TPasSpecializeType }
@@ -2063,7 +2098,7 @@ begin
       Result:=Result+',';
     Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
     end;
-  If Full then
+  If Full and (Name<>'') then
     begin
     Result:=Name+' = '+Result;
     ProcessHints(False,Result);
@@ -2991,7 +3026,7 @@ begin
     begin
     Child:=TPasElement(Declarations[i]);
     Child.Parent:=nil;
-    Child.Release{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Childs'){$ENDIF};
+    Child.Release{$IFDEF CheckPasTreeRefCount}('TPasDeclarations.Children'){$ENDIF};
     end;
   FreeAndNil(Declarations);
 
@@ -3078,19 +3113,24 @@ begin
   inherited Destroy;
 end;
 
-procedure TPasArrayType.ClearChildReferences(El: TPasElement; arg: pointer);
-begin
-  El.ClearTypeReferences(Self);
-  if arg=nil then ;
-end;
-
 procedure TPasArrayType.SetParent(const AValue: TPasElement);
+var
+  CurArr: TPasArrayType;
 begin
   if (AValue=nil) and (Parent<>nil) then
     begin
     // parent is cleared
-    // -> clear all child references to this array (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
+    // -> clear all references to this array (releasing loops)
+    CurArr:=Self;
+    while CurArr.ElType is TPasArrayType do
+      begin
+      if CurArr.ElType=Self then
+        begin
+        ReleaseAndNil(TPasElement(CurArr.ElType){$IFDEF CheckPasTreeRefCount},'TPasClassType.AncestorType'{$ENDIF});
+        break;
+        end;
+      CurArr:=TPasArrayType(CurArr.ElType);
+      end;
     end;
   inherited SetParent(AValue);
 end;
@@ -3099,7 +3139,6 @@ destructor TPasArrayType.Destroy;
 var
   i: Integer;
 begin
-  ReleaseGenericTemplateTypes(GenericTemplateTypes{$IFDEF CheckPasTreeRefCount},'TPasArrayType'{$ENDIF});
   for i:=0 to length(Ranges)-1 do
     Ranges[i].Release{$IFDEF CheckPasTreeRefCount}('TPasArrayType.Ranges'){$ENDIF};
   ReleaseAndNil(TPasElement(ElType){$IFDEF CheckPasTreeRefCount},'TPasArrayType.ElType'{$ENDIF});
@@ -4088,18 +4127,6 @@ begin
     Result:=Result+'const';
 end;
 
-procedure TPasArrayType.ForEachCall(const aMethodCall: TOnForEachPasElement;
-  const Arg: Pointer);
-var
-  i: Integer;
-begin
-  inherited ForEachCall(aMethodCall, Arg);
-  if GenericTemplateTypes<>nil then
-    for i:=0 to GenericTemplateTypes.Count-1 do
-      ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
-  ForEachChildCall(aMethodCall,Arg,ElType,true);
-end;
-
 function TPasArrayType.IsGenericArray: Boolean;
 begin
   Result:=GenericTemplateTypes<>nil;
@@ -4119,22 +4146,6 @@ begin
   Ranges[i]:=Range;
 end;
 
-procedure TPasArrayType.SetGenericTemplates(AList: TFPList);
-var
-  I: Integer;
-  El: TPasElement;
-begin
-  if GenericTemplateTypes=nil then
-    GenericTemplateTypes:=TFPList.Create;
-  For I:=0 to AList.Count-1 do
-    begin
-    El:=TPasElement(AList[i]);
-    El.Parent:=Self;
-    GenericTemplateTypes.Add(El);
-    end;
-  AList.Clear;
-end;
-
 function TPasFileType.GetDeclaration (full : boolean) : string;
 begin
   Result:='File';
@@ -4224,23 +4235,6 @@ end;
 
 { TPasMembersType }
 
-procedure TPasMembersType.ClearChildReferences(El: TPasElement; arg: pointer);
-begin
-  El.ClearTypeReferences(Self);
-  if arg=nil then ;
-end;
-
-procedure TPasMembersType.SetParent(const AValue: TPasElement);
-begin
-  if (AValue=nil) and (Parent<>nil) then
-    begin
-    // parent is cleared
-    // -> clear all child references to this class/record (releasing loops)
-    ForEachCall(@ClearChildReferences,nil);
-    end;
-  inherited SetParent(AValue);
-end;
-
 constructor TPasMembersType.Create(const AName: string; AParent: TPasElement);
 begin
   inherited Create(AName, AParent);
@@ -4284,26 +4278,10 @@ var
   i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  for i:=0 to GenericTemplateTypes.Count-1 do
-    ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
   for i:=0 to Members.Count-1 do
     ForEachChildCall(aMethodCall,Arg,TPasElement(Members[i]),false);
 end;
 
-procedure TPasMembersType.SetGenericTemplates(AList: TFPList);
-var
-  I: Integer;
-  El: TPasElement;
-begin
-  For I:=0 to AList.Count-1 do
-    begin
-    El:=TPasElement(AList[i]);
-    El.Parent:=Self;
-    GenericTemplateTypes.Add(El);
-    end;
-  AList.Clear;
-end;
-
 { TPasRecordType }
 
 procedure TPasRecordType.GetMembers(S: TStrings);
@@ -4692,11 +4670,12 @@ var
   i, j: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  for i:=0 to length(NameParts)-1 do
-    with NameParts[i] do
-      if Templates<>nil then
-        for j:=0 to Templates.Count-1 do
-          ForEachChildCall(aMethodCall,Arg,TPasElement(Templates[i]),false);
+  if NameParts<>nil then
+    for i:=0 to NameParts.Count-1 do
+      with TProcedureNamePart(NameParts[i]) do
+        if Templates<>nil then
+          for j:=0 to Templates.Count-1 do
+            ForEachChildCall(aMethodCall,Arg,TPasElement(Templates[i]),false);
   ForEachChildCall(aMethodCall,Arg,ProcType,false);
   ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
@@ -4771,17 +4750,18 @@ begin
   Result:=ptProcedure;
 end;
 
-procedure TPasProcedure.SetNameParts(var Parts: TProcedureNameParts);
+procedure TPasProcedure.SetNameParts(Parts: TProcedureNameParts);
 var
   i, j: Integer;
   El: TPasElement;
 begin
-  if length(NameParts)>0 then
+  if NameParts<>nil then
     ReleaseProcNameParts(NameParts);
-  NameParts:=Parts;
-  Parts:=nil;
-  for i:=0 to length(NameParts)-1 do
-    with NameParts[i] do
+  NameParts:=TFPList.Create;
+  NameParts.Assign(Parts);
+  Parts.Clear;
+  for i:=0 to NameParts.Count-1 do
+    with TProcedureNamePart(NameParts[i]) do
       if Templates<>nil then
         for j:=0 to Templates.Count-1 do
           begin
@@ -4801,14 +4781,14 @@ begin
     If Full then
       begin
       T:=TypeName;
-      if length(NameParts)>0 then
+      if NameParts<>nil then
         begin
         T:=T+' ';
-        for i:=0 to length(NameParts)-1 do
+        for i:=0 to NameParts.Count-1 do
           begin
           if i>0 then
             T:=T+'.';
-          with NameParts[i] do
+          with TProcedureNamePart(NameParts[i]) do
             begin
             T:=T+Name;
             if Templates<>nil then

+ 102 - 26
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -270,6 +270,7 @@ type
     procedure UseType(El: TPasType; Mode: TPAUseMode); virtual;
     procedure UseClassOrRecType(El: TPasMembersType; Mode: TPAUseMode); virtual;
     procedure UseClassConstructor(El: TPasMembersType); virtual;
+    procedure UseSpecializeType(El: TPasSpecializeType; Mode: TPAUseMode); virtual;
     procedure UseVariable(El: TPasVariable; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseResourcestring(El: TPasResString); virtual;
@@ -282,6 +283,7 @@ type
     procedure EmitTypeHints(El: TPasType); virtual;
     procedure EmitVariableHints(El: TPasVariable); virtual;
     procedure EmitProcedureHints(El: TPasProcedure); virtual;
+    procedure EmitFunctionResultHints(El: TPasFunction); virtual;
   public
     constructor Create;
     destructor Destroy; override;
@@ -829,7 +831,7 @@ var
   s: String;
   E: EPasAnalyzer;
 begin
-  s:='['+IntToStr(Id)+']: Element='+GetElModName(El);
+  s:='['+IntToStr(Id)+']: Element='+GetObjPath(El);
   if Msg<>'' then S:=S+' '+Msg;
   E:=EPasAnalyzer.Create(s);
   E.PasElement:=El;
@@ -1063,6 +1065,7 @@ var
   Prop: TPasProperty;
   ProcType: TPasProcedureType;
   ClassEl: TPasClassType;
+  ArrType: TPasArrayType;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.UsePublished START ',GetObjName(El));
@@ -1098,10 +1101,13 @@ begin
   else if C=TPasRangeType then
   else if C=TPasArrayType then
     begin
-    UseSubEl(TPasArrayType(El).ElType);
-    for i:=0 to length(TPasArrayType(El).Ranges)-1 do
+    ArrType:=TPasArrayType(El);
+    if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ArrType) then
+      RaiseNotSupported(20190817151437,ArrType);
+    UseSubEl(ArrType.ElType);
+    for i:=0 to length(ArrType.Ranges)-1 do
       begin
-      Member:=TPasArrayType(El).Ranges[i];
+      Member:=ArrType.Ranges[i];
       Resolver.ComputeElement(Member,MemberResolved,[rcConstant]);
       UseSubEl(MemberResolved.HiTypeEl);
       end;
@@ -1143,11 +1149,20 @@ begin
   else if C.InheritsFrom(TPasProcedureType) then
     begin
     ProcType:=TPasProcedureType(El);
+    if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ProcType) then
+      RaiseNotSupported(20190817151554,ProcType);
     for i:=0 to ProcType.Args.Count-1 do
       UseSubEl(TPasArgument(ProcType.Args[i]).ArgType);
     if El is TPasFunctionType then
       UseSubEl(TPasFunctionType(El).ResultEl.ResultType);
     end
+  else if C=TPasSpecializeType then
+    UseSubEl(TPasSpecializeType(El).DestType)
+  else if C=TPasGenericTemplateType then
+    begin
+    if ScopeModule=nil then
+      RaiseNotSupported(20190817110226,El);
+    end
   else
     begin
     {$IFDEF VerbosePasAnalyzer}
@@ -1842,6 +1857,8 @@ begin
   writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
   {$ENDIF}
   if not MarkElementAsUsed(ProcType) then exit;
+  if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ProcType) then
+    RaiseNotSupported(20190817151651,ProcType);
 
   for i:=0 to ProcType.Args.Count-1 do
     begin
@@ -1859,6 +1876,7 @@ procedure TPasAnalyzer.UseType(El: TPasType; Mode: TPAUseMode);
 var
   C: TClass;
   i: Integer;
+  ArrType: TPasArrayType;
 begin
   if El=nil then exit;
 
@@ -1894,10 +1912,13 @@ begin
       end
     else if C=TPasArrayType then
       begin
-      if not MarkElementAsUsed(El) then exit;
-      for i:=0 to length(TPasArrayType(El).Ranges)-1 do
-        UseExpr(TPasArrayType(El).Ranges[i]);
-      UseElType(El,TPasArrayType(El).ElType,Mode);
+      ArrType:=TPasArrayType(El);
+      if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ArrType) then
+        RaiseNotSupported(20190817151449,ArrType);
+      if not MarkElementAsUsed(ArrType) then exit;
+      for i:=0 to length(ArrType.Ranges)-1 do
+        UseExpr(ArrType.Ranges[i]);
+      UseElType(El,ArrType.ElType,Mode);
       end
     else if (C=TPasRecordType) or (C=TPasClassType) then
       UseClassOrRecType(TPasMembersType(El),Mode)
@@ -1924,6 +1945,9 @@ begin
       end
     else if C.InheritsFrom(TPasProcedureType) then
       UseProcedureType(TPasProcedureType(El))
+    else if C=TPasSpecializeType then
+      UseSpecializeType(TPasSpecializeType(El),Mode)
+    else if C=TPasGenericTemplateType then
     else
       RaiseNotSupported(20170306170315,El);
 
@@ -1997,6 +2021,8 @@ var
   aClass: TPasClassType;
 begin
   FirstTime:=true;
+  if (ScopeModule=nil) and not Resolver.IsFullySpecialized(El) then
+    RaiseNotSupported(20190817110919,El);
   case Mode of
   paumAllExports: exit;
   paumAllPasUsable:
@@ -2200,6 +2226,24 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.UseSpecializeType(El: TPasSpecializeType;
+  Mode: TPAUseMode);
+var
+  Param: TPasElement;
+  i: Integer;
+begin
+  if not MarkElementAsUsed(El) then exit;
+  // El.DestType is TPasGenericType, which is never be used
+  if El.CustomData is TPasSpecializeTypeData then
+    UseElType(El,TPasSpecializeTypeData(El.CustomData).SpecializedType,Mode);
+  for i:=0 to El.Params.Count-1 do
+    begin
+    Param:=TPasElement(El.Params[i]);
+    if Param is TPasGenericTemplateType then continue;
+    UseElement(Param,rraRead,false);
+    end;
+end;
+
 procedure TPasAnalyzer.UseVariable(El: TPasVariable;
   Access: TResolvedRefAccess; UseFull: boolean);
 var
@@ -2599,9 +2643,7 @@ var
   Arg: TPasArgument;
   Usage: TPAElement;
   ProcScope: TPasProcedureScope;
-  PosEl: TPasElement;
   DeclProc, ImplProc: TPasProcedure;
-  FuncType: TPasFunctionType;
 begin
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
@@ -2668,22 +2710,7 @@ begin
       end;
     // check result
     if (El.ProcType is TPasFunctionType) then
-      begin
-      FuncType:=TPasFunctionType(TPasProcedure(El).ProcType);
-      PosEl:=FuncType.ResultEl;
-      if (ProcScope.ImplProc<>nil)
-          and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
-        PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
-      Usage:=FindElement(FuncType.ResultEl);
-      if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
-        // result was never used
-        EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
-          sPAFunctionResultDoesNotSeemToBeSet,[],PosEl)
-      else
-        begin
-        // result was used
-        end;
-      end;
+      EmitFunctionResultHints(TPasFunction(El));
     end;
 
   if El.Body<>nil then
@@ -2694,6 +2721,55 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.EmitFunctionResultHints(El: TPasFunction);
+var
+  FuncType: TPasFunctionType;
+  Usage: TPAElement;
+  TypeEl: TPasType;
+  Members: TFPList;
+  i: Integer;
+  Member: TPasElement;
+  HasFields: Boolean;
+  PosEl: TPasResultElement;
+  ProcScope: TPasProcedureScope;
+begin
+  FuncType:=El.FuncType;
+  Usage:=FindElement(FuncType.ResultEl);
+  if (Usage=nil) or (Usage.Access in [paiaNone,paiaRead]) then
+    begin
+    // result was never set
+    TypeEl:=Resolver.ResolveAliasType(FuncType.ResultEl.ResultType);
+    if TypeEl is TPasRecordType then
+      begin
+      Members:=TPasRecordType(TypeEl).Members;
+      HasFields:=false;
+      for i:=0 to Members.Count-1 do
+        begin
+        Member:=TPasElement(Members[i]);
+        if Member.ClassType=TPasVariable then
+          begin
+          HasFields:=true;
+          break;
+          end;
+        end;
+      if not HasFields then
+        // empty record -> no hint
+        exit;
+      end;
+    PosEl:=FuncType.ResultEl;
+    ProcScope:=El.CustomData as TPasProcedureScope;
+    if (ProcScope.ImplProc<>nil)
+        and (TPasFunction(ProcScope.ImplProc).FuncType.ResultEl<>nil) then
+      PosEl:=TPasFunction(ProcScope.ImplProc).FuncType.ResultEl;
+    EmitMessage(20170313214038,mtHint,nPAFunctionResultDoesNotSeemToBeSet,
+      sPAFunctionResultDoesNotSeemToBeSet,[],PosEl)
+    end
+  else
+    begin
+    // result was used
+    end;
+end;
+
 constructor TPasAnalyzer.Create;
 var
   m: TPAUseMode;

文件差异内容过多而无法显示
+ 385 - 312
packages/fcl-passrc/src/pparser.pp


+ 2 - 2
packages/fcl-passrc/tests/tcclasstype.pas

@@ -557,8 +557,8 @@ begin
   AssertNotNull('Have param types',C.Params);
   AssertEquals('Have one param type',1,C.Params.Count);
   AssertNotNull('First Param ',C.Params[0]);
-  AssertEquals('First Param expr',TPrimitiveExpr,TObject(C.Params[0]).ClassType);
-  AssertEquals('Has specialize param integer','Integer',TPrimitiveExpr(C.Params[0]).Value);
+  AssertEquals('First Param unresolvedtype',TPasUnresolvedTypeRef,TObject(C.Params[0]).ClassType);
+  AssertEquals('Has specialize param integer','Integer',TPasUnresolvedTypeRef(C.Params[0]).Name);
 end;
 
 procedure TTestClassType.TestOneSpecializedClass;

+ 25 - 1
packages/fcl-passrc/tests/tcgenerics.pp

@@ -16,8 +16,10 @@ Type
     Procedure TestObjectGenerics;
     Procedure TestRecordGenerics;
     Procedure TestArrayGenerics;
+    Procedure TestArrayGenericsDelphi;
+    Procedure TestProcTypeGenerics;
     Procedure TestGenericConstraint;
-    Procedure TestGenericInterfaceConstraint; // ToDo
+    Procedure TestGenericInterfaceConstraint;
     Procedure TestDeclarationConstraint;
     Procedure TestSpecializationDelphi;
     Procedure TestDeclarationDelphi;
@@ -61,6 +63,28 @@ begin
   Add([
     'Type',
     '  Generic TSome<T> = array of T;',
+    '  Generic TStatic<R,T> = array[R] of T;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestArrayGenericsDelphi;
+begin
+  Add([
+    '{$mode delphi}',
+    'Type',
+    '  TSome<T> = array of T;',
+    '  TStatic<R,T> = array[R] of T;',
+    '']);
+  ParseDeclarations;
+end;
+
+procedure TTestGenerics.TestProcTypeGenerics;
+begin
+  Add([
+    'Type',
+    '  Generic TSome<T> = procedure(v: T);',
+    '  Generic TFunc<R,T> = function(b: R): T;',
     '']);
   ParseDeclarations;
 end;

+ 1125 - 18
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -5,7 +5,7 @@ unit tcresolvegenerics;
 interface
 
 uses
-  Classes, SysUtils, testregistry, tcresolver, PasResolveEval;
+  Classes, SysUtils, testregistry, tcresolver, PasResolveEval, PParser;
 
 type
 
@@ -13,35 +13,179 @@ type
 
   TTestResolveGenerics = Class(TCustomTestResolver)
   Published
-    procedure TestGen_GenericFunction; // ToDo
+    // generic types
+    procedure TestGen_MissingTemplateFail;
+    procedure TestGen_VarTypeWithoutSpecializeFail;
+    procedure TestGen_GenTypeWithWrongParamCountFail;
+    procedure TestGen_GenericNotFoundFail;
+    procedure TestGen_SameNameSameParamCountFail;
+    procedure TestGen_TypeAliasWithoutSpecializeFail;
+
+    // constraints
     procedure TestGen_ConstraintStringFail;
     procedure TestGen_ConstraintMultiClassFail;
-    // ToDo: constraint keyword record
-    // ToDo: constraint keyword class, constructor, class+constructor
-    // ToDo: constraint Unit2.TBird
-    // ToDo: constraint Unit2.TGen<word>
-    // ToDo: generic array
+    procedure TestGen_ConstraintRecordExpectedFail;
+    procedure TestGen_ConstraintClassRecordFail;
+    procedure TestGen_ConstraintRecordClassFail;
+    procedure TestGen_ConstraintArrayFail;
+    // ToDo: constraint constructor
+    // ToDo: constraint T:Unit2.TBird
+    // ToDo: constraint T:Unit2.TGen<word>
+    procedure TestGen_TemplNameEqTypeNameFail;
+    procedure TestGen_ConstraintInheritedMissingRecordFail;
+    procedure TestGen_ConstraintInheritedMissingClassTypeFail;
+
+    // generic record
+    procedure TestGen_RecordLocalNameDuplicateFail;
+    procedure TestGen_Record;
+    procedure TestGen_RecordDelphi;
+    procedure TestGen_RecordNestedSpecialized;
+    procedure TestGen_Record_SpecializeSelfInsideFail;
+    procedure TestGen_RecordAnoArray;
+    // ToDo: unitname.specialize TBird<word>.specialize
+    procedure TestGen_RecordNestedSpecialize;
+
+    // generic class
+    procedure TestGen_Class;
+    procedure TestGen_ClassDelphi;
+    procedure TestGen_ClassForward;
+    procedure TestGen_ClassForwardConstraints;
+    procedure TestGen_ClassForwardConstraintNameMismatch;
+    procedure TestGen_ClassForwardConstraintKeywordMismatch;
+    procedure TestGen_ClassForwardConstraintTypeMismatch;
+    procedure TestGen_ClassForward_Circle;
+    procedure TestGen_Class_RedeclareInUnitImplFail;
+    // ToDo: add another in unit implementation
+    procedure TestGen_Class_Method;
+    // ToDo: procedure TestGen_Class_MethodOverride;
+    procedure TestGen_Class_MethodDelphi;
+    // ToDo: procedure TestGen_Class_MethodDelphiTypeParamMissing;
+    // ToDo: procedure TestGen_Class_MethodImplConstraintFail;
+    procedure TestGen_Class_SpecializeSelfInside;
+    // ToDo: generic class overload <T> <S,T>
+    procedure TestGen_Class_GenAncestor;
+    procedure TestGen_Class_AncestorSelfFail;
+    // ToDo: class of TBird<word> fail
+    // ToDo: UnitA.impl uses UnitB.intf uses UnitA.intf, UnitB has specialize of UnitA
+    procedure TestGen_Class_NestedType;
+    procedure TestGen_Class_NestedRecord;
+    procedure TestGen_Class_NestedClass;
+    procedure TestGen_Class_Enums_NotPropagating;
+    procedure TestGen_Class_List;
+
+    // generic external class
+    procedure TestGen_ExtClass_Array;
+
+    // generic interface
+    procedure TestGen_ClassInterface;
+    procedure TestGen_ClassInterface_Method;
+
+    // generic array
+    procedure TestGen_Array;
+
+    // generic procedure type
+    procedure TestGen_ProcType;
+
+    // ToDo: pointer of generic
+    // ToDo: PBird = ^TBird<word> fail
+
+    // ToDo: helpers for generics
+
+    // generic functions
+    procedure TestGen_GenericFunction; // ToDo
+    // ToDo: generic class method overload <T> <S,T>
+    // ToDo: procedure TestGen_GenMethod_ClassConstructorFail;
+
+    // generic statements
+    procedure TestGen_LocalVar;
+    procedure TestGen_Statements;
+    procedure TestGen_InlineSpecializeExpr;
+    // ToDo: for-in
+    procedure TestGen_TryExcept;
+    // ToDo: call
+    // ToDo: dot
+    // ToDo: is as
+    // ToDo: typecast
+    // ToTo: nested proc
   end;
 
 implementation
 
 { TTestResolveGenerics }
 
-procedure TTestResolveGenerics.TestGen_GenericFunction;
+procedure TTestResolveGenerics.TestGen_MissingTemplateFail;
 begin
   StartProgram(false);
   Add([
-  'generic function DoIt<T>(a: T): T;',
-  'var i: T;',
+  'type generic g< > = array of word;',
   'begin',
-  '  a:=i;',
-  '  Result:=a;',
-  'end;',
-  'var w: word;',
+  '']);
+  CheckParserException('Expected "Identifier"',nParserExpectTokenError);
+end;
+
+procedure TTestResolveGenerics.TestGen_VarTypeWithoutSpecializeFail;
+begin
+  StartProgram(false);
+  Add([
+  'type generic TBird<T> = record end;',
+  'var b: TBird;',
   'begin',
-  //'  w:=DoIt<word>(3);',
   '']);
-  ParseProgram;
+  CheckResolverException('Generics without specialization cannot be used as a type for a variable',
+    nGenericsWithoutSpecializationAsType);
+end;
+
+procedure TTestResolveGenerics.TestGen_GenTypeWithWrongParamCountFail;
+begin
+  StartProgram(false);
+  Add([
+  'type generic TBird<T> = record end;',
+  'var b: TBird<word, byte>;',
+  'begin',
+  '']);
+  CheckResolverException('identifier not found "TBird<,>"',
+    nIdentifierNotFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_GenericNotFoundFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TBird = specialize TAnimal<word>;',
+  'begin',
+  '']);
+  CheckResolverException('identifier not found "TAnimal<>"',
+    nIdentifierNotFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_SameNameSameParamCountFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TBird<S,T> = record w: T; end;',
+  '  TBird<X,Y> = record f: X; end;',
+  'begin',
+  '']);
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,8)',
+    nDuplicateIdentifier);
+end;
+
+procedure TTestResolveGenerics.TestGen_TypeAliasWithoutSpecializeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TBird<T> = record w: T; end;',
+  '  TBirdAlias = TBird;',
+  'begin',
+  '']);
+  CheckResolverException('type expected, but TBird<> found',
+    nXExpectedButYFound);
 end;
 
 procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
@@ -54,7 +198,7 @@ begin
   'end;',
   'begin',
   '']);
-  CheckResolverException('''string'' is not a valid constraint',
+  CheckResolverException('"String" is not a valid constraint',
     nXIsNotAValidConstraint);
 end;
 
@@ -73,10 +217,973 @@ begin
   'end;',
   'begin',
   '']);
-  CheckResolverException('''TBird'' constraint and ''TBear'' constraint cannot be specified together',
+  CheckResolverException('"TBird" constraint and "TBear" constraint cannot be specified together',
     nConstraintXAndConstraintYCannotBeTogether);
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintRecordExpectedFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T:record> = record v: T; end;',
+  'var r: specialize TBird<word>;',
+  'begin',
+  '']);
+  CheckResolverException('record type expected, but Word found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintClassRecordFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TRec = record end;',
+  '  generic TBird<T:class> = record v: T; end;',
+  'var r: specialize TBird<TRec>;',
+  'begin',
+  '']);
+  CheckResolverException('class type expected, but TRec found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintRecordClassFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T:record> = record v: T; end;',
+  'var r: specialize TBird<TObject>;',
+  'begin',
+  '']);
+  CheckResolverException('record type expected, but TObject found',
+    nXExpectedButYFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintArrayFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TArr = array of word;',
+  '  generic TBird<T:TArr> = record v: T; end;',
+  'begin',
+  '']);
+  CheckResolverException('"array of Word" is not a valid constraint',
+    nXIsNotAValidConstraint);
+end;
+
+procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<TBird> = record v: T; end;',
+  'var r: specialize TBird<word>;',
+  'begin',
+  '']);
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(4,16)',
+    nDuplicateIdentifier);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingRecordFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T: record> = class v: T; end;',
+  '  generic TEagle<U> = class(TBird<U>)',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Type parameter "U" is missing constraint "record"',
+    nTypeParamXIsMissingConstraintY);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintInheritedMissingClassTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  generic TBird<T: TAnt> = class v: T; end;',
+  '  generic TEagle<U> = class(TBird<U>)',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Type parameter "U" is not compatible with type "TAnt"',
+    nTypeParamXIsNotCompatibleWithY);
+end;
+
+procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T> = record T: word; end;',
+  'begin',
+  '']);
+  CheckResolverException('Duplicate identifier "T" at afile.pp(4,18)',
+    nDuplicateIdentifier);
+end;
+
+procedure TTestResolveGenerics.TestGen_Record;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  {#Typ}T = word;',
+  '  generic TRec<{#Templ}T> = record',
+  '    {=Templ}v: T;',
+  '  end;',
+  'var',
+  '  r: specialize TRec<word>;',
+  '  {=Typ}w: T;',
+  'begin',
+  '  r.v:=w;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_RecordDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  {#Typ}T = word;',
+  '  TRec<{#Templ}T> = record',
+  '    {=Templ}v: T;',
+  '  end;',
+  'var',
+  '  r: TRec<word>;',
+  '  {=Typ}w: T;',
+  'begin',
+  '  r.v:=w;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_RecordNestedSpecialized;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class v: T; end;',
+  '  generic TFish<T:class> = record v: T; end;',
+  'var f: specialize TFish<specialize TBird<word>>;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Record_SpecializeSelfInsideFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T> = record',
+  '    v: specialize TBird<word>;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('type "TBird<>" is not yet completely defined',
+    nTypeXIsNotYetCompletelyDefined);
+end;
+
+procedure TTestResolveGenerics.TestGen_RecordAnoArray;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T> = record v: T; end;',
+  'var',
+  '  a: specialize TBird<array of word>;',
+  '  b: specialize TBird<array of word>;',
+  'begin',
+  '  a:=b;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_RecordNestedSpecialize;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T> = record v: T; end;',
+  'var',
+  '  a: specialize TBird<specialize TBird<word>>;',
+  'begin',
+  '  a.v.v:=3;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  {#Typ}T = word;',
+  '  generic TBird<{#Templ}T> = class',
+  '    {=Templ}v: T;',
+  '  end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  '  {=Typ}w: T;',
+  'begin',
+  '  b.v:=w;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  {#Typ}T = word;',
+  '  TBird<{#Templ}T> = class',
+  '    {=Templ}v: T;',
+  '  end;',
+  'var',
+  '  b: TBird<word>;',
+  '  {=Typ}w: T;',
+  'begin',
+  '  b.v:=w;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForward;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  {#Typ}T = word;',
+  '  generic TBird<{#Templ_Forward}T> = class;',
+  '  TRec = record',
+  '    b: specialize TBird<T>;',
+  '  end;',
+  '  generic TBird<{#Templ}T> = class',
+  '    {=Templ}v: T;',
+  '    r: TRec;',
+  '  end;',
+  'var',
+  '  s: TRec;',
+  '  {=Typ}w: T;',
+  'begin',
+  '  s.b.v:=w;',
+  '  s.b.r:=s;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraints;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  generic TBird<T: class; U; V: TAnt> = class;',
+  '  TRec = record',
+  '    b: specialize TBird<TAnt,word,TAnt>;',
+  '  end;',
+  '  generic TBird<T: class; U; V: TAnt> = class',
+  '    i: U;',
+  '    r: TRec;',
+  '  end;',
+  'var',
+  '  s: TRec;',
+  '  w: word;',
+  'begin',
+  '  s.b.i:=w;',
+  '  s.b.r:=s;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintNameMismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class;',
+  '  generic TBird<U> = class',
+  '    i: U;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintKeywordMismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T: class, constructor> = class;',
+  '  generic TBird<U: class> = class',
+  '    i: U;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "U" differs from previous declaration at afile.pp(5,18)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForwardConstraintTypeMismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  TFish = class end;',
+  '  generic TBird<T: TAnt> = class;',
+  '  generic TBird<T: TFish> = class',
+  '    i: U;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,20)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassForward_Circle;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TAnt<T> = class;',
+  '  generic TFish<U> = class',
+  '    private type AliasU = U;',
+  '    var a: TAnt<AliasU>;',
+  '        Size: AliasU;',
+  '  end;',
+  '  generic TAnt<T> = class',
+  '    private type AliasT = T;',
+  '    var f: TFish<AliasT>;',
+  '        Speed: AliasT;',
+  '  end;',
+  'var',
+  '  WordFish: specialize TFish<word>;',
+  '  BoolAnt: specialize TAnt<boolean>;',
+  '  w: word;',
+  '  b: boolean;',
+  'begin',
+  '  WordFish.Size:=w;',
+  '  WordFish.a.Speed:=w;',
+  '  WordFish.a.f.Size:=w;',
+  '  BoolAnt.Speed:=b;',
+  '  BoolAnt.f.Size:=b;',
+  '  BoolAnt.f.a.Speed:=b;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_RedeclareInUnitImplFail;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class v: T; end;',
+  'implementation',
+  'type generic TBird<T> = record v: T; end;',
+  '']);
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,16)',
+    nDuplicateIdentifier);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_Method;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  {#Typ}T = word;',
+  '  generic TBird<{#Templ}T> = class',
+  '    function Fly(p:T): T; virtual; abstract;',
+  '    function Run(p:T): T;',
+  '  end;',
+  'function TBird.Run(p:T): T;',
+  'begin',
+  'end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  '  {=Typ}w: T;',
+  'begin',
+  '  w:=b.Fly(w);',
+  '  w:=b.Run(w);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_MethodDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  {#Typ}T = word;',
+  '  TBird<{#Templ}T> = class',
+  '    function Fly(p:T): T; virtual; abstract;',
+  '    function Run(p:T): T;',
+  '  end;',
+  'function TBird<T>.Run(p:T): T;',
+  'begin',
+  'end;',
+  'var',
+  '  b: TBird<word>;',
+  '  {=Typ}w: T;',
+  'begin',
+  '  w:=b.Fly(w);',
+  '  w:=b.Run(w);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_SpecializeSelfInside;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    e: T;',
+  '    v: TBird<boolean>;',
+  '  end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  '  w: word;',
+  'begin',
+  '  b.e:=w;',
+  '  if b.v.e then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_GenAncestor;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    i: T;',
+  '  end;',
+  '  generic TEagle<T> = class(TBird<T>)',
+  '    j: T;',
+  '  end;',
+  'var',
+  '  e: specialize TEagle<word>;',
+  'begin',
+  '  e.i:=e.j;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_AncestorSelfFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class(TBird<word>)',
+  '    e: T;',
+  '  end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  'begin',
+  '']);
+  CheckResolverException('type "TBird<>" is not yet completely defined',nTypeXIsNotYetCompletelyDefined);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_NestedType;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  public type',
+  '    TArrayEvent = reference to procedure(El: T);',
+  '  public',
+  '    p: TArrayEvent;',
+  '  end;',
+  '  TBirdWord = specialize TBird<word>;',
+  'var',
+  '  b: TBirdWord;',
+  'begin',
+  '  b.p:=procedure(El: word) begin end;']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_NestedRecord;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch advancedrecords}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  public type TWing = record',
+  '      s: T;',
+  '      function GetIt: T;',
+  '    end;',
+  '  public',
+  '    w: TWing;',
+  '  end;',
+  '  TBirdWord = specialize TBird<word>;',
+  'function TBird.TWing.GetIt: T;',
+  'begin',
+  'end;',
+  'var',
+  '  b: TBirdWord;',
+  '  i: word;',
+  'begin',
+  '  b.w.s:=i;',
+  '  i:=b.w.GetIt;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_NestedClass;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  public type TWing = class',
+  '      s: T;',
+  '      function GetIt: T;',
+  '    end;',
+  '  public',
+  '    w: TWing;',
+  '  end;',
+  '  TBirdWord = specialize TBird<word>;',
+  'function TBird.TWing.GetIt: T;',
+  'begin',
+  'end;',
+  'var',
+  '  b: TBirdWord;',
+  '  i: word;',
+  'begin',
+  '  b.w.s:=3;',
+  '  i:=b.w.GetIt;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_Enums_NotPropagating;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  public type',
+  '    TEnum = (red, blue);',
+  '  const',
+  '    e = blue;',
+  '  end;',
+  'const',
+  '  r = red;',
+  'begin']);
+  CheckResolverException('identifier not found "red"',nIdentifierNotFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_List;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TList<T> = class',
+  '  strict private',
+  '    FItems: array of T;',
+  '    function GetItems(Index: longint): T;',
+  '    procedure SetItems(Index: longint; Value: T);',
+  '  public',
+  '    procedure Alter(w: T);',
+  '    property Items[Index: longint]: T read GetItems write SetItems; default;',
+  '  end;',
+  '  TWordList = specialize TList<word>;',
+  'function TList.GetItems(Index: longint): T;',
+  'begin',
+  '  Result:=FItems[Index];',
+  'end;',
+  'procedure TList.SetItems(Index: longint; Value: T);',
+  'begin',
+  '  FItems[Index]:=Value;',
+  'end;',
+  'procedure TList.Alter(w: T);',
+  'begin',
+  '  SetLength(FItems,length(FItems)+1);',
+  '  Insert(w,FItems,2);',
+  '  Delete(FItems,2,3);',
+  'end;',
+  'var l: TWordList;',
+  '  w: word;',
+  'begin',
+  '  l[1]:=w;',
+  '  w:=l[2];']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ExtClass_Array;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  '{$ModeSwitch externalclass}',
+  'type',
+  '  NativeInt = longint;',
+  '  TJSGenArray<T> = Class external name ''Array''',
+  '  private',
+  '    function GetElements(Index: NativeInt): T; external name ''[]'';',
+  '    procedure SetElements(Index: NativeInt; const AValue: T); external name ''[]'';',
+  '  public',
+  '    type TSelfType = TJSGenArray<T>;',
+  '    TArrayEvent = reference to function(El: T; Arr: TSelfType): Boolean;',
+  '    TArrayCallback = TArrayEvent;',
+  '  public',
+  '    FLength : NativeInt; external name ''length'';',
+  '    constructor new; overload;',
+  '    constructor new(aLength : NativeInt); overload;',
+  '    class function _of() : TSelfType; varargs; external name ''of'';',
+  '    function every(const aCallback: TArrayCallBack): boolean; overload;',
+  '    function fill(aValue : T) : TSelfType; overload;',
+  '    function fill(aValue : T; aStartIndex : NativeInt) : TSelfType; overload;',
+  '    function fill(aValue : T; aStartIndex,aEndIndex : NativeInt) : TSelfType; overload;',
+  '    property Length : NativeInt Read FLength Write FLength;',
+  '    property Elements[Index: NativeInt]: T read GetElements write SetElements; default;',
+  '  end;',
+  '  TJSWordArray = TJSGenArray<word>;',
+  'var',
+  '  wa: TJSWordArray;',
+  '  w: word;',
+  'begin',
+  '  wa:=TJSWordArray.new;',
+  '  wa:=TJSWordArray.new(3);',
+  '  wa:=TJSWordArray._of(4,5);',
+  '  wa:=wa.fill(7);',
+  '  wa:=wa.fill(7,8,9);',
+  '  w:=wa.length;',
+  '  wa.length:=10;',
+  '  wa[11]:=w;',
+  '  w:=wa[12];',
+  '  wa.every(function(El: word; Arr: TJSWordArray): Boolean',
+  '           begin',
+  '           end',
+  '      );',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassInterface;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {$interfaces corba}',
+  '  generic ICorbaIntf<T> = interface',
+  '    procedure Fly(a: T);',
+  '  end;',
+  '  {$interfaces com}',
+  '  IUnknown = interface',
+  '  end;',
+  '  IInterface = IUnknown;',
+  '  generic IComIntf<T> = interface',
+  '    procedure Run(b: T);',
+  '  end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassInterface_Method;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {$interfaces corba}',
+  '  generic IBird<T> = interface',
+  '    procedure Fly(a: T);',
+  '  end;',
+  '  TObject = class end;',
+  '  generic TBird<U> = class(IBird<U>)',
+  '    procedure Fly(a: U);',
+  '  end;',
+  'procedure TBird.Fly(a: U);',
+  'begin',
+  'end;',
+  'var b: specialize IBird<word>;',
+  'begin',
+  '  b.Fly(3);']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Array;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  generic TArray<T> = array of T;',
+  '  TWordArray = specialize TArray<word>;',
+  'var',
+  '  a: specialize TArray<word>;',
+  '  b: TWordArray;',
+  '  w: word;',
+  'begin',
+  '  a[1]:=2;',
+  '  b[2]:=a[3]+b[4];',
+  '  a:=b;',
+  '  b:=a;',
+  '  SetLength(a,5);',
+  '  SetLength(b,6);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ProcType;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  generic TFunc<T> = function(v: T): T;',
+  '  TWordFunc = specialize TFunc<word>;',
+  'function GetIt(w: word): word;',
+  'begin',
+  'end;',
+  'var',
+  '  a: specialize TFunc<word>;',
+  '  b: TWordFunc;',
+  '  w: word;',
+  'begin',
+  '  a:=nil;',
+  '  b:=nil;',
+  '  a:=b;',
+  '  b:=a;',
+  '  w:=a(w);',
+  '  w:=b(w);',
+  '  a:=@GetIt;',
+  '  b:=@GetIt;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_GenericFunction;
+begin
+  exit;
+  StartProgram(false);
+  Add([
+  'generic function DoIt<T>(a: T): T;',
+  'var i: T;',
+  'begin',
+  '  a:=i;',
+  '  Result:=a;',
+  'end;',
+  'var w: word;',
+  'begin',
+  //'  w:=DoIt<word>(3);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_LocalVar;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<{#Templ}T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  'function TBird.Fly(p:T): T;',
+  'var l: T;',
+  'begin',
+  '  l:=p;',
+  '  p:=l;',
+  '  Result:=p;',
+  '  Result:=l;',
+  '  l:=Result;',
+  'end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  '  w: word;',
+  'begin',
+  '  w:=b.Fly(w);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Statements;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<{#Templ}T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  'function TBird.Fly(p:T): T;',
+  'var',
+  '  v1,v2,v3:T;',
+  'begin',
+  '  v1:=1;',
+  '  v2:=v1+v1*v1+v1 div p;',
+  '  v3:=-v1;',
+  '  repeat',
+  '    v1:=v1+1;',
+  '  until v1>=5;',
+  '  while v1>=0 do',
+  '    v1:=v1-v2;',
+  '  for v1:=v2 to v3 do v2:=v1;',
+  '  if v1<v2 then v3:=v1 else v3:=v2;',
+  '  if v1<v2 then else ;',
+  '  case v1 of',
+  '  1: v3:=3;',
+  '  end;',
+  'end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  'begin',
+  '  b.Fly(2);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_InlineSpecializeExpr;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    constructor Create;',
+  '  end;',
+  '  generic TAnt<U> = class',
+  '    constructor Create;',
+  '  end;',
+  'constructor TBird.Create;',
+  'var',
+  '  a: TAnt<T>;',
+  '  b: TAnt<word>;',
+  'begin',
+  '  a:=TAnt<T>.create;',
+  '  b:=TAnt<word>.create;',
+  'end;',
+  'constructor TAnt.Create;',
+  'var',
+  '  i: TBird<U>;',
+  '  j: TBird<word>;',
+  '  k: TAnt<U>;',
+  'begin',
+  '  i:=TBird<U>.create;',
+  '  j:=TBird<word>.create;',
+  '  k:=TAnt<U>.create;',
+  'end;',
+  'var a: TAnt<word>;',
+  'begin',
+  '  a:=TAnt<word>.create;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_TryExcept;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<{#Templ}T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  '  Exception = class',
+  '  end;',
+  '  generic EMsg<T> = class',
+  '    Msg: T;',
+  '  end;',
+  'function TBird.Fly(p:T): T;',
+  'var',
+  '  v1,v2,v3:T;',
+  'begin',
+  '  try',
+  '  finally',
+  '  end;',
+  '  try',
+  '    v1:=v2;',
+  '  finally',
+  '    v2:=v1;',
+  '  end;',
+  '  try',
+  '  except',
+  '    on Exception do ;',
+  '    on E: Exception do ;',
+  '    on E: EMsg<boolean> do E.Msg:=true;',
+  '    on E: EMsg<T> do E.Msg:=1;',
+  '  end;',
+  'end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  'begin',
+  '  b.Fly(2);',
+  '']);
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);
 

+ 53 - 8
packages/fcl-passrc/tests/tcresolver.pas

@@ -68,7 +68,7 @@ type
     procedure ReleaseUsedUnits;
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; AVisibility: TPasMemberVisibility;
-      const ASrcPos: TPasSourcePos): TPasElement;
+      const ASrcPos: TPasSourcePos; TypeParams: TFPList = nil): TPasElement;
       overload; override;
     function FindUnit(const AName, InFilename: String; NameExpr,
       InFileExpr: TPasExpr): TPasModule; override;
@@ -360,6 +360,7 @@ type
     Procedure TestUnitUseIntf;
     Procedure TestUnitUseImplFail;
     Procedure TestUnit_DuplicateUsesFail;
+    Procedure TestUnit_DuplicateUsesIntfImplFail;
     Procedure TestUnit_NestedFail;
     Procedure TestUnitUseDotted;
     Procedure TestUnit_ProgramDefaultNamespace;
@@ -452,6 +453,7 @@ type
     Procedure TestProc_ImplicitCalls;
     Procedure TestProc_Absolute;
     Procedure TestProc_LocalInit;
+    Procedure TestProc_ExtNamePropertyFail;
 
     // anonymous procs
     Procedure TestAnonymousProc_Assign;
@@ -763,6 +765,7 @@ type
 
     // arrays
     Procedure TestDynArrayOfLongint;
+    Procedure TestDynArrayOfSelfFail;
     Procedure TestStaticArray;
     Procedure TestStaticArrayOfChar;
     Procedure TestStaticArrayOfCharDelphi;
@@ -1012,9 +1015,9 @@ end;
 
 function TTestEnginePasResolver.CreateElement(AClass: TPTreeElement;
   const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility;
-  const ASrcPos: TPasSourcePos): TPasElement;
+  const ASrcPos: TPasSourcePos; TypeParams: TFPList): TPasElement;
 begin
-  Result:=inherited CreateElement(AClass, AName, AParent, AVisibility, ASrcPos);
+  Result:=inherited CreateElement(AClass, AName, AParent, AVisibility, ASrcPos, TypeParams);
   if (FModule=nil) and AClass.InheritsFrom(TPasModule) then
     Module:=TPasModule(Result);
 end;
@@ -5673,6 +5676,28 @@ begin
     nParserDuplicateIdentifier);
 end;
 
+procedure TTestResolver.TestUnit_DuplicateUsesIntfImplFail;
+begin
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'type number = longint;']),
+    LinesToStr([
+    '']));
+
+  StartUnit(true);
+  Add([
+  'interface',
+  'uses unit2;',
+  'var j: number;',
+  'implementation',
+  'uses unit2;',
+  'initialization',
+  '  if number(3) then ;',
+  '']);
+  CheckParserException('Duplicate identifier "unit2" at token ";" in file afile.pp at line 6 column 11',
+    nParserDuplicateIdentifier);
+end;
+
 procedure TTestResolver.TestUnit_NestedFail;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',
@@ -5884,8 +5909,8 @@ begin
   '  if unit1.j1=0 then ;',
   '  if unitdots.unit1.j1=0 then ;',
   '']);
-  CheckResolverException('Duplicate identifier "unitdots.unit1" at unitdots.main1.pas(2,14)',
-    nDuplicateIdentifier);
+  CheckParserException('Duplicate identifier "unit1" at token ";" in file unitdots.main1.pas at line 2 column 27',
+    nParserDuplicateIdentifier);
 end;
 
 procedure TTestResolver.TestUnit_Unit1DotUnit2Fail;
@@ -7385,7 +7410,7 @@ begin
   Add('function GetIt: longint; begin end;');
   Add('var s: smallint;');
   Add('begin');
-  Add('   s:=smallint(GetIt);');
+  Add('  s:=smallint(GetIt);');
   ParseProgram;
 end;
 
@@ -7479,6 +7504,16 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProc_ExtNamePropertyFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Foo; external name ''});'' property;',
+  'begin']);
+  CheckParserException('Expected ";" at token "property" in file afile.pp at line 2 column 36',
+    nParserExpectTokenError);
+end;
+
 procedure TTestResolver.TestAnonymousProc_Assign;
 begin
   StartProgram(false);
@@ -9125,7 +9160,7 @@ begin
   Add('begin');
   Add('end;');
   Add('begin');
-  CheckResolverException('identifier not found "TClassA"',nIdentifierNotFound);
+  CheckResolverException('class "TClassA" not found in this module',nClassXNotFoundInThisModule);
 end;
 
 procedure TTestResolver.TestClass_MethodInOtherUnitFail;
@@ -9146,7 +9181,8 @@ begin
   'begin',
   'end;',
   'begin']);
-  CheckResolverException('method class "TObject" in other unit "unit1"',nMethodClassXInOtherUnitY);
+  CheckResolverException('class "TObject" not found in this module',
+    nClassXNotFoundInThisModule);
 end;
 
 procedure TTestResolver.TestClass_MethodWithParams;
@@ -10205,6 +10241,7 @@ begin
   Add('  ProcA(TClassA({@o}o));');
   Add('  if TClassA({@o}o).id=3 then ;');
   Add('  if (o as TClassA).id=3 then ;');
+  Add('  o:=TObject(nil);');
   ParseProgram;
 end;
 
@@ -13755,6 +13792,14 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestDynArrayOfSelfFail;
+begin
+  StartProgram(false);
+  Add('type TIntArray = array of TIntArray;');
+  Add('begin');
+  CheckResolverException(sIllegalExpression,nIllegalExpression);
+end;
+
 procedure TTestResolver.TestStaticArray;
 begin
   StartProgram(false);

+ 49 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -67,6 +67,7 @@ type
     procedure TestM_Const;
     procedure TestM_ResourceString;
     procedure TestM_Record;
+    procedure TestM_RecordGeneric;
     procedure TestM_PointerTyped_Record;
     procedure TestM_Array;
     procedure TestM_NestedFuncResult;
@@ -128,6 +129,7 @@ type
     procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
     procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
     procedure TestM_Hint_FunctionResultRecord;
+    procedure TestM_Hint_FunctionResultRecordEmpty;
     procedure TestM_Hint_FunctionResultPassRecordElement;
     procedure TestM_Hint_FunctionResultAssembler;
     procedure TestM_Hint_FunctionResultExit;
@@ -880,6 +882,34 @@ begin
   AnalyzeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestM_RecordGeneric;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#DoIt_used}DoIt;',
+  'type',
+  '  {#integer_used}integer = longint;',
+  '  {#number_used}number = word;',
+  '  generic {#trec_used}TRec<{#trec_t_notused}T> = record',
+  '    {#a_used}a: integer;',
+  '    {#b_notused}b: integer;',
+  '    {#c_used}c: T;',
+  '  end;',
+  'var',
+  '  {#r_used}r: specialize TRec<number>;',
+  'const',
+  '  ci = 2;',
+  '  cr: specialize TRec<number> = (a:0;b:ci;c:2);',
+  'begin',
+  '  r.a:=3;',
+  '  with r do c:=4;',
+  '  r:=cr;',
+  'end;',
+  'begin',
+  '  DoIt;']);
+  AnalyzeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestM_PointerTyped_Record;
 begin
   StartProgram(false);
@@ -2169,6 +2199,25 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecordEmpty;
+begin
+  StartProgram(true);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  TEmpty = record',
+  '    class function Create: TEmpty; static;',
+  '  end;',
+  'class function TEmpty.Create: TEmpty;',
+  'begin',
+  'end;',
+  'begin',
+  '  TEmpty.Create;',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
 begin
   StartProgram(true);

+ 27 - 15
packages/pastojs/src/fppas2js.pp

@@ -1339,8 +1339,8 @@ type
     procedure ClearOverloadScopes;
   protected
     procedure AddType(El: TPasType); override;
-    procedure AddRecordType(El: TPasRecordType); override;
-    procedure AddClassType(El: TPasClassType); override;
+    procedure AddRecordType(El: TPasRecordType; TypeParams: TFPList); override;
+    procedure AddClassType(El: TPasClassType; TypeParams: TFPList); override;
     procedure AddEnumType(El: TPasEnumType); override;
     procedure ResolveImplAsm(El: TPasImplAsmStatement); override;
     procedure ResolveNameExpr(El: TPasExpr; const aName: string;
@@ -3229,7 +3229,8 @@ begin
     AddElevatedLocal(El);
 end;
 
-procedure TPas2JSResolver.AddRecordType(El: TPasRecordType);
+procedure TPas2JSResolver.AddRecordType(El: TPasRecordType; TypeParams: TFPList
+  );
 begin
   inherited;
   if (El.Name='') and (El.Parent.ClassType<>TPasVariant) then
@@ -3244,9 +3245,9 @@ begin
     AddElevatedLocal(El);
 end;
 
-procedure TPas2JSResolver.AddClassType(El: TPasClassType);
+procedure TPas2JSResolver.AddClassType(El: TPasClassType; TypeParams: TFPList);
 begin
-  inherited AddClassType(El);
+  inherited AddClassType(El,TypeParams);
 end;
 
 procedure TPas2JSResolver.AddEnumType(El: TPasEnumType);
@@ -4906,12 +4907,12 @@ begin
     end;
 
   // search for TIName
-  ResetSubExprScopes(ScopeDepth);
+  ScopeDepth:=StashSubExprScopes;
   FindData:=Default(TPRFindData);
   FindData.ErrorPosEl:=Params;
   Abort:=false;
   IterateElements(TIName,@OnFindFirst,@FindData,Abort);
-  RestoreSubExprScopes(ScopeDepth);
+  RestoreStashedScopes(ScopeDepth);
   {$IFDEF VerbosePas2JS}
   writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName="',TIName,'" FindData.Found="',GetObjName(FindData.Found),'"');
   {$ENDIF}
@@ -12837,6 +12838,8 @@ begin
     Result:=ConvertProcedureType(TPasProcedureType(El),GlobalCtx)
   else if (C=TPasArrayType) then
     Result:=ConvertArrayType(TPasArrayType(El),GlobalCtx)
+  else if (C=TPasSpecializeType) then
+    // specialize type is converted at the generic type
   else
     begin
     {$IFDEF VerbosePas2JS}
@@ -13326,10 +13329,12 @@ var
   aResolver: TPas2JSResolver;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
+  if not aResolver.IsFullySpecialized(El) then exit;
+
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertClassType START ',GetObjName(El));
   {$ENDIF}
-  aResolver:=AContext.Resolver;
   if not (El.ObjKind in [okClass,okInterface,okClassHelper,okRecordHelper,okTypeHelper]) then
     RaiseNotSupported(El,AContext,20170927183645);
   if El.Parent is TProcedureBody then
@@ -13981,8 +13986,11 @@ var
   MethodKind: TMethodKind;
   Obj: TJSObjectLiteral;
   Prop: TJSObjectLiteralElement;
+  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
+  if not aResolver.IsFullySpecialized(El) then exit;
   if El.IsNested then
     DoError(20170222231636,nPasElementNotSupported,sPasElementNotSupported,
       ['is nested'],El);
@@ -14104,8 +14112,11 @@ var
   BracketEx: TJSBracketMemberExpression;
   ArraySt, CloneEl: TJSElement;
   ReturnSt: TJSReturnStatement;
+  aResolver: TPas2JSResolver;
 begin
   Result:=nil;
+  aResolver:=AContext.Resolver;
+  if not aResolver.IsFullySpecialized(El) then exit;
   if El.PackMode<>pmNone then
     DoError(20170222231648,nPasElementNotSupported,sPasElementNotSupported,
        ['packed'],El);
@@ -14118,7 +14129,7 @@ begin
   if AContext.JSElement is TJSSourceElements then
     Src:=TJSSourceElements(AContext.JSElement);
 
-  if AContext.Resolver.HasStaticArrayCloneFunc(El) then
+  if aResolver.HasStaticArrayCloneFunc(El) then
     begin
     // For example: type TArr = array[1..2] of array[1..2] of longint;
     //  this.TStaticArray$clone = function(a){
@@ -14149,7 +14160,7 @@ begin
       ExprLT:=TJSRelationalExpressionLT(CreateElement(TJSRelationalExpressionLT,El));
       ForLoop.Cond:=ExprLT;
       ExprLT.A:=CreatePrimitiveDotExpr(CloneRunName,El);
-      RangeEnd:=AContext.Resolver.GetRangeLength(RangeEl);
+      RangeEnd:=aResolver.GetRangeLength(RangeEl);
       ExprLT.B:=CreateLiteralNumber(RangeEl,RangeEnd);
       // i++
       PlusPlus:=TJSUnaryPostPlusPlusExpression(CreateElement(TJSUnaryPostPlusPlusExpression,El));
@@ -14164,7 +14175,7 @@ begin
       BracketEx.MExpr:=CreatePrimitiveDotExpr(CloneArrName,El);
       BracketEx.Name:=CreatePrimitiveDotExpr(CloneRunName,El);
       // clone a[i]
-      ElType:=AContext.Resolver.ResolveAliasType(El.ElType);
+      ElType:=aResolver.ResolveAliasType(El.ElType);
       CloneEl:=nil;
       if ElType is TPasArrayType then
         begin
@@ -14228,7 +14239,7 @@ begin
       CallName:=GetBIName(pbifnRTTINewDynArray);
     Call:=CreateRTTINewType(El,CallName,false,AContext,Obj);
     try
-      ElType:=AContext.Resolver.ResolveAliasType(El.ElType);
+      ElType:=aResolver.ResolveAliasType(El.ElType);
       if length(El.Ranges)>0 then
         begin
         // static array
@@ -14241,7 +14252,7 @@ begin
         Index:=0;
         repeat
           RangeEl:=Arr.Ranges[Index];
-          RgLen:=AContext.Resolver.GetRangeLength(RangeEl);
+          RgLen:=aResolver.GetRangeLength(RangeEl);
           ArrLit.AddElement(CreateLiteralNumber(RangeEl,RgLen));
           inc(Index);
           if Index=length(Arr.Ranges) then
@@ -14251,7 +14262,7 @@ begin
             Arr:=TPasArrayType(ElType);
             if length(Arr.Ranges)=0 then
               RaiseNotSupported(Arr,AContext,20170411222315,'static array of anonymous array');
-            ElType:=AContext.Resolver.ResolveAliasType(Arr.ElType);
+            ElType:=aResolver.ResolveAliasType(Arr.ElType);
             Index:=0;
             end;
         until false;
@@ -22862,10 +22873,11 @@ begin
   Result:=nil;
   if El.Name='' then
     RaiseNotSupported(El,AContext,20190105101258,'anonymous record');
+  aResolver:=AContext.Resolver;
+  if not aResolver.IsFullySpecialized(El) then exit;
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertRecordType ',GetObjName(El));
   {$ENDIF}
-  aResolver:=AContext.Resolver;
   FuncContext:=nil;
   NewFields:=nil;
   Vars:=nil;

+ 9 - 8
packages/pastojs/src/pas2jscompiler.pp

@@ -2560,12 +2560,16 @@ begin
         begin
         Res:=TPasResString(ResList[i]);
         aValue:=aFile.PascalResolver.Eval(Res.Expr,[refConst],False);
-        if aValue.Kind=revkString then
-           FResourceStrings.AddString(Res.Name,TResEvalString(aValue).S)
-        else if aValue.Kind=revkUnicodeString then
-           FResourceStrings.AddString(Res.Name,TJSONStringType(TResEvalUTF16(aValue).S))
+        case aValue.Kind of
+        {$IFDEF FPC_HAS_CPSTRING}
+        revkString:
+          FResourceStrings.AddString(Res.Name,TResEvalString(aValue).S);
+        {$ENDIF}
+        revkUnicodeString:
+          FResourceStrings.AddString(Res.Name,TJSONStringType(TResEvalUTF16(aValue).S))
         else
           Log.Log(mtNote,sSkipNoConstResourcestring,nSkipNoConstResourcestring,aFile.PasFileName);
+        end;
         ReleaseEvalValue(aValue);
         end;
       end;
@@ -2574,9 +2578,7 @@ begin
   end;
 end;
 
-
 procedure TPas2jsCompiler.WriteResourceStrings(aFileName : String);
-
 Var
   {$IFDEF Pas2js}
   buf: TJSArray;
@@ -2584,7 +2586,6 @@ Var
   buf: TMemoryStream;
   {$ENDIF}
   S : TJSONStringType;
-
 begin
   Log.LogMsg(nWritingFile,[FullFormatPath(aFilename)],'',0,0,False);
   try
@@ -2597,7 +2598,7 @@ begin
       // Note: No UTF-8 BOM in source map, Chrome 59 gives an error
       S:=FResourceStrings.AsString;
       {$ifdef pas2js}
-      aStream.push(S);
+      buf.push(S);
       {$else}
       buf.Write(S[1],length(S));
       {$endif}

+ 33 - 12
packages/pastojs/src/pas2jsfiler.pp

@@ -460,7 +460,8 @@ const
     );
 
   PCUProcedureScopeFlagNames: array[TPasProcedureScopeFlag] of string = (
-    'GrpOverload'
+    'GrpOverload',
+    'ppsfIsSpecialized'
     );
 
   PCUDefaultPSRefAccess = psraRead;
@@ -843,6 +844,7 @@ type
     procedure Set_Variable_VarType(RefEl: TPasElement; Data: TObject);
     procedure Set_AliasType_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_PointerType_DestType(RefEl: TPasElement; Data: TObject);
+    procedure Set_InlineSpecializeExpr_DestType(RefEl: TPasElement; Data: TObject);
     procedure Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
     procedure Set_FileType_ElType(RefEl: TPasElement; Data: TObject);
     procedure Set_SetType_EnumType(RefEl: TPasElement; Data: TObject);
@@ -3326,8 +3328,7 @@ procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext);
 begin
   WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
-  WriteExpr(Obj,Expr,'Name',Expr.NameExpr,aContext);
-  WriteElementList(Obj,Expr,'Params',Expr.Params,aContext);
+  WriteElType(Obj,Expr,'Dest',Expr.DestType,aContext);
 end;
 
 procedure TPCUWriter.WriteRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -3633,6 +3634,7 @@ procedure TPCUWriter.WriteProcedureType(Obj: TJSONObject;
   El: TPasProcedureType; aContext: TPCUWriterContext);
 begin
   WritePasElement(Obj,El,aContext);
+  WriteGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   WriteElementList(Obj,El,'Args',El.Args,aContext);
   if El.CallingConvention<>ccDefault then
     Obj.Add('Call',PCUCallingConventionNames[El.CallingConvention]);
@@ -3760,14 +3762,14 @@ var
   NameParts: TProcedureNameParts;
 begin
   NameParts:=El.NameParts;
-  if length(NameParts)=0 then exit;
+  if (NameParts=nil) or (NameParts.Count=0) then exit;
   Arr:=TJSONArray.Create;
   Obj.Add('NameParts',Arr);
-  for i:=0 to length(NameParts)-1 do
+  for i:=0 to NameParts.Count-1 do
     begin
     NamePartObj:=TJSONObject.Create;
     Arr.Add(NamePartObj);
-    with NameParts[i] do
+    with TProcedureNamePart(NameParts[i]) do
       begin
       NamePartObj.Add('Name',Name);
       if Templates<>nil then
@@ -4247,6 +4249,21 @@ begin
     RaiseMsg(20180211121757,El,GetObjName(RefEl));
 end;
 
+procedure TPCUReader.Set_InlineSpecializeExpr_DestType(RefEl: TPasElement;
+  Data: TObject);
+var
+  El: TInlineSpecializeExpr absolute Data;
+begin
+  if RefEl is TPasSpecializeType then
+    begin
+    El.DestType:=TPasSpecializeType(RefEl);
+    if RefEl.Parent<>El then
+      RefEl.AddRef{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.DestType'){$ENDIF};
+    end
+  else
+    RaiseMsg(20190815192420,El,GetObjName(RefEl));
+end;
+
 procedure TPCUReader.Set_ArrayType_ElType(RefEl: TPasElement; Data: TObject);
 var
   El: TPasArrayType absolute Data;
@@ -6706,10 +6723,7 @@ procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext);
 begin
   Expr.Kind:=pekSpecialize;
-  Expr.NameExpr:=ReadExpr(Obj,Expr,'Name',aContext);
-  ReadElementList(Obj,Expr,'Params',Expr.Params,
-    {$IFDEF CheckPasTreeRefCount}'TPasSpecializeType.Params'{$ELSE}true{$ENDIF},
-    aContext);
+  ReadElType(Obj,'Dest',Expr,@Set_InlineSpecializeExpr_DestType,aContext);
 end;
 
 procedure TPCUReader.ReadRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -7280,6 +7294,7 @@ var
   c: TCallingConvention;
 begin
   ReadPasElement(Obj,El,aContext);
+  ReadGenericTemplateTypes(Obj,El,El.GenericTemplateTypes,aContext);
   ReadElementList(Obj,El,'Args',El.Args,
     {$IFDEF CheckPasTreeRefCount}'TPasProcedureType.Args'{$ELSE}true{$ENDIF},
     aContext);
@@ -7469,15 +7484,21 @@ var
   NamePartObj, TemplObj: TJSONObject;
   GenTypeName: string;
   GenType: TPasGenericTemplateType;
+  NamePart: TProcedureNamePart;
 begin
   ReleaseProcNameParts(El.NameParts);
   if ReadArray(Obj,'NameParts',Arr,El) then
     begin
-    SetLength(El.NameParts,Arr.Count);
+    if El.NameParts=nil then
+      El.NameParts:=TProcedureNameParts.Create
+    else
+      El.NameParts.Clear;
     for i:=0 to Arr.Count-1 do
       begin
       NamePartObj:=CheckJSONObject(Arr[i],20190718113441);
-      with El.NameParts[i] do
+      NamePart:=TProcedureNamePart.Create;
+      El.NameParts.Add(NamePart);
+      with NamePart do
         begin
         if not ReadString(NamePartObj,'Name',Name,El) then
           RaiseMsg(20190718113739,El,IntToStr(i));

+ 3 - 3
packages/pastojs/src/pas2jspparser.pp

@@ -63,7 +63,7 @@ type
   public
     function CreateElement(AClass: TPTreeElement; const AName: String;
       AParent: TPasElement; AVisibility: TPasMemberVisibility;
-      const ASrcPos: TPasSourcePos): TPasElement;
+      const ASrcPos: TPasSourcePos; TypeParams: TFPList = nil): TPasElement;
       overload; override;
     function FindModule(const aUnitname: String): TPasModule; override;
     function FindUnit(const AName, InFilename: String; NameExpr,
@@ -145,11 +145,11 @@ end;
 
 function TPas2jsCompilerResolver.CreateElement(AClass: TPTreeElement;
   const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility;
-  const ASrcPos: TPasSourcePos): TPasElement;
+  const ASrcPos: TPasSourcePos; TypeParams: TFPList): TPasElement;
 begin
   if AClass=TFinalizationSection then
     (CurrentParser as TPas2jsPasParser).RaiseParserError(nFinalizationNotSupported,[]);
-  Result:=inherited CreateElement(AClass,AName,AParent,AVisibility,ASrcPos);
+  Result:=inherited CreateElement(AClass,AName,AParent,AVisibility,ASrcPos,TypeParams);
   if (Result is TPasModule) then
     OnCheckSrcName(Result);
 end;

+ 15 - 11
packages/pastojs/tests/tcfiler.pas

@@ -1360,8 +1360,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredInlineSpecializedExpr(
   const Path: string; Orig, Rest: TInlineSpecializeExpr);
 begin
-  CheckRestoredElement(Path+'.NameExpr',Orig.NameExpr,Rest.NameExpr);
-  CheckRestoredElementList(Path+'.Params',Orig.Params,Rest.Params);
+  CheckRestoredElement(Path+'.DestType',Orig.DestType,Rest.DestType);
 end;
 
 procedure TCustomTestPrecompile.CheckRestoredRangeType(const Path: string;
@@ -1460,6 +1459,7 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredProcedureType(const Path: string;
   Orig, Rest: TPasProcedureType);
 begin
+  CheckRestoredElementList(Path+'.GenericTemplateTypes',Orig.GenericTemplateTypes,Rest.GenericTemplateTypes);
   CheckRestoredElementList(Path+'.Args',Orig.Args,Rest.Args);
   if Orig.CallingConvention<>Rest.CallingConvention then
     Fail(Path+'.CallingConvention Orig='+PCUCallingConventionNames[Orig.CallingConvention]+' Rest='+PCUCallingConventionNames[Rest.CallingConvention]);
@@ -1549,16 +1549,20 @@ var
 begin
   OrigNameParts:=Orig.NameParts;
   RestNameParts:=Rest.NameParts;
-  AssertEquals(Path+'.NameParts length',length(OrigNameParts),length(RestNameParts));
-  for i:=0 to length(OrigNameParts)-1 do
+  AssertEquals(Path+'.NameParts<>nil',OrigNameParts<>nil,RestNameParts<>nil);
+  if OrigNameParts<>nil then
     begin
-    SubPath:=Path+'.NameParts['+IntToStr(i)+']';
-    AssertEquals(SubPath+'.Name',OrigNameParts[i].Name,RestNameParts[i].Name);
-    OrigTemplates:=OrigNameParts[i].Templates;
-    RestTemplates:=RestNameParts[i].Templates;
-    CheckRestoredObject(SubPath+'.Templates',OrigTemplates,RestTemplates);
-    if OrigTemplates=nil then continue;
-    CheckRestoredElementList(SubPath+'.Templates',OrigTemplates,RestTemplates);
+    AssertEquals(Path+'.NameParts.Count',OrigNameParts.Count,RestNameParts.Count);
+    for i:=0 to OrigNameParts.Count-1 do
+      begin
+      SubPath:=Path+'.NameParts['+IntToStr(i)+']';
+      AssertEquals(SubPath+'.Name',TProcedureNamePart(OrigNameParts[i]).Name,TProcedureNamePart(RestNameParts[i]).Name);
+      OrigTemplates:=TProcedureNamePart(OrigNameParts[i]).Templates;
+      RestTemplates:=TProcedureNamePart(RestNameParts[i]).Templates;
+      CheckRestoredObject(SubPath+'.Templates',OrigTemplates,RestTemplates);
+      if OrigTemplates=nil then continue;
+      CheckRestoredElementList(SubPath+'.Templates',OrigTemplates,RestTemplates);
+      end;
     end;
 end;
 

+ 269 - 0
packages/pastojs/tests/tcgenerics.pas

@@ -0,0 +1,269 @@
+unit TCGenerics;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry,
+  TCModules;
+
+type
+
+  { TTestGenerics }
+
+  TTestGenerics = class(TCustomTestModule)
+  Published
+    // generic record
+    Procedure TestGen_RecordEmpty;
+
+    // generic class
+    Procedure TestGen_ClassEmpty;
+    Procedure TestGen_Class_EmptyMethod;
+    Procedure TestGen_Class_TList;
+
+    // generic external class
+    procedure TestGen_ExtClass_Array;
+  end;
+
+implementation
+
+{ TTestGenerics }
+
+procedure TTestGenerics.TestGen_RecordEmpty;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  generic TRecA<T> = record',
+  '  end;',
+  'var a,b: specialize TRecA<word>;',
+  'begin',
+  '  if a=b then ;']);
+  ConvertProgram;
+  CheckSource('TestGen_RecordEmpty',
+    LinesToStr([ // statements
+    'rtl.recNewT($mod, "TRecA$G1", function () {',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '});',
+    'this.a = $mod.TRecA$G1.$new();',
+    'this.b = $mod.TRecA$G1.$new();',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if ($mod.a.$eq($mod.b)) ;'
+    ]));
+end;
+
+procedure TTestGenerics.TestGen_ClassEmpty;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  end;',
+  'var a,b: specialize TBird<word>;',
+  'begin',
+  '  if a=b then ;']);
+  ConvertProgram;
+  CheckSource('TestGen_ClassEmpty',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '});',
+    'this.a = null;',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'if ($mod.a === $mod.b) ;'
+    ]));
+end;
+
+procedure TTestGenerics.TestGen_Class_EmptyMethod;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    function Fly(w: T): T;',
+  '  end;',
+  'function TBird.Fly(w: T): T;',
+  'begin',
+  'end;',
+  'var a: specialize TBird<word>;',
+  'begin',
+  '  if a.Fly(3)=4 then ;']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_EmptyMethod',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.Fly = function (w) {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.a = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '  if ($mod.a.Fly(3) === 4) ;'
+    ]));
+end;
+
+procedure TTestGenerics.TestGen_Class_TList;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TList<T> = class',
+  '  strict private',
+  '    FItems: array of T;',
+  '    function GetItems(Index: longint): T;',
+  '    procedure SetItems(Index: longint; Value: T);',
+  '  public',
+  '    procedure Alter(w: T);',
+  '    property Items[Index: longint]: T read GetItems write SetItems; default;',
+  '  end;',
+  '  TWordList = specialize TList<word>;',
+  'function TList.GetItems(Index: longint): T;',
+  'begin',
+  '  Result:=FItems[Index];',
+  'end;',
+  'procedure TList.SetItems(Index: longint; Value: T);',
+  'begin',
+  '  FItems[Index]:=Value;',
+  'end;',
+  'procedure TList.Alter(w: T);',
+  'begin',
+  '  SetLength(FItems,length(FItems)+1);',
+  '  Insert(w,FItems,2);',
+  '  Delete(FItems,2,3);',
+  'end;',
+  'var l: TWordList;',
+  '  w: word;',
+  'begin',
+  '  l[1]:=w;',
+  '  w:=l[2];',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_TList',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TList$G1", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.FItems = [];',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FItems = undefined;',
+    '    $mod.TObject.$final.call(this);',
+    '  };',
+    '  this.GetItems = function (Index) {',
+    '    var Result = 0;',
+    '    Result = this.FItems[Index];',
+    '    return Result;',
+    '  };',
+    '  this.SetItems = function (Index, Value) {',
+    '    this.FItems[Index] = Value;',
+    '  };',
+    '  this.Alter = function (w) {',
+    '    this.FItems = rtl.arraySetLength(this.FItems, 0, rtl.length(this.FItems) + 1);',
+    '    this.FItems.splice(2, 0, w);',
+    '    this.FItems.splice(2, 3);',
+    '  };',
+    '});',
+    'this.l = null;',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.l.SetItems(1, $mod.w);',
+    '$mod.w = $mod.l.GetItems(2);',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_ExtClass_Array;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  '{$ModeSwitch externalclass}',
+  'type',
+  '  NativeInt = longint;',
+  '  TJSGenArray<T> = Class external name ''Array''',
+  '  private',
+  '    function GetElements(Index: NativeInt): T; external name ''[]'';',
+  '    procedure SetElements(Index: NativeInt; const AValue: T); external name ''[]'';',
+  '  public',
+  '    type TSelfType = TJSGenArray<T>;',
+  '  public',
+  '    FLength : NativeInt; external name ''length'';',
+  '    constructor new; overload;',
+  '    constructor new(aLength : NativeInt); overload;',
+  '    class function _of() : TSelfType; varargs; external name ''of'';',
+  '    function fill(aValue : T) : TSelfType; overload;',
+  '    function fill(aValue : T; aStartIndex : NativeInt) : TSelfType; overload;',
+  '    function fill(aValue : T; aStartIndex,aEndIndex : NativeInt) : TSelfType; overload;',
+  '    property Length : NativeInt Read FLength Write FLength;',
+  '    property Elements[Index: NativeInt]: T read GetElements write SetElements; default;',
+  '  end;',
+  '  TJSWordArray = TJSGenArray<word>;',
+  'var',
+  '  wa: TJSWordArray;',
+  '  w: word;',
+  'begin',
+  '  wa:=TJSWordArray.new;',
+  '  wa:=TJSWordArray.new(3);',
+  '  wa:=TJSWordArray._of(4,5);',
+  '  wa:=wa.fill(7);',
+  '  wa:=wa.fill(7,8,9);',
+  '  w:=wa.length;',
+  '  wa.length:=10;',
+  '  wa[11]:=w;',
+  '  w:=wa[12];',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ExtClass_Array',
+    LinesToStr([ // statements
+    'this.wa = null;',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.wa = new Array();',
+    '$mod.wa = new Array(3);',
+    '$mod.wa = Array.of(4, 5);',
+    '$mod.wa = $mod.wa.fill(7);',
+    '$mod.wa = $mod.wa.fill(7, 8, 9);',
+    '$mod.w = $mod.wa.length;',
+    '$mod.wa.length = 10;',
+    '$mod.wa[11] = $mod.w;',
+    '$mod.w = $mod.wa[12];',
+    '']));
+end;
+
+Initialization
+  RegisterTests([TTestGenerics]);
+end.
+

+ 27 - 3
packages/pastojs/tests/tcmodules.pas

@@ -4952,7 +4952,7 @@ begin
   '  f: TMyEnum = Green;',
   'begin',
   '  e:=green;']);
-  SetExpectedPasResolverError('not yet implemented: Red:TPasEnumValue [20180126202434] enum const',3002);
+  SetExpectedPasResolverError('not yet implemented: Red:TPasEnumValue [20180126202434] "enum const"',3002);
   ConvertProgram;
 end;
 
@@ -10477,6 +10477,12 @@ begin
   'procedure Fly(d: jsvalue; const c: jsvalue);',
   'begin',
   'end;',
+  'procedure Run(d: TRecord; const c: TRecord; var v: TRecord);',
+  'begin',
+  '  if jsvalue(d) then ;',
+  '  if jsvalue(c) then ;',
+  '  if jsvalue(v) then ;',
+  'end;',
   'var',
   '  Jv: jsvalue;',
   '  Rec: trecord;',
@@ -10485,6 +10491,8 @@ begin
   '  jv:=rec;',
   '  Fly(rec,rec);',
   '  Fly(@rec,@rec);',
+  '  if jsvalue(Rec) then ;',
+  '  Run(trecord(jv),trecord(jv),rec);',
   '']);
   ConvertProgram;
   CheckSource('TestRecord_JSValue',
@@ -10501,6 +10509,11 @@ begin
     '});',
     'this.Fly = function (d, c) {',
     '};',
+    'this.Run = function (d, c, v) {',
+    '  if (d) ;',
+    '  if (c) ;',
+    '  if (v) ;',
+    '};',
     'this.Jv = undefined;',
     'this.Rec = $mod.TRecord.$new();',
     '']),
@@ -10509,6 +10522,8 @@ begin
     '$mod.Jv = $mod.Rec;',
     '$mod.Fly($mod.TRecord.$clone($mod.Rec), $mod.Rec);',
     '$mod.Fly($mod.Rec, $mod.Rec);',
+    'if ($mod.Rec) ;',
+    '$mod.Run($mod.TRecord.$clone(rtl.getObject($mod.Jv)), rtl.getObject($mod.Jv), $mod.Rec);',
     '']));
 end;
 
@@ -10718,7 +10733,7 @@ begin
   'var',
   '  r: record x: word end;',
   'begin']);
-  SetExpectedPasResolverError('not yet implemented: :TPasRecordType [20190408224556] anonymous record type',
+  SetExpectedPasResolverError('not yet implemented: :TPasRecordType [20190408224556] "anonymous record type"',
     nNotYetImplemented);
   ConvertProgram;
 end;
@@ -11308,7 +11323,7 @@ begin
   '  end;',
   'begin',
   '']);
-  SetExpectedPasResolverError('not yet implemented: IBird:TPasClassType [20190105143752] interface inside record',
+  SetExpectedPasResolverError('not yet implemented: IBird:TPasClassType [20190105143752] "interface inside record"',
     nNotYetImplemented);
   ParseProgram;
 end;
@@ -13223,6 +13238,7 @@ begin
   Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit());');
   Add('  tcontrol(obj):=tcontrol(tcontrol(obj).getit(1));');
   Add('  tcontrol(obj):=tcontrol(tcontrol(tcontrol(obj).getit).arr[2]);');
+  Add('  obj:=tcontrol(nil);');
   ConvertProgram;
   CheckSource('TestClass_TypeCast',
     LinesToStr([ // statements
@@ -13261,6 +13277,7 @@ begin
     '$mod.Obj = $mod.Obj.GetIt(0);',
     '$mod.Obj = $mod.Obj.GetIt(1);',
     '$mod.Obj = $mod.Obj.GetIt(0).Arr[2];',
+    '$mod.Obj = null;',
     '']));
 end;
 
@@ -25809,6 +25826,10 @@ procedure TTestModule.TestJSValue_If;
 begin
   StartProgram(false);
   Add([
+  'procedure Fly(var u);',
+  'begin',
+  '  if jsvalue(u) then ;',
+  'end;',
   'var',
   '  v: jsvalue;',
   'begin',
@@ -25819,6 +25840,9 @@ begin
   ConvertProgram;
   CheckSource('TestJSValue_If',
     LinesToStr([ // statements
+    'this.Fly = function (u) {',
+    '  if (u.get()) ;',
+    '};',
     'this.v = undefined;',
     '']),
     LinesToStr([ // $mod.$main

+ 6 - 1
packages/pastojs/tests/testpas2js.lpi

@@ -37,7 +37,7 @@
         <PackageName Value="FCL"/>
       </Item2>
     </RequiredPackages>
-    <Units Count="12">
+    <Units Count="13">
       <Unit0>
         <Filename Value="testpas2js.pp"/>
         <IsPartOfProject Value="True"/>
@@ -93,6 +93,11 @@
         <IsPartOfProject Value="True"/>
         <UnitName Value="Pas2jsUseAnalyzer"/>
       </Unit11>
+      <Unit12>
+        <Filename Value="tcgenerics.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="TCGenerics"/>
+      </Unit12>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 2 - 2
packages/pastojs/tests/testpas2js.pp

@@ -20,8 +20,8 @@ uses
   {$IFDEF EnableMemCheck}
   MemCheck,
   {$ENDIF}
-  Classes, consoletestrunner, tcconverter, tcmodules, tcoptimizations, tcsrcmap,
-  tcfiler, Pas2JsFiler, tcunitsearch, tcprecompile, pas2jsuseanalyzer;
+  Classes, consoletestrunner, tcconverter, TCModules, tcoptimizations, tcsrcmap,
+  tcfiler, tcunitsearch, tcprecompile, TCGenerics;
 
 type
 

+ 3 - 2
utils/pas2js/dist/rtl.js

@@ -280,7 +280,7 @@ var rtl = {
       // if root is an "object" then c.$ancestor === Object.getPrototypeOf(c)
       // if root is a "function" then c.$ancestor === c.__proto__, Object.getPrototypeOf(c) returns the root
     } else {
-      c = {};
+      c = { $ancestor: null };
       c.$create = function(fn,args){
         if (args == undefined) args = [];
         var o = Object.create(this);
@@ -355,7 +355,7 @@ var rtl = {
       c.$ancestor = ancestor;
       // c.$ancestor === Object.getPrototypeOf(c)
     } else {
-      c = {};
+      c = { $ancestor: null };
     };
     parent[name] = c;
     c.$class = c; // Note: o.$class === Object.getPrototypeOf(o)
@@ -1058,6 +1058,7 @@ var rtl = {
         s=' '+s;
         l++;
       };
+      return s;
     };
   },
 

部分文件因为文件数量过多而无法显示