Browse Source

# revisions: 42759,42769,42770,42771,42811,42818,42819,42824,42826,42827,42828,42830,42866,42869,42870,42874,42877,42878,42880,42881,42889,42890,42893,42894,42895,42896,42918,42948,42950,42951,42952,42953,42954,43020,43021,43031,43032,43049,43050,43051,43052,43053,43056,43057,43077,43078,43079,43084,43090,43099,43101,43145,43146,43147,43148,43149,43150,43151,43159,43160,43161,43164,43166,43168

git-svn-id: branches/fixes_3_2@43379 -
marco 5 years ago
parent
commit
95202dc8c4

+ 2 - 10
packages/fcl-json/src/jsonscanner.pp

@@ -257,14 +257,6 @@ begin
       FCurToken := Result;
       exit;
       end;
-  // Empty line
-  if (FTokenStr=FEOL) then
-    begin
-    Result := tkWhiteSpace;
-    FCurToken := Result;
-    exit;
-    end;
-
 
   FCurTokenString := '';
   case FTokenStr^ of
@@ -278,13 +270,13 @@ begin
       Result := tkWhitespace;
       repeat
         Inc(FTokenStr);
-        if (FTokenStr[0] = #0) or (FTokenStr=FEOL) then
+        if FTokenStr[0] = #0 then
           if not FetchLine then
           begin
             FCurToken := Result;
             exit;
           end;
-      until not (FTokenStr[0] in [#9, ' ',#10, #13]);
+      until not (FTokenStr[0] in [#9, ' ']);
       end;
     '"','''':
       begin

+ 13 - 51
packages/fcl-json/tests/testjsonparser.pp

@@ -70,7 +70,6 @@ type
     Procedure TestHandlerResult;
     Procedure TestHandlerResultStream;
     Procedure TestEmptyLine;
-    procedure TestBug36037Part2;
   end;
 
 implementation
@@ -541,23 +540,20 @@ begin
 end;
 
 procedure TTestParser.TestEmptyLine;
-
 // Bug report 36037
-
-Const
-  MyJSON =
-    '  {'+sLineBreak+
-    '  "pylib__linux" : "libpython3.7m.so.1.0",'+sLineBreak+
-    '  "ui_toolbar_theme": "default_24x24",'+sLineBreak+
-    '  "ui_toolbar_show" : true,'+sLineBreak+
-    '  "font_name__linux" : "DejaVu Sans Mono",'+sLineBreak+
-    '  "font_size__linux" : 10,'+sLineBreak+
-    '    "ui_listbox_fuzzy": false,'+sLineBreak+
-    '    "ui_max_size_lexer": 5,'+sLineBreak+
-    '    "find_separate_form": false,'+sLineBreak+sLineBreak+
-    '}';
-var
-  J : TJSONData;
+Const MyJSON =
+'  {'+sLineBreak+
+'  "pylib__linux" : "libpython3.7m.so.1.0",'+sLineBreak+
+'  "ui_toolbar_theme": "default_24x24",'+sLineBreak+
+'  "ui_toolbar_show" : true,'+sLineBreak+
+'  "font_name__linux" : "DejaVu Sans Mono",'+sLineBreak+
+'  "font_size__linux" : 10,'+sLineBreak+
+'    "ui_listbox_fuzzy": false,'+sLineBreak+
+'    "ui_max_size_lexer": 5,'+sLineBreak+
+'    "find_separate_form": false,'+sLineBreak+sLineBreak+
+'}';
+  var
+    J : TJSONData;
 begin
   With TJSONParser.Create(MyJSON,[joUTF8,joIgnoreTrailingComma]) do
   Try
@@ -568,40 +564,6 @@ begin
   end;
 end;
 
-procedure TTestParser.TestBug36037Part2;
-
-Const
-  MyJSON =
-
-'{'+sLineBreak+
-'  "tab_spaces": true,'+sLineBreak+
-'  //auto-indent kind:'+sLineBreak+
-'  //  0: indent like in prev line'+sLineBreak+
-'  //  1: by spaces'+sLineBreak+
-'  //  2: by tabs+spaces'+sLineBreak+
-'  //  3: by tabs only'+sLineBreak+
-'  "indent_kind": 1,'+sLineBreak+
-'  "indent_size": 4,'+sLineBreak+
-''+sLineBreak+
-'  "saving_trim_spaces": true,'+sLineBreak+
-''+sLineBreak+
-'//  "config_menus_from": "kv-menu JSON.json",'+sLineBreak+
-'    "find_hotkey_replace": "Alt+Enter",'+sLineBreak+
-'    "fold_style": 4,'+sLineBreak+
-'}'+sLineBreak;
-
-var
-  J : TJSONData;
-begin
-  With TJSONParser.Create(MyJSON,[joUTF8,joIgnoreTrailingComma,joComments]) do
-  Try
-    J:=Parse;
-    J.Free;
-  Finally
-    Free;
-  end;
-end;
-
 procedure TTestParser.DoTestError(S : String; Options : TJSONOptions = DefaultOpts);
 
 Var

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

@@ -193,13 +193,18 @@ const
   nConstraintXSpecifiedMoreThanOnce = 3127;
   nConstraintXAndConstraintYCannotBeTogether = 3128;
   nXIsNotAValidConstraint = 3129;
-  nWrongNumberOfParametersForGenericType = 3130;
+  nWrongNumberOfParametersForGenericX = 3130;
   nGenericsWithoutSpecializationAsType = 3131;
   nDeclOfXDiffersFromPrevAtY = 3132;
   nTypeParamXIsMissingConstraintY = 3133;
   nTypeParamXIsNotCompatibleWithY = 3134;
   nTypeParamXMustSupportIntfY = 3135;
   nTypeParamsNotAllowedOnX = 3136;
+  nXMethodsCannotHaveTypeParams = 3137;
+  nImplMustNotRepeatConstraints = 3138;
+  nCouldNotInferTypeArgXForMethodY = 3139;
+  nInferredTypeXFromDiffArgsMismatchFromMethodY = 3140;
+  nParamOfThisTypeCannotHaveDefVal = 3141;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -340,13 +345,18 @@ resourcestring
   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';
+  sWrongNumberOfParametersForGenericX = 'wrong number of parameters for generic %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';
+  sXMethodsCannotHaveTypeParams = '%s methods cannot have type parameters';
+  sImplMustNotRepeatConstraints = 'Implementations must not repeat constraints';
+  sCouldNotInferTypeArgXForMethodY = 'Could not infer generic type argument "%s" for method "%s"';
+  sInferredTypeXFromDiffArgsMismatchFromMethodY = 'Inferred type "%s" from different arguments mismatch for method "%s"';
+  sParamOfThisTypeCannotHaveDefVal = 'Parameters of this type cannot have default values';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }
@@ -787,9 +797,10 @@ function CodePointToUnicodeString(u: longword): UnicodeString;
 
 function GetObjName(o: TObject): string;
 function GetObjPath(o: TObject): string;
-function GetTypeParamCommas(Cnt: integer): string;
+function GetGenericParamCommas(Cnt: integer): string;
 function dbgs(const Flags: TResEvalFlags): string; overload;
 function dbgs(v: TResEvalValue): string; overload;
+function LastPos(c: char; const s: string): sizeint;
 
 implementation
 
@@ -1018,7 +1029,7 @@ begin
       GenType:=TPasGenericType(o);
       if (GenType.GenericTemplateTypes<>nil)
           and (GenType.GenericTemplateTypes.Count>0) then
-        Result:=Result+GetTypeParamCommas(GenType.GenericTemplateTypes.Count);
+        Result:=Result+GetGenericParamCommas(GenType.GenericTemplateTypes.Count);
       end;
     Result:=Result+':'+o.ClassName;
     end
@@ -1044,7 +1055,7 @@ begin
         GenType:=TPasGenericType(El);
         if (GenType.GenericTemplateTypes<>nil)
             and (GenType.GenericTemplateTypes.Count>0) then
-          Result:=GetTypeParamCommas(GenType.GenericTemplateTypes.Count)+Result;
+          Result:=GetGenericParamCommas(GenType.GenericTemplateTypes.Count)+Result;
         end;
       if El.Name<>'' then
         begin
@@ -1062,7 +1073,7 @@ begin
     Result:=GetObjName(o);
 end;
 
-function GetTypeParamCommas(Cnt: integer): string;
+function GetGenericParamCommas(Cnt: integer): string;
 begin
   if Cnt<=0 then
     Result:=''
@@ -1094,6 +1105,15 @@ begin
     Result:=v.AsDebugString;
 end;
 
+function LastPos(c: char; const s: string): sizeint;
+var
+  i: SizeInt;
+begin
+  for i:=length(s) downto 1 do
+    if s[i]=c then exit(i);
+  Result:=-1;
+end;
+
 { TResEvalExternal }
 
 constructor TResEvalExternal.Create;

File diff suppressed because it is too large
+ 384 - 216
packages/fcl-passrc/src/pasresolver.pp


+ 57 - 23
packages/fcl-passrc/src/pastree.pp

@@ -192,6 +192,7 @@ type
     class property GlobalRefCount: NativeInt read FGlobalRefCount write FGlobalRefCount;
     {$endif}
   end;
+  TPasElementArray = array of TPasElement;
 
   TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
      pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
@@ -558,10 +559,10 @@ type
     function GetDeclaration(full : boolean) : string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    procedure AddConstraint(Expr: TPasExpr);
+    procedure AddConstraint(El: TPasElement);
   Public
     TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
-    Constraints: TPasExprArray;
+    Constraints: TPasElementArray; // list of TPasExpr or TPasType, can be nil!
   end;
 
   { TPasGenericType - abstract base class for all types which can be generics }
@@ -589,7 +590,6 @@ type
     function GetDeclaration(full: boolean) : string; override;
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
-    procedure AddParam(El: TPasElement);
   public
     Params: TFPList; // list of TPasType or TPasExpr
   end;
@@ -605,7 +605,8 @@ type
     procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
       const Arg: Pointer); override;
   public
-    DestType: TPasSpecializeType;
+    NameExpr: TPasExpr;
+    Params: TFPList; // list of TPasType
   end;
 
   { TPasClassOfType }
@@ -644,7 +645,7 @@ type
     IndexRange : string; // only valid if Parser po_arrayrangeexpr disabled
     Ranges: TPasExprArray; // only valid if Parser po_arrayrangeexpr enabled
     PackMode : TPackMode;
-    ElType: TPasType;
+    ElType: TPasType; // nil means array-of-const
     function IsGenericArray : Boolean;
     function IsPacked : Boolean;
     procedure AddRange(Range: TPasExpr);
@@ -1053,7 +1054,7 @@ type
     Name: string;
     Templates: TFPList; // optional list of TPasGenericTemplateType, can be nil!
   end;
-  TProcedureNameParts = TFPList;
+  TProcedureNameParts = TFPList; // list of TProcedureNamePart
                         
   TProcedureBody = class;
 
@@ -1083,7 +1084,7 @@ type
     AliasName : String;
     ProcType : TPasProcedureType;
     Body : TProcedureBody;
-    NameParts: TProcedureNameParts; // only used for generic functions
+    NameParts: TProcedureNameParts; // only used for generic aka parametrized functions
     Procedure AddModifier(AModifier : TProcedureModifier);
     Function IsVirtual : Boolean;
     Function IsDynamic : Boolean;
@@ -1743,15 +1744,15 @@ const
 
 procedure ReleaseAndNil(var El: TPasElement {$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF}); overload;
 procedure ReleaseGenericTemplateTypes(var GenericTemplateTypes: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
+procedure ReleaseElementList(ElList: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
 function GenericTemplateTypesAsString(List: TFPList): string;
+procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
 
 {$IFDEF HasPTDumpStack}
 procedure PTDumpStack;
 function GetPTDumpStack: string;
 {$ENDIF}
 
-procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
-
 implementation
 
 uses SysUtils;
@@ -1779,6 +1780,21 @@ begin
   FreeAndNil(GenericTemplateTypes);
 end;
 
+procedure ReleaseElementList(ElList: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  if ElList=nil then exit;
+  for i := 0 to ElList.Count - 1 do
+    begin
+    El:=TPasElement(ElList[i]);
+    if El<>nil then
+      El.Release{$IFDEF CheckPasTreeRefCount}(Id){$ENDIF};
+    end;
+  ElList.Clear;
+end;
+
 function GenericTemplateTypesAsString(List: TFPList): string;
 var
   i, j: Integer;
@@ -1944,13 +1960,13 @@ begin
     ForEachChildCall(aMethodCall,Arg,Constraints[i],false);
 end;
 
-procedure TPasGenericTemplateType.AddConstraint(Expr: TPasExpr);
+procedure TPasGenericTemplateType.AddConstraint(El: TPasElement);
 var
   l: Integer;
 begin
   l:=Length(Constraints);
   SetLength(Constraints,l+1);
-  Constraints[l]:=Expr;
+  Constraints[l]:=El;
 end;
 
 {$IFDEF HasPTDumpStack}
@@ -2038,11 +2054,17 @@ 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(DestType){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
+  TPasElement(NameExpr).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+  for i:=0 to Params.Count-1 do
+    TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
+  FreeAndNil(Params);
   inherited Destroy;
 end;
 
@@ -2052,15 +2074,29 @@ begin
 end;
 
 function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string;
+var
+  i: Integer;
 begin
-  Result:=DestType.GetDeclaration(full);
+  Result:='specialize '+NameExpr.GetDeclaration(false)+'<';
+  for i:=0 to Params.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
+    end;
+  Result:=Result+'>';
+  if full then ;
 end;
 
 procedure TInlineSpecializeExpr.ForEachCall(
   const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
+var
+  i: Integer;
 begin
   inherited ForEachCall(aMethodCall, Arg);
-  ForEachChildCall(aMethodCall,Arg,DestType,false);
+  ForEachChildCall(aMethodCall,Arg,NameExpr,false);
+  for i:=0 to Params.Count-1 do
+    ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
 end;
 
 { TPasSpecializeType }
@@ -2115,11 +2151,6 @@ begin
     ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
 end;
 
-procedure TPasSpecializeType.AddParam(El: TPasElement);
-begin
-  Params.Add(El);
-end;
-
 { TInterfaceSection }
 
 function TInterfaceSection.ElementTypeName: string;
@@ -4668,14 +4699,17 @@ procedure TPasProcedure.ForEachCall(const aMethodCall: TOnForEachPasElement;
   const Arg: Pointer);
 var
   i, j: Integer;
+  Templates: TFPList;
 begin
   inherited ForEachCall(aMethodCall, Arg);
   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);
+      begin
+      Templates:=TProcedureNamePart(NameParts[i]).Templates;
+      if Templates<>nil then
+        for j:=0 to Templates.Count-1 do
+          ForEachChildCall(aMethodCall,Arg,TPasElement(Templates[j]),false);
+      end;
   ForEachChildCall(aMethodCall,Arg,ProcType,false);
   ForEachChildCall(aMethodCall,Arg,PublicName,false);
   ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);

+ 155 - 56
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -252,6 +252,7 @@ type
     function ElementVisited(El: TPasElement; Mode: TPAUseMode): boolean; overload;
     function ElementVisited(El: TPasElement; OtherCheck: TPAOtherCheckedEl): boolean; overload;
     procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess);
+    function CanSkipGenericType(El: TPasGenericType): boolean;
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
@@ -264,6 +265,7 @@ type
     procedure UseExprRef(El: TPasElement; Expr: TPasExpr;
       Access: TResolvedRefAccess; UseFull: boolean); virtual;
     procedure UseInheritedExpr(El: TInheritedExpr); virtual;
+    procedure UseInlineSpecializeExpr(El: TInlineSpecializeExpr); virtual;
     procedure UseScopeReferences(Refs: TPasScopeReferences); virtual;
     procedure UseProcedure(Proc: TPasProcedure); virtual;
     procedure UseProcedureType(ProcType: TPasProcedureType); virtual;
@@ -300,6 +302,7 @@ type
     function IsExport(El: TPasElement): boolean;
     function IsIdentifier(El: TPasElement): boolean;
     function IsImplBlockEmpty(El: TPasImplBlock): boolean;
+    function IsSpecializedGenericType(El: TPasElement): boolean;
     procedure EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
       MsgNumber: integer; Fmt: String;
       const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
@@ -1007,6 +1010,47 @@ begin
     CheckImplRef;
 end;
 
+function TPasAnalyzer.CanSkipGenericType(El: TPasGenericType): boolean;
+
+  procedure RaiseHalfSpecialized;
+  var
+    GenScope: TPasGenericScope;
+    Item: TPRSpecializedItem;
+  begin
+    if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
+      RaiseNotSupported(20190817151437,El);
+    if not (El.CustomData is TPasGenericScope) then
+      RaiseNotSupported(20190826141320,El,GetObjName(El.CustomData));
+    GenScope:=TPasGenericScope(El.CustomData);
+    Item:=GenScope.SpecializedFromItem;
+    if Item=nil then
+      RaiseNotSupported(20190826141352,El);
+    if Item.SpecializedEl=nil then
+      RaiseNotSupported(20190826141516,El);
+    if Item.FirstSpecialize=nil then
+      RaiseNotSupported(20190826141649,El);
+    RaiseNotSupported(20190826141540,El,'SpecializedAt:'+GetObjPath(Item.FirstSpecialize)+' '+Resolver.GetElementSourcePosStr(Item.FirstSpecialize));
+  end;
+
+begin
+  Result:=false;
+  if ScopeModule=nil then
+    begin
+    // analyze whole program
+    if not Resolver.IsFullySpecialized(El) then
+      RaiseHalfSpecialized;
+    end
+  else
+    begin
+    // analyze a module
+    if ((El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0)) then
+      // generic template -> analyze
+    else if not Resolver.IsFullySpecialized(El) then
+      // half specialized -> skip
+      exit(true);
+    end;
+end;
+
 procedure TPasAnalyzer.UseElement(El: TPasElement; Access: TResolvedRefAccess;
   UseFull: boolean);
 var
@@ -1102,8 +1146,7 @@ begin
   else if C=TPasArrayType then
     begin
     ArrType:=TPasArrayType(El);
-    if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ArrType) then
-      RaiseNotSupported(20190817151437,ArrType);
+    if CanSkipGenericType(ArrType) then exit;
     UseSubEl(ArrType.ElType);
     for i:=0 to length(ArrType.Ranges)-1 do
       begin
@@ -1117,6 +1160,7 @@ begin
   else if C=TPasClassType then
     begin
     ClassEl:=TPasClassType(El);
+    if CanSkipGenericType(ClassEl) then exit;
     if ClassEl.ObjKind=okInterface then
       begin
       // mark all used members
@@ -1135,6 +1179,7 @@ begin
   else if C=TPasRecordType then
     begin
     // published record: use all members
+    if CanSkipGenericType(TPasRecordType(El)) then exit;
     Members:=TPasRecordType(El).Members;
     for i:=0 to Members.Count-1 do
       begin
@@ -1149,8 +1194,7 @@ begin
   else if C.InheritsFrom(TPasProcedureType) then
     begin
     ProcType:=TPasProcedureType(El);
-    if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ProcType) then
-      RaiseNotSupported(20190817151554,ProcType);
+    if CanSkipGenericType(ProcType) then exit;
     for i:=0 to ProcType.Args.Count-1 do
       UseSubEl(TPasArgument(ProcType.Args[i]).ArgType);
     if El is TPasFunctionType then
@@ -1480,18 +1524,78 @@ begin
 end;
 
 procedure TPasAnalyzer.UseExpr(El: TPasExpr);
+
+  procedure UseSystemExit;
+  var
+    Params: TPasExprArray;
+    SubEl: TPasElement;
+    Proc: TPasProcedure;
+    ProcScope: TPasProcedureScope;
+    ParentParams: TPRParentParams;
+  begin
+    Resolver.GetParamsOfNameExpr(El,ParentParams);
+    if ParentParams.Params=nil then exit;
+    Params:=ParentParams.Params.Params;
+    if length(Params)<1 then
+      exit;
+    SubEl:=El.Parent;
+    while (SubEl<>nil) and not (SubEl is TPasProcedure) do
+      SubEl:=SubEl.Parent;
+    if SubEl=nil then exit;
+    Proc:=TPasProcedure(SubEl);
+    if not (Proc.ProcType is TPasFunctionType) then
+      RaiseNotSupported(20190825203504,El);
+    ProcScope:=Proc.CustomData as TPasProcedureScope;
+    if ProcScope.DeclarationProc<>nil then
+      Proc:=ProcScope.DeclarationProc;
+    SubEl:=TPasFunctionType(Proc.ProcType).ResultEl;
+    UseElement(SubEl,rraAssign,false);
+  end;
+
+  procedure UseBuilInFuncTypeInfo;
+  var
+    ParentParams: TPRParentParams;
+    ParamResolved: TPasResolverResult;
+    SubEl: TPasElement;
+    Params: TPasExprArray;
+  begin
+    Resolver.GetParamsOfNameExpr(El,ParentParams);
+    if ParentParams.Params=nil then
+      RaiseNotSupported(20190225150136,El);
+    Params:=ParentParams.Params.Params;
+    if length(Params)<>1 then
+      RaiseNotSupported(20180226144217,El.Parent);
+    Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
+    {$IFDEF VerbosePasAnalyzer}
+    writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
+    {$ENDIF}
+    if ParamResolved.IdentEl=nil then
+      RaiseNotSupported(20180628155107,Params[0]);
+    if (ParamResolved.IdentEl is TPasProcedure)
+        and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
+      begin
+      SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
+      MarkImplScopeRef(El,SubEl,psraTypeInfo);
+      UseTypeInfo(SubEl);
+      end
+    else
+      begin
+      SubEl:=ParamResolved.IdentEl;
+      MarkImplScopeRef(El,SubEl,psraTypeInfo);
+      UseTypeInfo(SubEl);
+      end;
+    // the parameter is not used otherwise
+  end;
+
 var
   Ref: TResolvedReference;
   C: TClass;
   Params: TPasExprArray;
   i: Integer;
   BuiltInProc: TResElDataBuiltInProc;
-  ParamResolved: TPasResolverResult;
   Decl: TPasElement;
   ModScope: TPasModuleScope;
   Access: TResolvedRefAccess;
-  SubEl: TPasElement;
-  ParamsExpr: TParamsExpr;
 begin
   if El=nil then exit;
   // Note: expression itself is not marked, but it can reference identifiers
@@ -1544,52 +1648,12 @@ begin
         case BuiltInProc.BuiltIn of
         bfExit:
           begin
-          ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
-          if ParamsExpr<>nil then
-            begin
-            Params:=(El.Parent as TParamsExpr).Params;
-            if length(Params)=1 then
-              begin
-              SubEl:=El.Parent;
-              while (SubEl<>nil) and not (SubEl is TPasProcedure) do
-                SubEl:=SubEl.Parent;
-              if (SubEl is TPasProcedure)
-                  and (TPasProcedure(SubEl).ProcType is TPasFunctionType) then
-                begin
-                SubEl:=TPasFunctionType(TPasProcedure(SubEl).ProcType).ResultEl;
-                UseElement(SubEl,rraAssign,false);
-                end;
-              end;
-            end;
+          UseSystemExit;
+          exit;
           end;
         bfTypeInfo:
           begin
-          ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
-          if ParamsExpr=nil then
-            RaiseNotSupported(20190225150136,El);
-          Params:=ParamsExpr.Params;
-          if length(Params)<>1 then
-            RaiseNotSupported(20180226144217,El.Parent);
-          Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
-          {$IFDEF VerbosePasAnalyzer}
-          writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
-          {$ENDIF}
-          if ParamResolved.IdentEl=nil then
-            RaiseNotSupported(20180628155107,Params[0]);
-          if (ParamResolved.IdentEl is TPasProcedure)
-              and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
-            begin
-            SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
-            MarkImplScopeRef(El,SubEl,psraTypeInfo);
-            UseTypeInfo(SubEl);
-            end
-          else
-            begin
-            SubEl:=ParamResolved.IdentEl;
-            MarkImplScopeRef(El,SubEl,psraTypeInfo);
-            UseTypeInfo(SubEl);
-            end;
-          // the parameter is not used otherwise
+          UseBuilInFuncTypeInfo;
           exit;
           end;
         bfAssert:
@@ -1640,6 +1704,8 @@ begin
     UseInheritedExpr(TInheritedExpr(El))
   else if C=TProcedureExpr then
     UseProcedure(TProcedureExpr(El).Proc)
+  else if C=TInlineSpecializeExpr then
+    UseInlineSpecializeExpr(TInlineSpecializeExpr(El))
   else
     RaiseNotSupported(20170307085444,El);
 end;
@@ -1749,6 +1815,15 @@ begin
     end;
 end;
 
+procedure TPasAnalyzer.UseInlineSpecializeExpr(El: TInlineSpecializeExpr);
+var
+  i: Integer;
+begin
+  for i:=0 to El.Params.Count-1 do
+    UseType(TPasType(El.Params[i]),paumElement);
+  UseExpr(El.NameExpr);
+end;
+
 procedure TPasAnalyzer.UseScopeReferences(Refs: TPasScopeReferences);
 begin
   if Refs=nil then exit;
@@ -1913,8 +1988,7 @@ begin
     else if C=TPasArrayType then
       begin
       ArrType:=TPasArrayType(El);
-      if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ArrType) then
-        RaiseNotSupported(20190817151449,ArrType);
+      if CanSkipGenericType(ArrType) then exit;
       if not MarkElementAsUsed(ArrType) then exit;
       for i:=0 to length(ArrType.Ranges)-1 do
         UseExpr(ArrType.Ranges[i]);
@@ -1944,7 +2018,10 @@ begin
       UseElType(El,TPasSetType(El).EnumType,Mode);
       end
     else if C.InheritsFrom(TPasProcedureType) then
-      UseProcedureType(TPasProcedureType(El))
+      begin
+      if CanSkipGenericType(TPasProcedureType(El)) then exit;
+      UseProcedureType(TPasProcedureType(El));
+      end
     else if C=TPasSpecializeType then
       UseSpecializeType(TPasSpecializeType(El),Mode)
     else if C=TPasGenericTemplateType then
@@ -2021,12 +2098,11 @@ var
   aClass: TPasClassType;
 begin
   FirstTime:=true;
-  if (ScopeModule=nil) and not Resolver.IsFullySpecialized(El) then
-    RaiseNotSupported(20190817110919,El);
   case Mode of
   paumAllExports: exit;
   paumAllPasUsable:
     begin
+    if CanSkipGenericType(El) then exit;
     if MarkElementAsUsed(El) then
       ElementVisited(El,Mode)
     else
@@ -2039,7 +2115,10 @@ begin
       end;
     end;
   paumElement:
+    begin
+    if CanSkipGenericType(El) then exit;
     if not MarkElementAsUsed(El) then exit;
+    end
   else
     RaiseInconsistency(20170414152143,IntToStr(ord(Mode)));
   end;
@@ -2537,6 +2616,8 @@ begin
       if Usage=nil then
         begin
         // declaration was never used
+        if IsSpecializedGenericType(Decl) then
+          continue;
         EmitMessage(20170311231734,mtHint,nPALocalXYNotUsed,
           sPALocalXYNotUsed,[Decl.ElementTypeName,Decl.Name],Decl);
         end;
@@ -2566,6 +2647,7 @@ begin
       begin
       if (El is TPasClassType) and (TPasClassType(El).ObjKind=okInterface) then
         exit;
+      if IsSpecializedGenericType(El) then exit;
 
       EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
         sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
@@ -2625,7 +2707,7 @@ begin
     begin
     // write without read
     if (vmExternal in El.VarModifiers)
-        or ((El.Parent is TPasClassType) and (TPasClassType(El.Parent).IsExternal)) then
+        or ((El.Parent is TPasClassType) and TPasClassType(El.Parent).IsExternal) then
       exit;
     if El.Visibility in [visPrivate,visStrictPrivate] then
       EmitMessage(20170311234159,mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
@@ -2657,6 +2739,10 @@ begin
     ImplProc:=El
   else
     ImplProc:=ProcScope.ImplProc;
+  if (ProcScope.ClassRecScope<>nil)
+      and (ProcScope.ClassRecScope.SpecializedFromItem<>nil) then
+    exit; // specialized proc
+
   if not PAElementExists(DeclProc) then
     begin
     // procedure never used
@@ -2956,6 +3042,19 @@ begin
   Result:=false;
 end;
 
+function TPasAnalyzer.IsSpecializedGenericType(El: TPasElement): boolean;
+var
+  GenScope: TPasGenericScope;
+begin
+  if El is TPasGenericType then
+    begin
+    GenScope:=El.CustomData as TPasGenericScope;
+    if (GenScope<>nil) and (GenScope.SpecializedFromItem<>nil) then
+      exit(true);
+    end;
+  Result:=false;
+end;
+
 procedure TPasAnalyzer.EmitMessage(Id: TMaxPrecInt; MsgType: TMessageType;
   MsgNumber: integer; Fmt: String;
   const Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};

+ 469 - 331
packages/fcl-passrc/src/pparser.pp

@@ -318,9 +318,9 @@ type
     function GetProcedureClass(ProcType : TProcType): TPTreeElement;
     procedure ParseClassFields(AType: TPasClassType; const AVisibility: TPasMemberVisibility; IsClassField : Boolean);
     procedure ParseClassMembers(AType: TPasClassType);
-    procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
-    procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
-    procedure ReadSpecializeArguments(Spec: TPasSpecializeType);
+    procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility; MustBeGeneric: boolean);
+    procedure ReadGenericArguments(List: TFPList; Parent: TPasElement);
+    procedure ReadSpecializeArguments(Parent: TPasElement; Params: TFPList);
     function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
     function CheckProcedureArgs(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
@@ -331,7 +331,8 @@ type
     procedure ParseExcExpectedIdentifier;
     procedure ParseExcSyntaxError;
     procedure ParseExcTokenError(const Arg: string);
-    procedure ParseTypeParamsNotAllowed;
+    procedure ParseExcTypeParamsNotAllowed;
+    procedure ParseExcExpectedAorB(const A, B: string);
     function OpLevel(t: TToken): Integer;
     Function TokenToExprOp (AToken : TToken) : TExprOpCode;
     function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement): TPasElement;overload;
@@ -433,7 +434,7 @@ type
     // Constant declarations
     function ParseConstDecl(Parent: TPasElement): TPasConst;
     function ParseResourcestringDecl(Parent: TPasElement): TPasResString;
-    function ParseAttributes(Parent: TPasElement): TPasAttributes;
+    function ParseAttributes(Parent: TPasElement; Add: boolean): TPasAttributes;
     // Variable handling. This includes parts of records
     procedure ParseVarDecl(Parent: TPasElement; List: TFPList);
     procedure ParseInlineVarDecl(Parent: TPasElement; List: TFPList;  AVisibility : TPasMemberVisibility  = visDefault; ClosingBrace: Boolean = False);
@@ -458,7 +459,8 @@ type
     procedure ParseProcAsmBlock(Parent: TProcedureBody);
     // Function/Procedure declaration
     function ParseProcedureOrFunctionDecl(Parent: TPasElement;
-      ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
+      ProcType: TProcType; MustBeGeneric: boolean;
+      AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
     procedure ParseArgList(Parent: TPasElement;
       Args: TFPList; // list of TPasArgument
       EndToken: TToken);
@@ -1029,11 +1031,16 @@ begin
   ParseExc(nParserExpectTokenError,SParserExpectTokenError,[Arg]);
 end;
 
-procedure TPasParser.ParseTypeParamsNotAllowed;
+procedure TPasParser.ParseExcTypeParamsNotAllowed;
 begin
   ParseExc(nParserTypeParamsNotAllowedOnType,sParserTypeParamsNotAllowedOnType,[]);
 end;
 
+procedure TPasParser.ParseExcExpectedAorB(const A, B: string);
+begin
+  ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,[A,B]);
+end;
+
 constructor TPasParser.Create(AScanner: TPascalScanner;
   AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
 begin
@@ -1570,7 +1577,8 @@ begin
         ParseExcSyntaxError;
       UnGetToken;
       end
-    else if (CurToken = tkLessThan) then // A = B<t>;
+    else if (CurToken = tkLessThan)
+        and (MustBeSpecialize or (msDelphi in CurrentModeswitches)) then // A = B<t>;
       begin
       Result:=ParseSpecializeType(Parent,TypeName,Name,Expr);
       ok:=true;
@@ -1683,22 +1691,29 @@ begin
     if CurToken=tkLessThan then
       begin
       // specialize
-      Result:=ParseSpecializeType(Parent,'',Name,Expr);
-      NextToken;
+      if IsSpecialize or (msDelphi in CurrentModeswitches) then
+        begin
+        Result:=ParseSpecializeType(Parent,'',Name,Expr);
+        NextToken;
+        end;
       end
     else if IsSpecialize then
       CheckToken(tkLessThan)
     else
       begin
       // simple type reference
-      if not NeedExpr then
-        ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
       Result:=ResolveTypeReference(Name,Parent);
       end;
     ok:=true;
   finally
-    if (not ok) and (Result<>nil) then
-      Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+    if not ok then
+      begin
+      if Result<>nil then
+        Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+      ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
+      end
+    else if (not NeedExpr) and (Expr<>nil) then
+      ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
   end;
 end;
 
@@ -1720,7 +1735,7 @@ begin
       GenNameExpr:=nil; // ownership transferred to ST
       end;
     // read nested specialize arguments
-    ReadSpecializeArguments(ST);
+    ReadSpecializeArguments(ST,ST.Params);
     // Important: resolve type reference AFTER args, because arg count is needed
     ST.DestType:=ResolveTypeReference(GenName,ST,ST.Params.Count);
 
@@ -1741,11 +1756,27 @@ function TPasParser.ParsePointerType(Parent: TPasElement;
 
 var
   ok: Boolean;
+  Name: String;
 begin
   Result := TPasPointerType(CreateElement(TPasPointerType, TypeName, Parent, NamePos));
   ok:=false;
   Try
-    TPasPointerType(Result).DestType := ParseType(Result,CurSourcePos);
+    // only allowed: ^dottedidentifer
+    // forbidden: ^^identifier, ^array of word, ^A<B>
+    ExpectIdentifier;
+    Name:=CurTokenString;
+    repeat
+      NextToken;
+      if CurToken=tkDot then
+        begin
+        ExpectIdentifier;
+        Name := Name+'.'+CurTokenString;
+        end
+      else
+        break;
+    until false;
+    UngetToken;
+    Result.DestType:=ResolveTypeReference(Name,Result);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
   finally
@@ -2303,8 +2334,6 @@ var
   SrcPos, ScrPos: TPasSourcePos;
   ProcType: TProcType;
   ProcExpr: TProcedureExpr;
-  SpecType: TPasSpecializeType;
-
 begin
   Result:=nil;
   CanSpecialize:=aCannot;
@@ -2315,7 +2344,10 @@ begin
     tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
     tkIdentifier:
       begin
-      CanSpecialize:=aCan;
+      if msDelphi in CurrentModeswitches then
+        CanSpecialize:=aCan
+      else
+        CanSpecialize:=aCannot;
       aName:=CurTokenText;
       if (CompareText(aName,'self')=0) and not (tkself in Scanner.NonTokens) then
         Last:=CreateSelfExpr(AParent)
@@ -2473,7 +2505,7 @@ begin
           // an inline specialization (e.g. A<B,C>  or  something.A<B>)
           // check expression in front is an identifier
           Expr:=Result;
-          while Expr.Kind=pekBinary do
+          if Expr.Kind=pekBinary then
             begin
             if Expr.OpCode<>eopSubIdent then
               ParseExcSyntaxError;
@@ -2482,25 +2514,14 @@ begin
           if Expr.Kind<>pekIdent then
             ParseExcSyntaxError;
 
-          // read specialized type
+          // read specialized params
           ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent,SrcPos));
-          SpecType:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE,SrcPos));
-          ISE.DestType:=SpecType;
-          ReadSpecializeArguments(SpecType);
-          // can't resolve SpecType.DestType here
+          ReadSpecializeArguments(ISE,ISE.Params);
 
           // A<B>  or  something.A<B>
-          if Expr.Parent is TBinaryExpr then
-            begin
-            if TBinaryExpr(Expr.Parent).right<>Expr then
-              ParseExcSyntaxError;
-            TBinaryExpr(Expr.Parent).right:=ISE;
-            ISE.Parent:=Expr.Parent;
-            end;
-          SpecType.Expr:=Expr;
-          Expr.Parent:=SpecType;
-          if Expr=Result then
-            Result:=ISE;
+          ISE.NameExpr:=Result;
+          Result.Parent:=ISE;
+          Result:=ISE;
           ISE:=nil;
           CanSpecialize:=aCannot;
           NextToken;
@@ -3427,9 +3448,8 @@ var
   ExpEl: TPasExportSymbol;
   PropEl : TPasProperty;
   PT : TProcType;
-  ok: Boolean;
+  ok, MustBeGeneric: Boolean;
   Proc: TPasProcedure;
-  Attr: TPasAttributes;
   CurEl: TPasElement;
 begin
   CurBlock := declNone;
@@ -3462,7 +3482,9 @@ begin
           ParseImplementation;
           end;
         break;
-        end;
+        end
+      else
+        ParseExcSyntaxError;
     tkinitialization:
       if (Declarations is TInterfaceSection)
       or ((Declarations is TImplementationSection) and not (Declarations is TProgramSection)) then
@@ -3470,7 +3492,9 @@ begin
         SetBlock(declNone);
         ParseInitialization;
         break;
-        end;
+        end
+      else
+        ParseExcSyntaxError;
     tkfinalization:
       if (Declarations is TInterfaceSection)
       or ((Declarations is TImplementationSection) and not (Declarations is TProgramSection)) then
@@ -3510,139 +3534,143 @@ begin
       SetBlock(declProperty);
     tkProcedure, tkFunction, tkConstructor, tkDestructor, tkOperator:
       begin
+      MustBeGeneric:=(not (msDelphi in CurrentModeswitches)) and (GetPrevToken=tkgeneric);
       SetBlock(declNone);
       SaveComments;
       pt:=GetProcTypeFromToken(CurToken);
-      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, false));
+      AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
       end;
     tkClass:
       begin
-        SetBlock(declNone);
-        SaveComments;
-        NextToken;
-        If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
-          begin
-          pt:=GetProcTypeFromToken(CurToken,True);
-          AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, false));
-          end
-        else
-          CheckToken(tkprocedure);
+      MustBeGeneric:=(not (msDelphi in CurrentModeswitches)) and (GetPrevToken=tkgeneric);
+      SetBlock(declNone);
+      SaveComments;
+      NextToken;
+      If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
+        begin
+        pt:=GetProcTypeFromToken(CurToken,True);
+        AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
+        end
+      else
+        CheckToken(tkprocedure);
       end;
     tkIdentifier:
       begin
-        Scanner.UnSetTokenOption(toOperatorToken);
-        SaveComments;
-        case CurBlock of
-          declConst:
-            begin
-              ConstEl := ParseConstDecl(Declarations);
-              Declarations.Declarations.Add(ConstEl);
-              Declarations.Consts.Add(ConstEl);
-              Engine.FinishScope(stDeclaration,ConstEl);
-            end;
-          declResourcestring:
+      Scanner.UnSetTokenOption(toOperatorToken);
+      SaveComments;
+      case CurBlock of
+        declConst:
+          begin
+            ConstEl := ParseConstDecl(Declarations);
+            Declarations.Declarations.Add(ConstEl);
+            Declarations.Consts.Add(ConstEl);
+            Engine.FinishScope(stDeclaration,ConstEl);
+          end;
+        declResourcestring:
+          begin
+            ResStrEl := ParseResourcestringDecl(Declarations);
+            Declarations.Declarations.Add(ResStrEl);
+            Declarations.ResStrings.Add(ResStrEl);
+            Engine.FinishScope(stResourceString,ResStrEl);
+          end;
+        declType:
+          begin
+          TypeEl := ParseTypeDecl(Declarations);
+          // Scanner.SetForceCaret(OldForceCaret); // It may have been switched off
+          if Assigned(TypeEl) then        // !!!
             begin
-              ResStrEl := ParseResourcestringDecl(Declarations);
-              Declarations.Declarations.Add(ResStrEl);
-              Declarations.ResStrings.Add(ResStrEl);
-              Engine.FinishScope(stResourceString,ResStrEl);
-            end;
-          declType:
+            Declarations.Declarations.Add(TypeEl);
+            {$IFDEF CheckPasTreeRefCount}if TypeEl.RefIds.IndexOf('CreateElement')>=0 then TypeEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF}
+            if (TypeEl.ClassType = TPasClassType)
+                and (not (po_keepclassforward in Options)) then
             begin
-            TypeEl := ParseTypeDecl(Declarations);
-            // Scanner.SetForceCaret(OldForceCaret); // It may have been switched off
-            if Assigned(TypeEl) then        // !!!
-              begin
-              Declarations.Declarations.Add(TypeEl);
-              {$IFDEF CheckPasTreeRefCount}if TypeEl.RefIds.IndexOf('CreateElement')>=0 then TypeEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF}
-              if (TypeEl.ClassType = TPasClassType)
-                  and (not (po_keepclassforward in Options)) then
+              // Remove previous forward declarations, if necessary
+              for i := 0 to Declarations.Classes.Count - 1 do
               begin
-                // Remove previous forward declarations, if necessary
-                for i := 0 to Declarations.Classes.Count - 1 do
+                ClassEl := TPasClassType(Declarations.Classes[i]);
+                if CompareText(ClassEl.Name, TypeEl.Name) = 0 then
                 begin
-                  ClassEl := TPasClassType(Declarations.Classes[i]);
-                  if CompareText(ClassEl.Name, TypeEl.Name) = 0 then
-                  begin
-                    Declarations.Classes.Delete(i);
-                    for j := 0 to Declarations.Declarations.Count - 1 do
-                      if CompareText(TypeEl.Name,
-                        TPasElement(Declarations.Declarations[j]).Name) = 0 then
-                      begin
-                        Declarations.Declarations.Delete(j);
-                        break;
-                      end;
-                    ClassEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-                    break;
-                  end;
+                  Declarations.Classes.Delete(i);
+                  for j := 0 to Declarations.Declarations.Count - 1 do
+                    if CompareText(TypeEl.Name,
+                      TPasElement(Declarations.Declarations[j]).Name) = 0 then
+                    begin
+                      Declarations.Declarations.Delete(j);
+                      break;
+                    end;
+                  ClassEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+                  break;
                 end;
-                // Add the new class to the class list
-                Declarations.Classes.Add(TypeEl)
-              end else
-                Declarations.Types.Add(TypeEl);
               end;
+              // Add the new class to the class list
+              Declarations.Classes.Add(TypeEl)
+            end else
+              Declarations.Types.Add(TypeEl);
             end;
-          declExports:
+          end;
+        declExports:
+          begin
+          List := TFPList.Create;
+          try
+            ok:=false;
+            try
+              ParseExportDecl(Declarations, List);
+              ok:=true;
+            finally
+              if not ok then
+                for i := 0 to List.Count - 1 do
+                  TPasExportSymbol(List[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+            end;
+            for i := 0 to List.Count - 1 do
             begin
+              ExpEl := TPasExportSymbol(List[i]);
+              Declarations.Declarations.Add(ExpEl);
+              {$IFDEF CheckPasTreeRefCount}ExpEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF}
+              Declarations.ExportSymbols.Add(ExpEl);
+            end;
+          finally
+            List.Free;
+          end;
+          end;
+        declVar, declThreadVar:
+          begin
             List := TFPList.Create;
             try
-              ok:=false;
-              try
-                ParseExportDecl(Declarations, List);
-                ok:=true;
-              finally
-                if not ok then
-                  for i := 0 to List.Count - 1 do
-                    TPasExportSymbol(List[i]).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-              end;
+              ParseVarDecl(Declarations, List);
               for i := 0 to List.Count - 1 do
               begin
-                ExpEl := TPasExportSymbol(List[i]);
-                Declarations.Declarations.Add(ExpEl);
-                {$IFDEF CheckPasTreeRefCount}ExpEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF}
-                Declarations.ExportSymbols.Add(ExpEl);
+                CurEl := TPasElement(List[i]);
+                Declarations.Declarations.Add(CurEl);
+                if CurEl.ClassType=TPasAttributes then
+                  Declarations.Attributes.Add(CurEl)
+                else
+                  Declarations.Variables.Add(TPasVariable(CurEl));
+                Engine.FinishScope(stDeclaration,CurEl);
               end;
+              CheckToken(tkSemicolon);
             finally
               List.Free;
             end;
-            end;
-          declVar, declThreadVar:
-            begin
-              List := TFPList.Create;
-              try
-                ParseVarDecl(Declarations, List);
-                for i := 0 to List.Count - 1 do
-                begin
-                  CurEl := TPasElement(List[i]);
-                  Declarations.Declarations.Add(CurEl);
-                  if CurEl.ClassType=TPasAttributes then
-                    Declarations.Attributes.Add(CurEl)
-                  else
-                    Declarations.Variables.Add(TPasVariable(CurEl));
-                  Engine.FinishScope(stDeclaration,CurEl);
-                end;
-                CheckToken(tkSemicolon);
-              finally
-                List.Free;
-              end;
-            end;
-          declProperty:
-            begin
-            PropEl:=ParseProperty(Declarations,CurtokenString,visDefault,false);
-            Declarations.Declarations.Add(PropEl);
-            {$IFDEF CheckPasTreeRefCount}PropEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF}
-            Declarations.Properties.Add(PropEl);
-            Engine.FinishScope(stDeclaration,PropEl);
-            end;
-        else
-          ParseExcSyntaxError;
-        end;
+          end;
+        declProperty:
+          begin
+          PropEl:=ParseProperty(Declarations,CurtokenString,visDefault,false);
+          Declarations.Declarations.Add(PropEl);
+          {$IFDEF CheckPasTreeRefCount}PropEl.ChangeRefId('CreateElement','TPasDeclarations.Children');{$ENDIF}
+          Declarations.Properties.Add(PropEl);
+          Engine.FinishScope(stDeclaration,PropEl);
+          end;
+      else
+        ParseExcSyntaxError;
+      end;
       end;
     tkGeneric:
       begin
       NextToken;
       if (CurToken in [tkprocedure,tkfunction]) then
         begin
+        if msDelphi in CurrentModeswitches then
+          ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
         SetBlock(declNone);
         UngetToken;
         end;
@@ -3730,12 +3758,7 @@ begin
       end;
     tkSquaredBraceOpen:
       if msPrefixedAttributes in CurrentModeSwitches then
-        begin
-        Attr:=ParseAttributes(Declarations);
-        Declarations.Declarations.Add(Attr);
-        Declarations.Attributes.Add(Attr);
-        Engine.FinishScope(stDeclaration,Attr);
-        end
+        ParseAttributes(Declarations,true)
       else
         ParseExcSyntaxError;
     else
@@ -4028,11 +4051,14 @@ begin
   end;
 end;
 
-function TPasParser.ParseAttributes(Parent: TPasElement): TPasAttributes;
+function TPasParser.ParseAttributes(Parent: TPasElement; Add: boolean
+  ): TPasAttributes;
+// returns with CurToken at tkSquaredBraceClose
 var
   Expr, Arg: TPasExpr;
   Attributes: TPasAttributes;
   Params: TParamsExpr;
+  Decls: TPasDeclarations;
 begin
   Result:=nil;
   Attributes:=TPasAttributes(CreateElement(TPasAttributes,'',Parent));
@@ -4068,6 +4094,20 @@ begin
     until CurToken<>tkComma;
     CheckToken(tkSquaredBraceClose);
     Result:=Attributes;
+    if Add then
+      begin
+      if Parent is TPasDeclarations then
+        begin
+        Decls:=TPasDeclarations(Parent);
+        Decls.Declarations.Add(Result);
+        Decls.Attributes.Add(Result);
+        end
+      else if Parent is TPasMembersType then
+        TPasMembersType(Parent).Members.Add(Result)
+      else
+        ParseExcTokenError('[20190922193803]');
+      Engine.FinishScope(stDeclaration,Result);
+      end;
   finally
     if Result=nil then
       begin
@@ -4094,36 +4134,38 @@ begin
     if Curtoken = tkColon then
       repeat
         NextToken;
-        // comma separated list: identifier, class, record, constructor
-        if CurToken in [tkclass,tkrecord,tkconstructor] then
+        // comma separated list of constraints: identifier, class, record, constructor
+        case CurToken of
+        tkclass,tkrecord,tkconstructor:
           begin
           if T.TypeConstraint='' then
             T.TypeConstraint:=CurTokenString;
           Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText);
+          T.AddConstraint(Expr);
           NextToken;
-          end
-        else if CurToken=tkIdentifier then
+          end;
+        tkIdentifier,tkspecialize:
           begin
-          TypeEl:=ParseTypeReference(Parent,true,Expr);
-          if TypeEl<>nil then
-            begin
+          TypeEl:=ParseTypeReference(T,false,Expr);
+          if T.TypeConstraint='' then
             T.TypeConstraint:=TypeEl.Name;
-            TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
-            end;
-          end
+          if (Expr<>nil) and (Expr.Parent=T) then
+            Expr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+          T.AddConstraint(TypeEl);
+          end;
         else
           CheckToken(tkIdentifier);
-        T.AddConstraint(Expr);
+        end;
       until CurToken<>tkComma;
     Engine.FinishScope(stTypeDef,T);
   until not (CurToken in [tkSemicolon,tkComma]);
   if CurToken<>tkGreaterThan then
-    ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
-      [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
+    ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan]);
 end;
 {$warn 5043 on}
 
-procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
+procedure TPasParser.ReadSpecializeArguments(Parent: TPasElement;
+  Params: TFPList);
 // after parsing CurToken is on tkGreaterThan
 Var
   TypeEl: TPasType;
@@ -4132,8 +4174,8 @@ begin
   CheckToken(tkLessThan);
   repeat
     //writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
-    TypeEl:=ParseType(Spec,CurTokenPos,'');
-    Spec.AddParam(TypeEl);
+    TypeEl:=ParseType(Parent,CurTokenPos,'');
+    Params.Add(TypeEl);
     NextToken;
     if CurToken=tkComma then
       continue
@@ -4145,8 +4187,7 @@ begin
     else if CurToken=tkGreaterThan then
       break
     else
-      ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
-        [TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
+      ParseExcExpectedAorB(TokenInfos[tkComma], TokenInfos[tkGreaterThan]);
   until false;
 end;
 
@@ -4313,6 +4354,36 @@ function TPasParser.ParseGenericTypeDecl(Parent: TPasElement;
       end;
   end;
 
+  procedure ParseProcType(const TypeName: string;
+    const NamePos: TPasSourcePos; TypeParams: TFPList;
+    IsReferenceTo: boolean);
+  var
+    ProcTypeEl: TPasProcedureType;
+    ProcType: TProcType;
+  begin
+    case CurToken of
+    tkFunction:
+      begin
+      ProcTypeEl := CreateFunctionType(TypeName, 'Result', Parent, False,
+                                       NamePos, TypeParams);
+      ProcType:=ptFunction;
+      end;
+    tkprocedure:
+      begin
+      ProcTypeEl := TPasProcedureType(CreateElement(TPasProcedureType,
+                          TypeName, Parent, visDefault, NamePos, TypeParams));
+      ProcType:=ptProcedure;
+      end;
+    else
+      ParseExcTokenError('procedure or function');
+    end;
+    ProcTypeEl.IsReferenceTo:=IsReferenceTo;
+    if AddToParent and (Parent is TPasDeclarations) then
+      TPasDeclarations(Parent).Functions.Add(ProcTypeEl);
+    InitGenericType(ProcTypeEl,TypeParams);
+    ParseProcedureOrFunction(ProcTypeEl, ProcTypeEl, ProcType, True);
+  end;
+
 var
   TypeName, AExternalNameSpace, AExternalName: String;
   NamePos: TPasSourcePos;
@@ -4320,8 +4391,6 @@ var
   ClassEl: TPasClassType;
   RecordEl: TPasRecordType;
   ArrEl: TPasArrayType;
-  ProcTypeEl: TPasProcedureType;
-  ProcType: TProcType;
   i: Integer;
   AObjKind: TPasObjKind;
 begin
@@ -4392,26 +4461,19 @@ begin
        Engine.FinishScope(stTypeDef,ArrEl);
        end;
     tkprocedure,tkfunction:
-      begin
-      if CurToken=tkFunction then
+      ParseProcType(TypeName,NamePos,TypeParams,false);
+    tkIdentifier:
+      if CurTokenIsIdentifier('reference') then
         begin
-        ProcTypeEl := CreateFunctionType(TypeName, 'Result', Parent, False,
-                                         NamePos, TypeParams);
-        ProcType:=ptFunction;
+        NextToken;
+        CheckToken(tkto);
+        NextToken;
+        ParseProcType(TypeName,NamePos,TypeParams,true);
         end
       else
-        begin
-        ProcTypeEl := TPasProcedureType(CreateElement(TPasProcedureType,
-                            TypeName, Parent, visDefault, NamePos, TypeParams));
-        ProcType:=ptProcedure;
-        end;
-      if AddToParent and (Parent is TPasDeclarations) then
-        TPasDeclarations(Parent).Functions.Add(ProcTypeEl);
-      InitGenericType(ProcTypeEl,TypeParams);
-      ParseProcedureOrFunction(ProcTypeEl, ProcTypeEl, ProcType, True);
-      end;
+        ParseExcTypeParamsNotAllowed;
     else
-      ParseTypeParamsNotAllowed;
+      ParseExcTypeParamsNotAllowed;
     end;
   finally
     for i:=0 to TypeParams.Count-1 do
@@ -4539,7 +4601,10 @@ begin
     while CurToken=tkSquaredBraceOpen do
       begin
       if msPrefixedAttributes in CurrentModeswitches then
-        VarList.Add(ParseAttributes(Parent))
+        begin
+        VarList.Add(ParseAttributes(Parent,false));
+        NextToken;
+        end
       else
         CheckToken(tkIdentifier);
       end;
@@ -6343,6 +6408,7 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
   ): TPasProcedure;
 var
   NameParts: TProcedureNameParts;
+  NamePos: TPasSourcePos;
 
   function ExpectProcName: string;
   { Simple procedure:
@@ -6366,6 +6432,7 @@ var
     Part: TProcedureNamePart;
   begin
     Result:=ExpectIdentifier;
+    NamePos:=CurSourcePos;
     Cnt:=1;
     repeat
       NextToken;
@@ -6375,6 +6442,7 @@ var
           begin
           inc(Cnt);
           CurName:=ExpectIdentifier;
+          NamePos:=CurSourcePos;
           Result:=Result+'.'+CurName;
           if NameParts<>nil then
             begin
@@ -6424,6 +6492,8 @@ var
       else
         break;
     until false;
+    if (NameParts=nil) and MustBeGeneric then
+      CheckToken(tkLessThan);
     UngetToken;
   end;
 
@@ -6452,12 +6522,14 @@ begin
       if (ot=otUnknown) then
         ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
       Name:=OperatorNames[Ot];
+      NamePos:=CurTokenPos;
       end;
     ptAnonymousProcedure,ptAnonymousFunction:
       begin
       Name:='';
       if MustBeGeneric then
         ParseExcTokenError('generic'); // inconsistency
+      NamePos:=CurTokenPos;
       end
     else
       Name:=ExpectProcName;
@@ -6466,7 +6538,7 @@ begin
     if Name<>'' then
       Parent:=CheckIfOverLoaded(Parent,Name);
     Result := TPasProcedure(Engine.CreateElement(PC, Name, Parent, AVisibility,
-                                                 CurSourcePos, NameParts));
+                                                 NamePos, NameParts));
     if NameParts<>nil then
       begin
       if Result.NameParts=nil then
@@ -6623,7 +6695,6 @@ Var
   NamePos: TPasSourcePos;
   OldCount, i: Integer;
   CurEl: TPasElement;
-  Attr: TPasAttributes;
   LastToken: TToken;
 begin
   if AllowMethods then
@@ -6736,11 +6807,7 @@ begin
         end;
       tkSquaredBraceOpen:
         if msPrefixedAttributes in CurrentModeswitches then
-          begin
-          Attr:=ParseAttributes(ARec);
-          ARec.Members.Add(Attr);
-          Engine.FinishScope(stDeclaration,Attr);
-          end
+          ParseAttributes(ARec,true)
         else
           CheckToken(tkIdentifier);
       tkCase :
@@ -6854,14 +6921,15 @@ begin
     ParseExc(nParserExpectVisibility,SParserExpectVisibility);
 end;
 
-procedure TPasParser.ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
+procedure TPasParser.ProcessMethod(AType: TPasClassType; IsClass: Boolean;
+  AVisibility: TPasMemberVisibility; MustBeGeneric: boolean);
 
 var
   Proc: TPasProcedure;
   ProcType: TProcType;
 begin
   ProcType:=GetProcTypeFromToken(CurToken,isClass);
-  Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,false,AVisibility);
+  Proc:=ParseProcedureOrFunctionDecl(AType,ProcType,MustBeGeneric,AVisibility);
   if Proc.Parent is TPasOverloadedProc then
     TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
   else
@@ -6918,14 +6986,41 @@ Var
   T : TPasType;
   Done : Boolean;
 begin
-  // Writeln('Parsing local types');
+  //Writeln('Parsing local types');
+  while (CurToken=tkSquaredBraceOpen)
+      and (msPrefixedAttributes in CurrentModeswitches) do
+    begin
+    ParseAttributes(AType,true);
+    NextToken;
+    end;
   Repeat
     T:=ParseTypeDecl(AType);
     T.Visibility:=AVisibility;
     AType.Members.Add(t);
     // Writeln(CurtokenString,' ',TokenInfos[Curtoken]);
     NextToken;
-    Done:=(Curtoken<>tkIdentifier) or CheckVisibility(CurTokenString,AVisibility);
+    case CurToken of
+    tkgeneric:
+      begin
+      NextToken;
+      if CurToken<>tkIdentifier then
+        Done:=true;
+      UngetToken;
+      end;
+    tkIdentifier:
+      Done:=CheckVisibility(CurTokenString,AVisibility);
+    tkSquaredBraceOpen:
+      if msPrefixedAttributes in CurrentModeswitches then
+        repeat
+          ParseAttributes(AType,true);
+          NextToken;
+          Done:=false;
+        until CurToken<>tkSquaredBraceOpen
+      else
+        Done:=true;
+    else
+      Done:=true;
+    end;
     if Done then
       UngetToken;
   Until Done;
@@ -6940,6 +7035,12 @@ Var
   Done : Boolean;
 begin
   // Writeln('Parsing local consts');
+  while (CurToken=tkSquaredBraceOpen)
+      and (msPrefixedAttributes in CurrentModeswitches) do
+    begin
+    ParseAttributes(AType,true);
+    NextToken;
+    end;
   Repeat
     C:=ParseConstDecl(AType);
     C.Visibility:=AVisibility;
@@ -6950,17 +7051,29 @@ begin
     if CurToken<>tkSemicolon then
       exit;
     NextToken;
-    Done:=(CurToken<>tkIdentifier) or CheckVisibility(CurTokenString,AVisibility);
+    case CurToken of
+    tkIdentifier:
+      Done:=CheckVisibility(CurTokenString,AVisibility);
+    tkSquaredBraceOpen:
+      if msPrefixedAttributes in CurrentModeswitches then
+        repeat
+          ParseAttributes(AType,true);
+          NextToken;
+          Done:=false;
+        until CurToken<>tkSquaredBraceOpen
+      else
+        Done:=true;
+    else
+      Done:=true;
+    end;
     if Done then
       UngetToken;
   Until Done;
 end;
 
 procedure TPasParser.ParseClassMembers(AType: TPasClassType);
-
 Type
   TSectionType = (stNone,stConst,stType,stVar,stClassVar);
-
 Var
   CurVisibility : TPasMemberVisibility;
   CurSection : TSectionType;
@@ -6969,7 +7082,6 @@ Var
   LastToken: TToken;
   PropEl: TPasProperty;
   MethodRes: TPasMethodResolution;
-  Attr: TPasAttributes;
 begin
   CurSection:=stNone;
   haveClass:=false;
@@ -6982,160 +7094,186 @@ begin
     begin
     //writeln('TPasParser.ParseClassMembers LastToken=',LastToken,' CurToken=',CurToken,' haveClass=',haveClass,' CurSection=',CurSection);
     case CurToken of
-      tkType:
+    tkType:
+      begin
+      if haveClass then
+        ParseExcExpectedAorB('Procedure','Function');
+      case AType.ObjKind of
+      okClass,okObject,
+      okClassHelper,okRecordHelper,okTypeHelper: ;
+      else
+        ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['TYPE',ObjKindNames[AType.ObjKind]]);
+      end;
+      CurSection:=stType;
+      NextToken;
+      ParseMembersLocalTypes(AType,CurVisibility);
+      CurSection:=stNone;
+      end;
+    tkConst:
+      begin
+      if haveClass then
+        ParseExcExpectedAorB('Procedure','Var');
+      case AType.ObjKind of
+      okClass,okObject,
+      okClassHelper,okRecordHelper,okTypeHelper: ;
+      else
+        ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CONST',ObjKindNames[AType.ObjKind]]);
+      end;
+      CurSection:=stConst;
+      NextToken;
+      ParseMembersLocalConsts(AType,CurVisibility);
+      CurSection:=stNone;
+      end;
+    tkVar:
+      if not (CurSection in [stVar,stClassVar]) then
         begin
-        case AType.ObjKind of
-        okClass,okObject,
-        okClassHelper,okRecordHelper,okTypeHelper: ;
+        if (AType.ObjKind in okWithFields)
+        or (haveClass and (AType.ObjKind in okAllHelpers)) then
+          // ok
         else
-          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['TYPE',ObjKindNames[AType.ObjKind]]);
-        end;
-        CurSection:=stType;
+          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
+        if LastToken=tkClass then
+          CurSection:=stClassVar
+        else
+          CurSection:=stVar;
         end;
-      tkConst:
+    tkIdentifier:
+      if CheckVisibility(CurTokenString,CurVisibility) then
+        CurSection:=stNone
+      else
         begin
         if haveClass then
-          ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
-            ['Procedure','Var']);
-        case AType.ObjKind of
-        okClass,okObject,
-        okClassHelper,okRecordHelper,okTypeHelper: ;
-        else
-          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CONST',ObjKindNames[AType.ObjKind]]);
-        end;
-        CurSection:=stConst;
-        end;
-      tkVar:
-        if not (CurSection in [stVar,stClassVar]) then
           begin
-          if (AType.ObjKind in okWithFields)
-          or (haveClass and (AType.ObjKind in okAllHelpers)) then
-            // ok
-          else
-            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['VAR',ObjKindNames[AType.ObjKind]]);
-          if LastToken=tkClass then
-            CurSection:=stClassVar
-          else
-            CurSection:=stVar;
-          end;
-      tkIdentifier:
-        if CheckVisibility(CurtokenString,CurVisibility) then
-          CurSection:=stNone
+          if LastToken=tkclass then
+            ParseExcExpectedAorB('Procedure','Function');
+          end
         else
+          SaveComments;
+        Case CurSection of
+        stNone,
+        stVar:
           begin
-          if haveClass then
-            begin
-            if LastToken=tkclass then
-              ParseExcTokenError('procedure or function');
-            end
-          else
-            SaveComments;
-          Case CurSection of
-          stType:
-            ParseMembersLocalTypes(AType,CurVisibility);
-          stConst :
-            ParseMembersLocalConsts(AType,CurVisibility);
-          stNone,
-          stVar:
-            begin
-            if not (AType.ObjKind in okWithFields) then
-              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
-            ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
-            HaveClass:=False;
-            end;
-          stClassVar:
-            begin
-            if not (AType.ObjKind in okWithClassFields) then
-              ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
-            ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
-            HaveClass:=False;
-            end;
-          else
-            Raise Exception.Create('Internal error 201704251415');
+          if not (AType.ObjKind in okWithFields) then
+            ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
+          ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
+          HaveClass:=False;
           end;
-          end;
-      tkConstructor,tkDestructor:
-        begin
-        curSection:=stNone;
-        if not haveClass then
-          SaveComments;
-        case AType.ObjKind of
-        okObject,okClass: ;
-        okClassHelper,okTypeHelper,okRecordHelper:
+        stClassVar:
           begin
-          if (CurToken=tkdestructor) and not haveClass then
-            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
+          if not (AType.ObjKind in okWithClassFields) then
+            ParseExc(nParserNoFieldsAllowed,SParserNoFieldsAllowedInX,[ObjKindNames[AType.ObjKind]]);
+          ParseClassFields(AType,CurVisibility,CurSection=stClassVar);
+          HaveClass:=False;
           end;
         else
-          if CurToken=tkconstructor then
-            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['constructor',ObjKindNames[AType.ObjKind]])
-          else
-            ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
+          Raise Exception.Create('Internal error 201704251415');
         end;
-        ProcessMethod(AType,HaveClass,CurVisibility);
-        haveClass:=False;
         end;
-      tkProcedure,tkFunction:
+    tkConstructor,tkDestructor:
+      begin
+      curSection:=stNone;
+      if not haveClass then
+        SaveComments;
+      case AType.ObjKind of
+      okObject,okClass: ;
+      okClassHelper,okTypeHelper,okRecordHelper:
+        begin
+        if (CurToken=tkdestructor) and not haveClass then
+          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
+        end;
+      else
+        if CurToken=tkconstructor then
+          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['constructor',ObjKindNames[AType.ObjKind]])
+        else
+          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['destructor',ObjKindNames[AType.ObjKind]]);
+      end;
+      ProcessMethod(AType,HaveClass,CurVisibility,false);
+      haveClass:=False;
+      end;
+    tkProcedure,tkFunction:
+      begin
+      curSection:=stNone;
+      IsMethodResolution:=false;
+      if not haveClass then
         begin
-        curSection:=stNone;
-        IsMethodResolution:=false;
-        if not haveClass then
+        SaveComments;
+        if AType.ObjKind=okClass then
           begin
-          SaveComments;
-          if AType.ObjKind=okClass then
+          NextToken;
+          if CurToken=tkIdentifier then
             begin
             NextToken;
-            if CurToken=tkIdentifier then
-              begin
-              NextToken;
-              IsMethodResolution:=CurToken=tkDot;
-              UngetToken;
-              end;
+            IsMethodResolution:=CurToken=tkDot;
             UngetToken;
             end;
+          UngetToken;
           end;
-        if IsMethodResolution then
-          begin
-          MethodRes:=ParseMethodResolution(AType);
-          AType.Members.Add(MethodRes);
-          Engine.FinishScope(stDeclaration,MethodRes);
-          end
-        else
-          ProcessMethod(AType,HaveClass,CurVisibility);
-        haveClass:=False;
         end;
-      tkclass:
+      if IsMethodResolution then
         begin
-        case AType.ObjKind of
-        okClass,okObject,
-        okClassHelper,okRecordHelper,okTypeHelper: ;
-        else
-          ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CLASS',ObjKindNames[AType.ObjKind]]);
-        end;
-        SaveComments;
-        HaveClass:=True;
-        curSection:=stNone;
-        end;
-      tkProperty:
+        MethodRes:=ParseMethodResolution(AType);
+        AType.Members.Add(MethodRes);
+        Engine.FinishScope(stDeclaration,MethodRes);
+        end
+      else
+        ProcessMethod(AType,HaveClass,CurVisibility,false);
+      haveClass:=False;
+      end;
+    tkgeneric:
+      begin
+      if msDelphi in CurrentModeswitches then
+        ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
+      if haveClass and (LastToken=tkclass) then
+        ParseExcTokenError('Generic Class');
+      case AType.ObjKind of
+      okClass,okObject,
+      okClassHelper,okRecordHelper,okTypeHelper: ;
+      else
+        ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['generic',ObjKindNames[AType.ObjKind]]);
+      end;
+      SaveComments;
+      CurSection:=stNone;
+      NextToken;
+      if CurToken=tkclass then
         begin
-        curSection:=stNone;
-        if not haveClass then
-          SaveComments;
-        ExpectIdentifier;
-        PropEl:=ParseProperty(AType,CurtokenString,CurVisibility,HaveClass);
-        AType.Members.Add(PropEl);
-        Engine.FinishScope(stDeclaration,PropEl);
-        HaveClass:=False;
-        end;
-      tkSquaredBraceOpen:
-        if msPrefixedAttributes in CurrentModeswitches then
-          begin
-          Attr:=ParseAttributes(AType);
-          AType.Members.Add(Attr);
-          Engine.FinishScope(stDeclaration,Attr);
-          end
-        else
-          CheckToken(tkIdentifier);
+        haveClass:=true;
+        NextToken;
+        end
+      else
+        haveClass:=false;
+      if not (CurToken in [tkprocedure,tkfunction]) then
+        ParseExcExpectedAorB('Procedure','Function');
+      ProcessMethod(AType,HaveClass,CurVisibility,true);
+      end;
+    tkclass:
+      begin
+      case AType.ObjKind of
+      okClass,okObject,
+      okClassHelper,okRecordHelper,okTypeHelper: ;
+      else
+        ParseExc(nParserXNotAllowedInY,SParserXNotAllowedInY,['CLASS',ObjKindNames[AType.ObjKind]]);
+      end;
+
+      SaveComments;
+      HaveClass:=True;
+      curSection:=stNone;
+      end;
+    tkProperty:
+      begin
+      curSection:=stNone;
+      if not haveClass then
+        SaveComments;
+      ExpectIdentifier;
+      PropEl:=ParseProperty(AType,CurtokenString,CurVisibility,HaveClass);
+      AType.Members.Add(PropEl);
+      Engine.FinishScope(stDeclaration,PropEl);
+      HaveClass:=False;
+      end;
+    tkSquaredBraceOpen:
+      if msPrefixedAttributes in CurrentModeswitches then
+        ParseAttributes(AType,true)
+      else
+        CheckToken(tkIdentifier);
     else
       CheckToken(tkIdentifier);
     end;

+ 6 - 4
packages/fcl-passrc/src/pscanner.pp

@@ -298,7 +298,8 @@ type
     msExternalClass,       { Allow external class definitions }
     msPrefixedAttributes,  { Allow attributes, disable proc modifier [] }
     msOmitRTTI,            { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
-    msMultiHelpers         { off=only one helper per type, on=all }
+    msMultiHelpers,        { off=only one helper per type, on=all }
+    msImplicitFunctionSpec { implicit function specialization }
     );
   TModeSwitches = Set of TModeSwitch;
 
@@ -1001,7 +1002,7 @@ const
     'Tab'
   );
 
-  SModeSwitchNames : array[TModeSwitch] of string{$ifdef fpc}[20]{$endif} =
+  SModeSwitchNames : array[TModeSwitch] of string =
   ( '', // msNone
     '', // Fpc,
     '', // Objfpc,
@@ -1051,7 +1052,8 @@ const
     'EXTERNALCLASS',
     'PREFIXEDATTRIBUTES',
     'OMITRTTI',
-    'MULTIHELPERS'
+    'MULTIHELPERS',
+    'IMPLICITFUNCTIONSPECIALIZATION'
     );
 
   LetterSwitchNames: array['A'..'Z'] of string=(
@@ -1140,7 +1142,7 @@ const
      msPointer2Procedure,msAutoDeref,msTPProcVar,msInitFinal,msDefaultAnsistring,
      msOut,msDefaultPara,msDuplicateNames,msHintDirective,
      msProperty,msDefaultInline,msExcept,msAdvancedRecords,msTypeHelpers,
-     msPrefixedAttributes,msArrayOperators
+     msPrefixedAttributes,msArrayOperators,msImplicitFunctionSpec
      ];
 
   DelphiUnicodeModeSwitches = delphimodeswitches + [msSystemCodePage,msDefaultUnicodestring];

+ 40 - 0
packages/fcl-passrc/tests/tcclasstype.pas

@@ -159,6 +159,8 @@ type
     Procedure TestLocalSimpleTypes;
     Procedure TestLocalSimpleConst;
     Procedure TestLocalSimpleConsts;
+    Procedure TestClassTypeAttributes;
+    Procedure TestClassConstAttributes;
     procedure TestClassHelperEmpty;
     procedure TestClassHelperParentedEmpty;
     procedure TestClassHelperOneMethod;
@@ -1766,6 +1768,44 @@ begin
   AssertEquals('method name','Something', Method3.Name);
 end;
 
+procedure TTestClassType.TestClassTypeAttributes;
+begin
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '  [Black]',
+  '  type',
+  '    [Red]',
+  '    [White]',
+  '    TWord = word;',
+  '    [Blue]',
+  '    [Green]',
+  '    TChar = char;',
+  '  end;',
+  '']);
+  ParseDeclarations;
+end;
+
+procedure TTestClassType.TestClassConstAttributes;
+begin
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '  [Black]',
+  '  const',
+  '    [Red]',
+  '    [White]',
+  '    A = 1;',
+  '    [Blue]',
+  '    [Green]',
+  '    B = 2;',
+  '  end;',
+  '']);
+  ParseDeclarations;
+end;
+
 procedure TTestClassType.TestClassHelperEmpty;
 begin
   StartClassHelper('TOriginal','');

+ 116 - 79
packages/fcl-passrc/tests/tcgenerics.pp

@@ -13,25 +13,35 @@ Type
 
   TTestGenerics = Class(TBaseTestTypeParser)
   Published
+    // generic types
     Procedure TestObjectGenerics;
     Procedure TestRecordGenerics;
     Procedure TestArrayGenerics;
     Procedure TestArrayGenericsDelphi;
     Procedure TestProcTypeGenerics;
+    Procedure TestDeclarationDelphi;
+    Procedure TestDeclarationFPC;
+    Procedure TestMethodImplementation;
+
+    // generic constraints
     Procedure TestGenericConstraint;
     Procedure TestGenericInterfaceConstraint;
     Procedure TestDeclarationConstraint;
+
+    // specialize type
     Procedure TestSpecializationDelphi;
-    Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphiSpecialize;
-    Procedure TestDeclarationFPC;
-    Procedure TestMethodImplementation;
     Procedure TestInlineSpecializationInArgument;
     Procedure TestSpecializeNested;
     Procedure TestInlineSpecializeInStatement;
     Procedure TestInlineSpecializeInStatementDelphi;
+
+    // generic functions
     Procedure TestGenericFunction_Program;
     Procedure TestGenericFunction_Unit;
+
+    // generic method
+    Procedure TestGenericMethod_Program;
   end;
 
 implementation
@@ -89,6 +99,78 @@ begin
   ParseDeclarations;
 end;
 
+procedure TTestGenerics.TestDeclarationDelphi;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
+  Source.Add('    b : T;');
+  Source.Add('    b2 : T2;');
+  Source.Add('  end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
+procedure TTestGenerics.TestDeclarationFPC;
+Var
+  T : TPasClassType;
+begin
+  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
+  Source.Add('Type');
+  Source.Add('  TSomeClass<T;T2> = Class(TObject)');
+  Source.Add('    b : T;');
+  Source.Add('    b2 : T2;');
+  Source.Add('  end;');
+  ParseDeclarations;
+  AssertNotNull('have generic definition',Declarations.Classes);
+  AssertEquals('have generic definition',1,Declarations.Classes.Count);
+  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
+  T:=TPasClassType(Declarations.Classes[0]);
+  AssertNotNull('have generic templates',T.GenericTemplateTypes);
+  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
+  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
+  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
+end;
+
+procedure TTestGenerics.TestMethodImplementation;
+begin
+  With source do
+    begin
+    Add('unit afile;');
+    Add('{$MODE DELPHI}');
+    Add('interface');
+    Add('type');
+    Add('  TTest<T> =  object');
+    Add('    procedure foo(v:T);');
+    Add('    procedure bar<Y>(v:T);');
+    Add('  type');
+    Add('    TSub = class');
+    Add('      procedure DoIt<Y>(v:T);');
+    Add('    end;');
+    Add('  end;');
+    Add('implementation');
+    Add('procedure TTest<T>.foo;');
+    Add('begin');
+    Add('end;');
+    Add('procedure TTest<T>.bar<Y>;');
+    Add('begin');
+    Add('end;');
+    Add('procedure TTest<T>.TSub.DoIt<Y>;');
+    Add('begin');
+    Add('end;');
+    end;
+  ParseModule;
+end;
+
 procedure TTestGenerics.TestGenericConstraint;
 begin
   Add([
@@ -97,7 +179,7 @@ begin
     '  b : T;',
     'end;',
     'Generic TBird<T: class> = class',
-    '  c : TBird<T>;',
+    '  c : specialize TBird<T>;',
     'end;',
     'Generic TEagle<T: record> = class',
     'end;',
@@ -116,11 +198,11 @@ begin
     'TBird = class(TInterfacedObject,TIntfA,TIntfB) end;',
     'Generic TAnt<T: TIntfA, TIntfB> = class',
     '  b: T;',
-    '  c: TAnt<T>;',
+    '  c: specialize TAnt<T>;',
     'end;',
     'Generic TFly<T: TIntfA, TIntfB; S> = class',
     '  b: S;',
-    '  c: TFly<T>;',
+    '  c: specialize TFly<T>;',
     'end;',
     '']);
   ParseDeclarations;
@@ -148,30 +230,10 @@ end;
 
 procedure TTestGenerics.TestSpecializationDelphi;
 begin
+  Add('{$mode delphi}');
   ParseType('TFPGList<integer>',TPasSpecializeType,'');
 end;
 
-procedure TTestGenerics.TestDeclarationDelphi;
-Var
-  T : TPasClassType;
-begin
-  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
-  Source.Add('Type');
-  Source.Add('  TSomeClass<T,T2> = Class(TObject)');
-  Source.Add('    b : T;');
-  Source.Add('    b2 : T2;');
-  Source.Add('  end;');
-  ParseDeclarations;
-  AssertNotNull('have generic definition',Declarations.Classes);
-  AssertEquals('have generic definition',1,Declarations.Classes.Count);
-  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
-  T:=TPasClassType(Declarations.Classes[0]);
-  AssertNotNull('have generic templates',T.GenericTemplateTypes);
-  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
-  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
-  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
-end;
-
 procedure TTestGenerics.TestDeclarationDelphiSpecialize;
 Var
   T : TPasClassType;
@@ -194,57 +256,6 @@ begin
   AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
 end;
 
-procedure TTestGenerics.TestDeclarationFPC;
-Var
-  T : TPasClassType;
-begin
-  Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches;
-  Source.Add('Type');
-  Source.Add('  TSomeClass<T;T2> = Class(TObject)');
-  Source.Add('    b : T;');
-  Source.Add('    b2 : T2;');
-  Source.Add('  end;');
-  ParseDeclarations;
-  AssertNotNull('have generic definition',Declarations.Classes);
-  AssertEquals('have generic definition',1,Declarations.Classes.Count);
-  AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
-  T:=TPasClassType(Declarations.Classes[0]);
-  AssertNotNull('have generic templates',T.GenericTemplateTypes);
-  AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
-  AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
-  AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
-end;
-
-procedure TTestGenerics.TestMethodImplementation;
-begin
-  With source do
-    begin
-    Add('unit afile;');
-    Add('{$MODE DELPHI}');
-    Add('interface');
-    Add('type');
-    Add('  TTest<T> =  object');
-    Add('    procedure foo(v:T);');
-    Add('    procedure bar<Y>(v:T);');
-    Add('  type');
-    Add('    TSub = class');
-    Add('      procedure DoIt<Y>(v:T);');
-    Add('    end;');
-    Add('  end;');
-    Add('implementation');
-    Add('procedure TTest<T>.foo;');
-    Add('begin');
-    Add('end;');
-    Add('procedure TTest<T>.bar<Y>;');
-    Add('begin');
-    Add('end;');
-    Add('procedure TTest<T>.TSub.DoIt<Y>;');
-    Add('begin');
-    Add('end;');
-    end;
-  ParseModule;
-end;
-
 procedure TTestGenerics.TestInlineSpecializationInArgument;
 begin
   With source do
@@ -273,9 +284,13 @@ end;
 procedure TTestGenerics.TestInlineSpecializeInStatement;
 begin
   Add([
+  '{$mode objfpc}',
   'begin',
+  '  vec:=specialize TVector<double>.create;',
   '  t:=specialize a<b>;',
-  '  t:=a.specialize b<c>;',
+  //'  t:=specialize a<b.specialize c<d,e.f>>;',
+  //'  t:=a.specialize b<c>;',
+  '  t:=specialize a<b>.c;',
   '']);
   ParseModule;
 end;
@@ -283,6 +298,7 @@ end;
 procedure TTestGenerics.TestInlineSpecializeInStatementDelphi;
 begin
   Add([
+  '{$mode delphi}',
   'begin',
   '  vec:=TVector<double>.create;',
   '  b:=a<b;',
@@ -322,6 +338,27 @@ begin
   ParseModule;
 end;
 
+procedure TTestGenerics.TestGenericMethod_Program;
+begin
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class',
+  '    generic function Get<T>(val: T) :T;',
+  '  type TBird = word;',
+  '  generic procedure Fly<T>;',
+  '  const C = 1;',
+  '  generic procedure Run<T>;',
+  '  end;',
+  'generic function TObject.Get<T>(val: T) :T;',
+  'begin',
+  'end;',
+  'begin',
+  '  TObject.specialize GetIt<word>(2);',
+  '']);
+  ParseModule;
+end;
+
 initialization
   RegisterTest(TTestGenerics);
 end.

+ 1280 - 71
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -28,12 +28,22 @@ type
     procedure TestGen_ConstraintClassRecordFail;
     procedure TestGen_ConstraintRecordClassFail;
     procedure TestGen_ConstraintArrayFail;
-    // ToDo: constraint constructor
+    procedure TestGen_ConstraintConstructor;
     // ToDo: constraint T:Unit2.TBird
     // ToDo: constraint T:Unit2.TGen<word>
+    procedure TestGen_ConstraintSpecialize;
+    procedure TestGen_ConstraintTSpecializeWithT;
+    procedure TestGen_ConstraintTSpecializeAsTFail;
     procedure TestGen_TemplNameEqTypeNameFail;
     procedure TestGen_ConstraintInheritedMissingRecordFail;
     procedure TestGen_ConstraintInheritedMissingClassTypeFail;
+    procedure TestGen_ConstraintMultiParam;
+    procedure TestGen_ConstraintMultiParamClassMismatch;
+    procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
+    procedure TestGen_ConstraintClassType_ForInT;
+    procedure TestGen_ConstraintClassType_IsAs;
+    // ToDo: A<T:T> fail
+    // ToDo: A<T:B<T>> fail
 
     // generic record
     procedure TestGen_RecordLocalNameDuplicateFail;
@@ -55,23 +65,26 @@ type
     procedure TestGen_ClassForwardConstraintTypeMismatch;
     procedure TestGen_ClassForward_Circle;
     procedure TestGen_Class_RedeclareInUnitImplFail;
-    // ToDo: add another in unit implementation
+    procedure TestGen_Class_AnotherInUnitImpl;
     procedure TestGen_Class_Method;
-    // ToDo: procedure TestGen_Class_MethodOverride;
+    procedure TestGen_Class_MethodOverride;
     procedure TestGen_Class_MethodDelphi;
-    // ToDo: procedure TestGen_Class_MethodDelphiTypeParamMissing;
-    // ToDo: procedure TestGen_Class_MethodImplConstraintFail;
+    procedure TestGen_Class_MethodDelphiTypeParamMissing;
+    procedure TestGen_Class_MethodImplConstraintFail;
+    procedure TestGen_Class_MethodImplTypeParamNameMismatch;
     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
+    procedure TestGen_ClassOfSpecializeFail;
     // 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_Self;
+    procedure TestGen_Class_MemberTypeConstructor;
     procedure TestGen_Class_List;
+    // ToDo: different modeswitches at parse time and specialize time
 
     // generic external class
     procedure TestGen_ExtClass_Array;
@@ -81,32 +94,72 @@ type
     procedure TestGen_ClassInterface_Method;
 
     // generic array
-    procedure TestGen_Array;
+    procedure TestGen_DynArray;
+    procedure TestGen_StaticArray;
+    procedure TestGen_Array_Anoynmous;
 
     // generic procedure type
     procedure TestGen_ProcType;
 
-    // ToDo: pointer of generic
-    // ToDo: PBird = ^TBird<word> fail
+    // pointer of generic
+    procedure TestGen_PointerDirectSpecializeFail;
 
     // ToDo: helpers for generics
-
-    // generic functions
-    procedure TestGen_GenericFunction; // ToDo
-    // ToDo: generic class method overload <T> <S,T>
-    // ToDo: procedure TestGen_GenMethod_ClassConstructorFail;
+    // ToDo: default class prop array helper: arr<b>[c]
 
     // generic statements
     procedure TestGen_LocalVar;
     procedure TestGen_Statements;
     procedure TestGen_InlineSpecializeExpr;
-    // ToDo: for-in
+    // ToDo: a.b<c>(d)
+    // ToDo: with a do b<c>
     procedure TestGen_TryExcept;
-    // ToDo: call
-    // ToDo: dot
-    // ToDo: is as
-    // ToDo: typecast
-    // ToTo: nested proc
+    procedure TestGen_Call;
+    procedure TestGen_NestedProc;
+    // ToDo: obj<b>[c]
+
+    // generic functions
+    procedure TestGenProc_Function;
+    procedure TestGenProc_FunctionDelphi;
+    procedure TestGenProc_OverloadDuplicate;
+    procedure TestGenProc_MissingTemplatesFail;
+    procedure TestGenProc_Forward;
+    procedure TestGenProc_External;
+    procedure TestGenProc_UnitIntf;
+    procedure TestGenProc_BackRef1Fail;
+    procedure TestGenProc_BackRef2Fail;
+    procedure TestGenProc_BackRef3Fail;
+    procedure TestGenProc_CallSelf;
+    procedure TestGenProc_CallSelfNoParams;
+    procedure TestGenProc_ForwardConstraints;
+    procedure TestGenProc_ForwardConstraintsRepeatFail;
+    procedure TestGenProc_ForwardTempNameMismatch;
+    procedure TestGenProc_ForwardOverload;
+    procedure TestGenProc_NestedFail;
+    procedure TestGenProc_TypeParamCntOverload;
+    procedure TestGenProc_TypeParamCntOverloadNoParams;
+    procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
+    procedure TestGenProc_Inference_NeedExplicitFail;
+    procedure TestGenProc_Inference_Overload;
+    procedure TestGenProc_Inference_OverloadForward;
+    procedure TestGenProc_Inference_Var_Overload;
+    //procedure TestGenProc_Inference_Widen;
+    procedure TestGenProc_Inference_DefaultValue;
+    procedure TestGenProc_Inference_DefaultValueMismatch;
+    procedure TestGenProc_Inference_ProcT;
+    procedure TestGenProc_Inference_Mismatch;
+    procedure TestGenProc_Inference_ArrayOfT;
+    // ToDo procedure TestGenProc_Inference_ProcType;
+
+    // generic methods
+    procedure TestGenMethod_VirtualFail;
+    procedure TestGenMethod_ClassInterfaceMethodFail;
+    procedure TestGenMethod_ClassConstructorFail;
+    procedure TestGenMethod_TemplNameDifferFail;
+    procedure TestGenMethod_ImplConstraintFail;
+    procedure TestGenMethod_NestedSelf;
+    procedure TestGenMethod_OverloadTypeParamCnt;
+    procedure TestGenMethod_OverloadArgs;
   end;
 
 implementation
@@ -140,7 +193,7 @@ begin
   StartProgram(false);
   Add([
   'type generic TBird<T> = record end;',
-  'var b: TBird<word, byte>;',
+  'var b: specialize TBird<word, byte>;',
   'begin',
   '']);
   CheckResolverException('identifier not found "TBird<,>"',
@@ -192,10 +245,7 @@ procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
 begin
   StartProgram(false);
   Add([
-  'generic function DoIt<T:string>(a: T): T;',
-  'begin',
-  '  Result:=a;',
-  'end;',
+  'type generic TRec<T:string> = record end;',
   'begin',
   '']);
   CheckResolverException('"String" is not a valid constraint',
@@ -211,10 +261,7 @@ begin
   '  TObject = class end;',
   '  TBird = class end;',
   '  TBear = class end;',
-  'generic function DoIt<T: TBird, TBear>(a: T): T;',
-  'begin',
-  '  Result:=a;',
-  'end;',
+  '  generic TRec<T: TBird, TBear> = record end;',
   'begin',
   '']);
   CheckResolverException('"TBird" constraint and "TBear" constraint cannot be specified together',
@@ -279,6 +326,91 @@ begin
     nXIsNotAValidConstraint);
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintConstructor;
+begin
+  StartProgram(true,[supTObject]);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TBird<T:constructor> = class',
+  '    o: T;',
+  '    procedure Fly;',
+  '  end;',
+  '  TAnt = class end;',
+  'var a: specialize TBird<TAnt>;',
+  'procedure TBird.Fly;',
+  'begin',
+  '  o:=T.Create;',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintSpecialize;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TAnt<S> = class m: S; end;',
+  '  generic TBird<T:specialize TAnt<word>> = class',
+  '    o: T;',
+  '  end;',
+  '  TFireAnt = class(specialize TAnt<word>) end;',
+  'var',
+  '  a: specialize TBird<TFireAnt>;',
+  '  f: TFireAnt;',
+  'begin',
+  '  a.o:=f;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeWithT;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt<S> = class m: S; end;',
+  '  TBird<X; Y: TAnt<X>> = class',
+  '    Ant: Y;',
+  '  end;',
+  '  TEagle<X; Y:X> = class',
+  '    e: Y;',
+  '  end;',
+  '  TFireAnt<F> = class(TAnt<F>) end;',
+  '  TAntWord = TAnt<word>;',
+  '  TBirdAntWord = TBird<word, TAnt<word>>;',
+  'var',
+  '  a: TAnt<word>;',
+  '  b: TBird<word, TAntWord>;',
+  '  c: TBird<TBirdAntWord, TAnt<TBirdAntWord>>;',
+  '  f: TEagle<TAnt<boolean>, TFireAnt<boolean>>;',
+  '  fb: TFireAnt<boolean>;',
+  'begin',
+  '  b.Ant:=a;',
+  '  f.e:=fb;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintTSpecializeAsTFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  generic TAnt<S> = record v: S; end;',
+  '  generic TBird<T; U: specialize T<word>> = record v: T; end;',
+  'begin',
+  '']);
+  CheckResolverException('identifier not found "T<>"',nIdentifierNotFound);
+end;
+
 procedure TTestResolveGenerics.TestGen_TemplNameEqTypeNameFail;
 begin
   StartProgram(false);
@@ -301,7 +433,7 @@ begin
   'type',
   '  TObject = class end;',
   '  generic TBird<T: record> = class v: T; end;',
-  '  generic TEagle<U> = class(TBird<U>)',
+  '  generic TEagle<U> = class(specialize TBird<U>)',
   '  end;',
   'begin',
   '']);
@@ -318,7 +450,7 @@ begin
   '  TObject = class end;',
   '  TAnt = class end;',
   '  generic TBird<T: TAnt> = class v: T; end;',
-  '  generic TEagle<U> = class(TBird<U>)',
+  '  generic TEagle<U> = class(specialize TBird<U>)',
   '  end;',
   'begin',
   '']);
@@ -326,6 +458,147 @@ begin
     nTypeParamXIsNotCompatibleWithY);
 end;
 
+procedure TTestResolveGenerics.TestGen_ConstraintMultiParam;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  generic TBird<S,T: TAnt> = class',
+  '    x: S;',
+  '    y: T;',
+  '  end;',
+  '  TRedAnt = class(TAnt) end;',
+  '  TEagle = specialize TBird<TRedAnt,TAnt>;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintMultiParamClassMismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class end;',
+  '  TRedAnt = class(TAnt) end;',
+  '  generic TBird<S,T: TRedAnt> = class',
+  '    x: S;',
+  '    y: T;',
+  '  end;',
+  '  TEagle = specialize TBird<TRedAnt,TAnt>;',
+  'begin',
+  '']);
+  CheckResolverException('Incompatible types: got "TAnt" expected "TRedAnt"',
+    nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintClassType_DotIsAsTypeCast;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TAnt = class',
+  '    procedure Run; external; overload;',
+  '  end;',
+  '  TRedAnt = class(TAnt)',
+  '    procedure Run(w: word); external; overload;',
+  '  end;',
+  '  generic TBird<T: TRedAnt> = class',
+  '    y: T;',
+  '    procedure Fly;',
+  '  end;',
+  '  TFireAnt = class(TRedAnt);',
+  '  generic TEagle<U: TRedAnt> = class(specialize TBird<U>) end;',
+  '  TRedEagle = specialize TEagle<TRedAnt>;',
+  'procedure TBird.Fly;',
+  'var f: TFireAnt;',
+  'begin',
+  '  y.Run;',
+  '  y.Run(3);',
+  '  if y is TFireAnt then',
+  '    f:=y as TFireAnt;',
+  '  f:=TFireAnt(y);',
+  '  y:=T(f);',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintClassType_ForInT;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TEnumerator<TItem> = class',
+  '    FCurrent: TItem;',
+  '    property Current: TItem read FCurrent;',
+  '    function MoveNext: boolean;',
+  '  end;',
+  '  generic TAnt<U> = class',
+  '    function GetEnumerator: specialize TEnumerator<U>;',
+  '  end;',
+  '  generic TBird<S; T: specialize TAnt<S>> = class',
+  '    m: T;',
+  '    procedure Fly;',
+  '  end;',
+  'function TEnumerator.MoveNext: boolean;',
+  'begin',
+  'end;',
+  'function TAnt.GetEnumerator: specialize TEnumerator<U>;',
+  'begin',
+  'end;',
+  'procedure TBird.Fly;',
+  'var i: S;',
+  'begin',
+  '  for i in m do ;',
+  'end;',
+  'var',
+  '  a: specialize TAnt<word>;',
+  '  w: word;',
+  '  b: specialize TBird<word,specialize TAnt<word>>;',
+  'begin',
+  '  for w in a do ;',
+  '  for w in b.m do ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ConstraintClassType_IsAs;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TAnt<U> = class',
+  '    v: U;',
+  '    function Run: U;',
+  '  end;',
+  'function TAnt.Run: U;',
+  'var a: specialize TAnt<U>;',
+  'begin',
+  '  if v is TObject then ;',
+  '  if v is specialize TAnt<TObject> then',
+  '    specialize TAnt<TObject>(v).v:=nil;',
+  '  a:=v as specialize TAnt<U>;',
+  '  if (v as specialize TAnt<TObject>).v=nil then ;',
+  '  if nil=(v as specialize TAnt<TObject>).v then ;',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_RecordLocalNameDuplicateFail;
 begin
   StartProgram(false);
@@ -579,7 +852,7 @@ begin
   '  end;',
   'begin',
   '']);
-  CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,20)',
+  CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,18)',
     nDeclOfXDiffersFromPrevAtY);
 end;
 
@@ -593,12 +866,12 @@ begin
   '  generic TAnt<T> = class;',
   '  generic TFish<U> = class',
   '    private type AliasU = U;',
-  '    var a: TAnt<AliasU>;',
+  '    var a: specialize TAnt<AliasU>;',
   '        Size: AliasU;',
   '  end;',
   '  generic TAnt<T> = class',
   '    private type AliasT = T;',
-  '    var f: TFish<AliasT>;',
+  '    var f: specialize TFish<AliasT>;',
   '        Speed: AliasT;',
   '  end;',
   'var',
@@ -632,6 +905,20 @@ begin
     nDuplicateIdentifier);
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_AnotherInUnitImpl;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class v: T; end;',
+  'implementation',
+  'type generic TBird<T,U> = record x: T; y: U; end;',
+  '']);
+  ParseUnit;
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_Method;
 begin
   StartProgram(false);
@@ -657,6 +944,31 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_MethodOverride;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    function Fly(p:T): T; virtual; abstract;',
+  '  end;',
+  '  generic TEagle<S> = class(specialize TBird<S>)',
+  '    function Fly(p:S): S; override;',
+  '  end;',
+  'function TEagle.Fly(p:S): S;',
+  'begin',
+  'end;',
+  'var',
+  '  e: specialize TEagle<word>;',
+  '  w: word;',
+  'begin',
+  '  w:=e.Fly(w);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_MethodDelphi;
 begin
   StartProgram(false);
@@ -682,6 +994,60 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_MethodDelphiTypeParamMissing;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class',
+  '    function Run(p:T): T;',
+  '  end;',
+  'function TBird.Run(p:T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('TBird<> expected, but TBird found',nXExpectedButYFound);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_MethodImplConstraintFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T: record> = class',
+  '    function Run(p:T): T;',
+  '  end;',
+  'function TBird<T: record>.Run(p:T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('illegal qualifier ":" after "T"',nIllegalQualifierAfter);
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_MethodImplTypeParamNameMismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class',
+  '    procedure DoIt;',
+  '  end;',
+  'procedure TBird<S>.DoIt;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('T expected, but S found',nXExpectedButYFound);
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_SpecializeSelfInside;
 begin
   StartProgram(false);
@@ -691,7 +1057,7 @@ begin
   '  TObject = class end;',
   '  generic TBird<T> = class',
   '    e: T;',
-  '    v: TBird<boolean>;',
+  '    v: specialize TBird<boolean>;',
   '  end;',
   'var',
   '  b: specialize TBird<word>;',
@@ -713,7 +1079,7 @@ begin
   '  generic TBird<T> = class',
   '    i: T;',
   '  end;',
-  '  generic TEagle<T> = class(TBird<T>)',
+  '  generic TEagle<T> = class(specialize TBird<T>)',
   '    j: T;',
   '  end;',
   'var',
@@ -731,7 +1097,7 @@ begin
   '{$mode objfpc}',
   'type',
   '  TObject = class end;',
-  '  generic TBird<T> = class(TBird<word>)',
+  '  generic TBird<T> = class(specialize TBird<word>)',
   '    e: T;',
   '  end;',
   'var',
@@ -741,6 +1107,22 @@ begin
   CheckResolverException('type "TBird<>" is not yet completely defined',nTypeXIsNotYetCompletelyDefined);
 end;
 
+procedure TTestResolveGenerics.TestGen_ClassOfSpecializeFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    e: T;',
+  '  end;',
+  '  TBirdClass = class of specialize TBird<word>;',
+  'begin',
+  '']);
+  CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 8 column 25',nParserExpectTokenError);
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_NestedType;
 begin
   StartProgram(false);
@@ -840,6 +1222,62 @@ begin
   CheckResolverException('identifier not found "red"',nIdentifierNotFound);
 end;
 
+procedure TTestResolveGenerics.TestGen_Class_Self;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  generic TAnimal<T> = class end;',
+  '  generic TBird<T> = class(specialize TAnimal<T>)',
+  '    function GetObj: TObject;',
+  '    procedure Fly(Obj: TObject); virtual; abstract;',
+  '  end;',
+  '  TProc = procedure(Obj: TObject) of object;',
+  '  TWordBird = specialize TBird<word>;',
+  'function TBird.GetObj: TObject;',
+  'var p: TProc;',
+  'begin',
+  '  Result:=Self;',
+  '  if Self.GetObj=Result then ;',
+  '  Fly(Self);',
+  '  p:=@Fly;',
+  '  p(Self);',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Class_MemberTypeConstructor;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TAnimal<A> = class',
+  '  end;',
+  '  TAnt<L> = class',
+  '    constructor Create(A: TAnimal<L>);',
+  '  end;',
+  '  TBird<T> = class(TAnimal<T>)',
+  '  type TMyAnt = TAnt<T>;',
+  '    function Fly: TMyAnt;',
+  '  end;',
+  '  TWordBird = TBird<word>;',
+  'constructor TAnt<L>.Create(A: TAnimal<L>);',
+  'begin',
+  'end;',
+  'function TBird<T>.Fly: TMyAnt;',
+  'begin',
+  '  Result:=TMyAnt.Create(Self);',
+  'end;',
+  'begin']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_Class_List;
 begin
   StartProgram(false);
@@ -959,7 +1397,7 @@ begin
   '    procedure Fly(a: T);',
   '  end;',
   '  TObject = class end;',
-  '  generic TBird<U> = class(IBird<U>)',
+  '  generic TBird<U> = class(specialize IBird<U>)',
   '    procedure Fly(a: U);',
   '  end;',
   'procedure TBird.Fly(a: U);',
@@ -971,7 +1409,7 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_Array;
+procedure TTestResolveGenerics.TestGen_DynArray;
 begin
   StartProgram(false);
   Add([
@@ -989,20 +1427,70 @@ begin
   '  b:=a;',
   '  SetLength(a,5);',
   '  SetLength(b,6);',
+  '  w:=length(a)+low(a)+high(a);',
   '']);
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_ProcType;
+procedure TTestResolveGenerics.TestGen_StaticArray;
 begin
   StartProgram(false);
   Add([
   'type',
-  '  generic TFunc<T> = function(v: T): T;',
-  '  TWordFunc = specialize TFunc<word>;',
-  'function GetIt(w: word): word;',
-  'begin',
-  'end;',
+  '  generic TBird<T> = array[T] of word;',
+  '  TByteBird = specialize TBird<byte>;',
+  'var',
+  '  a: specialize TBird<byte>;',
+  '  b: TByteBird;',
+  '  i: byte;',
+  'begin',
+  '  a[1]:=2;',
+  '  b[2]:=a[3]+b[4];',
+  '  a:=b;',
+  '  b:=a;',
+  '  i:=low(a);',
+  '  i:=high(a);',
+  '  for i in a do ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_Array_Anoynmous;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  generic TRec<T> = record',
+  '    a: array of T;',
+  '  end;',
+  '  TWordRec = specialize TRec<word>;',
+  'var',
+  '  a: specialize TRec<word>;',
+  '  b: TWordRec;',
+  '  w: word;',
+  'begin',
+  '  a:=b;',
+  '  a.a:=b.a;',
+  '  a.a[1]:=2;',
+  '  b.a[2]:=a.a[3]+b.a[4];',
+  '  b:=a;',
+  '  SetLength(a.a,5);',
+  '  SetLength(b.a,6);',
+  '  w:=length(a.a)+low(a.a)+high(a.a);',
+  '']);
+  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;',
@@ -1020,22 +1508,16 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolveGenerics.TestGen_GenericFunction;
+procedure TTestResolveGenerics.TestGen_PointerDirectSpecializeFail;
 begin
-  exit;
   StartProgram(false);
   Add([
-  'generic function DoIt<T>(a: T): T;',
-  'var i: T;',
-  'begin',
-  '  a:=i;',
-  '  Result:=a;',
-  'end;',
-  'var w: word;',
+  'type',
+  '  generic TRec<T> = record v: T; end;',
+  '  PRec = ^specialize TRec<word>;',
   'begin',
-  //'  w:=DoIt<word>(3);',
   '']);
-  ParseProgram;
+  CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 4 column 11',nParserExpectTokenError);
 end;
 
 procedure TTestResolveGenerics.TestGen_LocalVar;
@@ -1118,25 +1600,25 @@ begin
   '  end;',
   'constructor TBird.Create;',
   'var',
-  '  a: TAnt<T>;',
-  '  b: TAnt<word>;',
+  '  a: specialize TAnt<T>;',
+  '  b: specialize TAnt<word>;',
   'begin',
-  '  a:=TAnt<T>.create;',
-  '  b:=TAnt<word>.create;',
+  '  a:=specialize TAnt<T>.create;',
+  '  b:=specialize TAnt<word>.create;',
   'end;',
   'constructor TAnt.Create;',
   'var',
-  '  i: TBird<U>;',
-  '  j: TBird<word>;',
-  '  k: TAnt<U>;',
+  '  i: specialize TBird<U>;',
+  '  j: specialize TBird<word>;',
+  '  k: specialize TAnt<U>;',
   'begin',
-  '  i:=TBird<U>.create;',
-  '  j:=TBird<word>.create;',
-  '  k:=TAnt<U>.create;',
+  '  i:=specialize TBird<U>.create;',
+  '  j:=specialize TBird<word>.create;',
+  '  k:=specialize TAnt<U>.create;',
   'end;',
-  'var a: TAnt<word>;',
+  'var a: specialize TAnt<word>;',
   'begin',
-  '  a:=TAnt<word>.create;',
+  '  a:=specialize TAnt<word>.create;',
   '']);
   ParseProgram;
 end;
@@ -1172,8 +1654,8 @@ begin
   '  except',
   '    on Exception do ;',
   '    on E: Exception do ;',
-  '    on E: EMsg<boolean> do E.Msg:=true;',
-  '    on E: EMsg<T> do E.Msg:=1;',
+  '    on E: specialize EMsg<boolean> do E.Msg:=true;',
+  '    on E: specialize EMsg<T> do E.Msg:=1;',
   '  end;',
   'end;',
   'var',
@@ -1184,6 +1666,733 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolveGenerics.TestGen_Call;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  'procedure Run(b: boolean); overload;',
+  'begin end;',
+  'procedure Run(w: word); overload;',
+  'begin end;',
+  'function TBird.Fly(p:T): T;',
+  'begin',
+  '  Run(p);',
+  '  Run(Result);',
+  'end;',
+  'var',
+  '  w: specialize TBird<word>;',
+  '  b: specialize TBird<boolean>;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_NestedProc;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    function Fly(p:T): T;',
+  '  end;',
+  'function TBird.Fly(p:T): T;',
+  '  function Run: T;',
+  '  begin',
+  '    Fly:=Result;',
+  '  end;',
+  'begin',
+  '  Run;',
+  'end;',
+  'var',
+  '  w: specialize TBird<word>;',
+  '  b: specialize TBird<boolean>;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Function;
+begin
+  StartProgram(false);
+  Add([
+  'generic function DoIt<T>(a: T): T;',
+  'var i: T;',
+  'begin',
+  '  a:=i;',
+  '  Result:=a;',
+  'end;',
+  'var w: word;',
+  'begin',
+  '  w:=specialize DoIt<word>(3);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_FunctionDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  '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.TestGenProc_OverloadDuplicate;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure Fly<T>(a: T);',
+  'begin',
+  'end;',
+  'generic procedure Fly<T>(a: T);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,22)',nDuplicateIdentifier);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_MissingTemplatesFail;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure Run;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckParserException('Expected "<"',nParserExpectTokenError);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Forward;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure Fly<T>(a: T); forward;',
+  'procedure Run;',
+  'begin',
+  '  specialize Fly<word>(3);',
+  'end;',
+  'generic procedure Fly<T>(a: T);',
+  'var i: T;',
+  'begin',
+  '  i:=a;',
+  'end;',
+  'begin',
+  '  specialize Fly<boolean>(true);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_External;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: T): T; external name ''flap'';',
+  'procedure Run;',
+  'begin',
+  '  specialize Fly<word>(3);',
+  'end;',
+  'begin',
+  '  specialize Fly<boolean>(true);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_UnitIntf;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'generic function Fly<T>(a: T): T;',
+    '']),
+    LinesToStr([
+    'generic function Fly<T>(a: T): T;',
+    'var i: T;',
+    'begin',
+    '  i:=a;',
+    'end;',
+    '']));
+  StartProgram(true);
+  Add([
+  'uses unit2;',
+  'var w: word;',
+  'begin',
+  '  w:=specialize Fly<word>(3);',
+  '  if specialize Fly<boolean>(false) then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_BackRef1Fail;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: Fly): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_BackRef2Fail;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: Fly<word>): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_BackRef3Fail;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: Fly<T>): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_CallSelf;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: T): T;',
+  '  procedure Run;',
+  '  begin',
+  '    specialize Fly<T>(a);',
+  '    specialize Fly<word>(3);',
+  '  end;',
+  'begin',
+  '  specialize Fly<T>(a);',
+  '  specialize Fly<boolean>(true);',
+  'end;',
+  'begin',
+  '  specialize Fly<string>(''fast'');',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_CallSelfNoParams;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: T = 0): T;',
+  '  procedure Run;',
+  '  begin',
+  '    specialize Fly<T>;',
+  '    specialize Fly<word>;',
+  '  end;',
+  'begin',
+  '  specialize Fly<T>;',
+  '  specialize Fly<byte>;',
+  'end;',
+  'begin',
+  '  specialize Fly<shortint>;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardConstraints;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TBird = class end;',
+  'var b: TBird;',
+  'generic function Fly<T: class>(a: T): T; forward;',
+  'procedure Run;',
+  'begin',
+  '  specialize Fly<TBird>(b);',
+  'end;',
+  'generic function Fly<T>(a: T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '  specialize Fly<TBird>(b);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardConstraintsRepeatFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  'generic function Fly<T: class>(a: T): T; forward;',
+  'generic function Fly<T: class>(a: T): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardTempNameMismatch;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Fly<T>(a: T): T; forward;',
+  'generic function Fly<B>(a: B): B;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "Fly<B>" differs from previous declaration at afile.pp(2,23)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_ForwardOverload;
+begin
+  StartProgram(false);
+  Add([
+  'generic function {#FlyA}Fly<T>(a: T; b: boolean): T; forward; overload;',
+  'generic function {#FlyB}Fly<T>(a: T; w: word): T; forward; overload;',
+  'procedure {#FlyC}Fly; overload;',
+  'begin',
+  '  specialize {@FlyA}Fly<longint>(1,true);',
+  '  specialize {@FlyB}Fly<string>(''ABC'',3);',
+  'end;',
+  'generic function Fly<T>(a: T; b: boolean): T;',
+  'begin',
+  'end;',
+  'generic function Fly<T>(a: T; w: word): T;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_NestedFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Fly;',
+  '  generic procedure Run<T>(a: T);',
+  '  begin',
+  '  end;',
+  'begin',
+  '  Run<boolean>(true);',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverload;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure {#A}Run<T>(a: T);',
+  'begin',
+  'end;',
+  'generic procedure {#B}Run<M,N>(a: M);',
+  'begin',
+  '  specialize {@A}Run<M>(a);',
+  '  specialize {@B}Run<double,char>(1.3);',
+  'end;',
+  'begin',
+  '  specialize {@A}Run<word>(3);',
+  '  specialize {@B}Run<word,char>(4);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_TypeParamCntOverloadNoParams;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure {#A}Run<T>;',
+  'begin',
+  'end;',
+  'generic procedure {#B}Run<M,N>;',
+  'begin',
+  '  specialize {@A}Run<M>;',
+  '  specialize {@A}Run<M>();',
+  '  specialize {@B}Run<double,char>;',
+  '  specialize {@B}Run<double,char>();',
+  'end;',
+  'begin',
+  '  specialize {@A}Run<word>;',
+  '  specialize {@A}Run<word>();',
+  '  specialize {@B}Run<word,char>;',
+  '  specialize {@B}Run<word,char>();',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_TypeParamWithDefaultParamDelphiFail;
+begin
+  // delphi 10.3 does not allow default values for args with generic types
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure {#A}Run<T>(a: T = 0); overload;',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_NeedExplicitFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'function {#A}Run<S,T>(a: S): T; overload;',
+  'begin',
+  'end;',
+  'begin',
+  '  {@A}Run(1);',
+  '']);
+  CheckResolverException('Could not infer generic type argument "T" for method "Run"',
+    nCouldNotInferTypeArgXForMethodY);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_Overload;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure {#A}Run<S>(a: S; b: boolean); overload;',
+  'begin',
+  'end;',
+  'procedure {#B}Run<T>(a: T; w: word); overload;',
+  'begin',
+  'end;',
+  'procedure {#C}Run<U>(a: U; b: U); overload;',
+  'begin',
+  'end;',
+  'begin',
+  '  {@A}Run(1,true);', // non generic take precedence
+  '  {@B}Run(2,word(3));', // non generic take precedence
+  '  {@C}Run(''foo'',''bar'');',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_OverloadForward;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure {#A}Run<S>(a: S; b: boolean); forward; overload;',
+  'procedure {#B}Run<T>(a: T; w: word); forward; overload;',
+  'procedure {#C}Run<U>(a: U; b: U); forward; overload;',
+  'procedure {#A2}Run<S>(a: S; b: boolean); overload;',
+  'begin',
+  '  {@A}Run(1,true);', // non generic take precedence
+  '  {@B}Run(2,word(3));', // non generic take precedence
+  '  {@C}Run(''foo'',''bar'');',
+  'end;',
+  'procedure {#B2}Run<T>(a: T; w: word); overload;',
+  'begin',
+  'end;',
+  'procedure {#C2}Run<U>(a: U; b: U); overload;',
+  'begin',
+  'end;',
+  'begin',
+  '  {@A}Run(1,true);', // non generic take precedence
+  '  {@B}Run(2,word(3));', // non generic take precedence
+  '  {@C}Run(''foo'',''bar'');',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_Var_Overload;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure {#A}Run<S>(var a: S; var b: boolean); overload;',
+  'begin',
+  'end;',
+  'procedure {#B}Run<T>(var a: T; var w: word); overload;',
+  'begin',
+  'end;',
+  'procedure {#C}Run<U>(var a: U; var b: U); overload;',
+  'begin',
+  'end;',
+  'var',
+  '  w: word;',
+  '  b: boolean;',
+  '  s: string;',
+  'begin',
+  '  {@A}Run(w,b);',
+  '  {@B}Run(s,w);',
+  '  {@C}Run(s,s);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_DefaultValue;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch implicitfunctionspecialization}',
+  'generic procedure {#A}Run<S>(a: S = 2; b: S = 10); overload;',
+  'begin',
+  'end;',
+  'begin',
+  '  {@A}Run(1,2);',
+  '  {@A}Run(3);',
+  '  {@A}Run();',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_DefaultValueMismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$modeswitch implicitfunctionspecialization}',
+  'generic procedure {#A}Run<S>(a: S; b: S = 10); overload;',
+  'begin',
+  'end;',
+  'begin',
+  '  {@A}Run(false,true);',
+  '']);
+  CheckResolverException('Incompatible types: got "Longint" expected "Boolean"',
+                         nIncompatibleTypesGotExpected);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_ProcT;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TProc<S> = reference to procedure(a: S);',
+  '  TObject = class',
+  '    procedure {#A}Run<T: class>(a: TProc<T>);',
+  '  end;',
+  '  TBird = class end;',
+  'procedure Tobject.Run<T>(a: TProc<T>);',
+  'begin',
+  'end;',
+  'var obj: TObject;',
+  'begin',
+  '  obj.{@A}Run<TBird>(procedure(Bird: TBird) begin end);',
+  //'  obj.{@A}Run(procedure(Bird: TBird) begin end);', // not supported by Delphi
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_Mismatch;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<T>(a: T; b: T);',
+  'begin',
+  'end;',
+  'begin',
+  '  Run(1,true);',
+  '']);
+  CheckResolverException('Inferred type "T" from different arguments mismatch for method "Run"',
+    nInferredTypeXFromDiffArgsMismatchFromMethodY);
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Inference_ArrayOfT;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<T>(a: array of T);',
+  'var b: T;',
+  'begin',
+  '  b:=3;',
+  'end;',
+  'var Arr: array of byte;',
+  'begin',
+  '  Run(Arr);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    generic procedure Run<T>(a: T); virtual; abstract;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('virtual, dynamic or message methods cannot have type parameters',
+    nXMethodsCannotHaveTypeParams);
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_ClassInterfaceMethodFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  IUnknown = interface',
+  '    generic procedure Run<T>(a: T); virtual; abstract;',
+  '  end;',
+  'begin',
+  '']);
+  CheckParserException('generic is not allowed in interface',nParserXNotAllowedInY);
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_ClassConstructorFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    generic class constructor Run<T>(a: T);',
+  '  end;',
+  'generic class constructor TObject.Run<T>(a: T);',
+  'begin end;',
+  'begin',
+  '']);
+  CheckParserException('Expected "Procedure" or "Function" at token "constructor" in file afile.pp at line 4 column 19',
+    nParserExpectToken2Error);
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_TemplNameDifferFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    generic procedure Run<T>(a: T);',
+  '  end;',
+  'generic procedure TObject.Run<S>(a: S);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('Declaration of "TObject.Run<S>" differs from previous declaration at afile.pp(4,28)',
+    nDeclOfXDiffersFromPrevAtY);
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_ImplConstraintFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    generic procedure Run<T>(a: T);',
+  '  end;',
+  'generic procedure TObject.Run<T: class>(a: T);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_NestedSelf;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    w: word;',
+  '    generic function Fly<T>(a: T): T;',
+  '  end;',
+  'generic function TObject.Fly<T>(a: T): T;',
+  '  function Sub: T;',
+  '  begin',
+  '    Result:=w+a;',
+  '    Result:=Self.w+a;',
+  //'    specialize Fly<T> :=', not supported by FPC/Delphi
+  '  end;',
+  'begin',
+  '  Result:=Sub;',
+  '  Result:=Self.w+Sub+a;',
+  'end;',
+  'var Obj: TObject;',
+  'begin',
+  '  if Obj.specialize Fly<smallint>(3)=4 then ;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_OverloadTypeParamCnt;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    generic procedure {#A}Run<T>(a: T);',
+  '    generic procedure {#B}Run<M,N>(a: M);',
+  '  end;',
+  'generic procedure TObject.Run<T>(a: T);',
+  'begin',
+  'end;',
+  'generic procedure TObject.Run<M,N>(a: M);',
+  'begin',
+  '  specialize {@A}Run<M>(a);',
+  '  specialize {@B}Run<double,char>(1.3);',
+  'end;',
+  'var obj: TObject;',
+  'begin',
+  '  obj.specialize {@A}Run<word>(3);',
+  '  obj.specialize {@B}Run<word,char>(4);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenMethod_OverloadArgs;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    generic function {#A}Run<T>(a: boolean): T;',
+  '    generic function {#B}Run<M>(a: word): M;',
+  '  end;',
+  'generic function TObject.Run<T>(a: boolean): T;',
+  'begin',
+  'end;',
+  'generic function TObject.Run<M>(a: word): M;',
+  'begin',
+  '  Result:=specialize Run<M>(a);',
+  '  if specialize {@A}Run<string>(true)=''foo'' then ;',
+  '  if specialize {@B}Run<byte>(3)=4 then ;',
+  'end;',
+  'var obj: TObject;',
+  'begin',
+  '  if obj.specialize {@A}Run<string>(true)=''bar'' then ;',
+  '  if obj.specialize {@B}Run<byte>(5)=6 then ;',
+  '']);
+  ParseProgram;
+end;
+
 initialization
   RegisterTests([TTestResolveGenerics]);
 

+ 45 - 6
packages/fcl-passrc/tests/tcresolver.pas

@@ -946,6 +946,7 @@ type
     Procedure TestTypeHelper_Constructor_NewInstance;
     Procedure TestTypeHelper_Interface;
     Procedure TestTypeHelper_Interface_ConstructorFail;
+    Procedure TestTypeHelper_TypeAliasType;
 
     // attributes
     Procedure TestAttributes_Globals;
@@ -1091,6 +1092,8 @@ begin
     writeln('TCustomTestResolver.TearDown GlobalRefCount Was='+IntToStr(FStartElementRefCount)+' Now='+IntToStr(TPasElement.GlobalRefCount));
     {$IFDEF CheckPasTreeRefCount}
     El:=TPasElement.FirstRefEl;
+    if El=nil then
+      writeln('  TPasElement.FirstRefEl=nil');
     while El<>nil do
       begin
       writeln('  ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
@@ -6480,8 +6483,8 @@ begin
   StartProgram(false);
   Add([
   'type',
-  '  integer = longint;',
-  '  TValue = type longint;',
+  '  integer = word;',
+  '  TValue = type word;',
   '  TAliasValue = TValue;',
   'procedure DoIt(i: integer); external;',
   'procedure DoIt(i: TAliasValue); external;',
@@ -11120,7 +11123,6 @@ begin
   '    procedure DoIt;',
   '    class procedure DoMore;',
   '  end;',
-  'implementation',
   'procedure tobject.doit;',
   'begin',
   '  if cI=4 then;',
@@ -11166,7 +11168,7 @@ begin
   '    class c: word;',
   '  end;',
   'begin']);
-  CheckParserException('Expected "procedure or function"',nParserExpectTokenError);
+  CheckParserException('Expected "Procedure" or "Function"',nParserExpectToken2Error);
 end;
 
 procedure TTestResolver.TestClass_ClassConstFail;
@@ -14510,6 +14512,10 @@ begin
   'type',
   '  TDynArrInt = array of byte;',
   '  TStaArrInt = array[1..2] of byte;',
+  'procedure Fly(var a: array of byte);',
+  'begin',
+  '  Fly(a);',
+  'end;',
   'procedure DoIt(a: array of byte);',
   'var',
   '  d: TDynArrInt;',
@@ -14520,6 +14526,8 @@ begin
   '  // d:=a; forbidden in delphi',
   '  DoIt(d);',
   '  DoIt(s);',
+  '  Fly(a);',
+  '  Fly(d);', // dyn array can be passed to a var open array
   'end;',
   'begin',
   '']);
@@ -15929,8 +15937,8 @@ begin
   Add([
   'type p = ^(red, green);',
   'begin']);
-  CheckResolverException('not yet implemented: pointer of anonymous type',
-    nNotYetImplemented);
+  CheckParserException('Expected "Identifier" at token "(" in file afile.pp at line 2 column 11',
+    nParserExpectTokenError);
 end;
 
 procedure TTestResolver.TestPointer_AssignPointerToClassFail;
@@ -17951,6 +17959,37 @@ begin
   CheckResolverException('constructor is not supported',nXIsNotSupported);
 end;
 
+procedure TTestResolver.TestTypeHelper_TypeAliasType;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TEnum = type longint;',
+  '  TIntHelper = type helper for longint',
+  '    procedure Run;',
+  '  end;',
+  '  TEnumHelper = type helper for TEnum',
+  '    procedure Fly;',
+  '  end;',
+  'procedure TIntHelper.Run;',
+  'begin',
+  'end;',
+  'procedure TEnumHelper.Fly;',
+  'begin',
+  'end;',
+  'var',
+  '  e: TEnum;',
+  '  i: longint;',
+  'begin',
+  '  i.Run;',
+  '  e.Fly;',
+  '  with i do Run;',
+  '  with e do Fly;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestAttributes_Globals;
 begin
   StartProgram(false);

File diff suppressed because it is too large
+ 380 - 168
packages/pastojs/src/fppas2js.pp


+ 1 - 1
packages/pastojs/src/fppjssrcmap.pp

@@ -148,7 +148,7 @@ begin
   //  ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine,',Col=',FSrcColumn-1);
 
   SrcMap.AddMapping(CurLine,Max(0,CurColumn-1),
-    FSrcFilename,FSrcLine,Max(0,FSrcColumn-1));
+    FSrcFilename,Max(0,FSrcLine),Max(0,FSrcColumn-1));
 
   if (CurElement is TJSLiteral)
       and (TJSLiteral(CurElement).Value.CustomValue<>'') then

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

@@ -15,7 +15,6 @@ Compiler-ToDos:
   Warn if -Ju and -Fu intersect
   -Fa<x>[,y] (for a program) load units <x> and [y] before uses is parsed
   Add Windows macros, see InitMacros.
-  add options for names of globals like 'pas' and 'rtl'
 }
 unit Pas2jsCompiler;
 
@@ -2259,7 +2258,7 @@ begin
     MapFilename:=LocalFilename;
     if (BaseDir<>'') and not SrcMapFilenamesAbsolute then
     begin
-      if not FS.TryCreateRelativePath(LocalFilename,BaseDir,true,MapFilename) then
+      if not FS.TryCreateRelativePath(LocalFilename,BaseDir,true,false,MapFilename) then
       begin
         // e.g. file is on another partition
         if not SrcMapInclude then
@@ -2273,6 +2272,12 @@ begin
         MapFilename:=LocalFilename;
       end;
     end;
+    if FilenameIsAbsolute(MapFilename)
+        and SameText(SrcMapSourceRoot,'file://') then
+      begin
+      // Firefox needs the "file://" schema with every file
+      MapFilename:='file://'+MapFilename;
+      end;
     {$IFNDEF Unix}
     // use / as PathDelim
     if PathDelim<>'/' then
@@ -4294,7 +4299,7 @@ begin
     RaiseInternalError(20170504161340,'internal error: TPas2jsCompiler.Run FileCount>0');
 
   try
-    // set working directory, need by all relative filenames
+    // set working directory, needed by all relative filenames
     SetWorkingDir(aWorkingDir);
 
     CompilerExe:=aCompilerExe; // maybe needed to find the default config

+ 21 - 6
packages/pastojs/src/pas2jsfilecache.pp

@@ -279,7 +279,8 @@ type
     function ExpandExecutable(const Filename: string): string; override;
     function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): String; override;
     Function AddForeignUnitPath(const aValue: String; FromCmdLine: Boolean): String; override;
-    function TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String): Boolean; override;
+    function TryCreateRelativePath(const Filename, BaseDirectory: String;
+      UsePointDirectory, AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean; override;
   Protected
     property DirectoryCache: TPas2jsCachedDirectories read FDirectoryCache;
   public
@@ -905,13 +906,25 @@ end;
 function TPas2jsCachedDirectories.DirectoryExists(Filename: string): boolean;
 var
   Info: TFileInfo;
+  Dir: TPas2jsCachedDirectory;
 begin
   Info.Filename:=Filename;
   if not GetFileInfo(Info) then exit(false);
   if Info.Dir<>nil then
     Result:=(Info.Dir.FileAttr(Info.ShortFilename) and faDirectory)>0
   else
-    Result:={$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.DirectoryExists(Info.Filename);
+    begin
+    Dir:=GetDirectory(Filename,true,false);
+    if Dir<>nil then
+      Result:=Dir.Count>0
+    else
+      begin
+      Filename:=ChompPathDelim(ResolveDots(Filename));
+      if not FilenameIsAbsolute(Filename) then
+        Filename:=WorkingDirectory+Filename;
+      Result:={$IFDEF pas2js}NodeJSFS{$ELSE}SysUtils{$ENDIF}.DirectoryExists(Filename);
+      end;
+    end;
 end;
 
 function TPas2jsCachedDirectories.FileExists(Filename: string): boolean;
@@ -1486,8 +1499,9 @@ procedure TPas2jsFilesCache.WriteFoldersAndSearchPaths;
   procedure WriteFolder(aName, Folder: string);
   begin
     if Folder='' then exit;
+    Folder:=ChompPathDelim(Folder);
     Log.LogMsgIgnoreFilter(nUsingPath,[aName,Folder]);
-    if not DirectoryExists(ChompPathDelim(Folder)) then
+    if not DirectoryExists(Folder) then
       Log.LogMsgIgnoreFilter(nFolderNotFound,[aName,QuoteStr(Folder)]);
   end;
 
@@ -1806,11 +1820,12 @@ begin
   AddSrcUnitPaths(aValue,FromCmdLine,Result);
 end;
 
-function TPas2jsFilesCache.TryCreateRelativePath(const Filename, BaseDirectory: String;
-  UsePointDirectory: boolean; out RelPath: String): Boolean;
+function TPas2jsFilesCache.TryCreateRelativePath(const Filename,
+  BaseDirectory: String; UsePointDirectory,
+  AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean;
 begin
   Result:=Pas2jsFileUtils.TryCreateRelativePath(Filename, BaseDirectory,
-    UsePointDirectory, true, RelPath);
+    UsePointDirectory, AlwaysRequireSharedBaseFolder, RelPath);
 end;
 
 function TPas2jsFilesCache.FindIncludeFileName(const aFilename,

+ 134 - 24
packages/pastojs/src/pas2jsfiler.pp

@@ -172,7 +172,8 @@ const
     'ExternalClass',
     'PrefixedAttributes',
     'OmitRTTI',
-    'MultiHelpers'
+    'MultiHelpers',
+    'ImplicitFunctionSpecialization'
     ); // Dont forget to update ModeSwitchToInt !
 
   PCUDefaultBoolSwitches: TBoolSwitches = [
@@ -723,6 +724,9 @@ type
     procedure WriteElementList(Obj: TJSONObject; Parent: TPasElement;
       const PropName: string; ListOfElements: TFPList; aContext: TPCUWriterContext;
       ReferencesAllowed: boolean = false); virtual;
+    procedure WriteElementArray(Obj: TJSONObject; Parent: TPasElement;
+      const PropName: string; ArrOfElements: TPasElementArray; aContext: TPCUWriterContext;
+      ReferencesAllowed: boolean = false); virtual;
     procedure WriteElement(Obj: TJSONObject; El: TPasElement; aContext: TPCUWriterContext); virtual;
     procedure WriteElType(Obj: TJSONObject; El: TPasElement; const PropName: string; aType: TPasType; aContext: TPCUWriterContext); virtual;
     procedure WriteVarModifiers(Obj: TJSONObject; const PropName: string; const Value, DefaultValue: TVariableModifiers); virtual;
@@ -826,6 +830,15 @@ type
     AddRef: TPCUAddRef;
   end;
 
+  { TPCUReaderPendingElArrRef }
+
+  TPCUReaderPendingElArrRef = class(TPCUFilerPendingElRef)
+  public
+    Arr: TPasElementArray;
+    Index: integer;
+    AddRef: TPCUAddRef;
+  end;
+
   { TPCUReaderPendingIdentifierScope }
 
   TPCUReaderPendingIdentifierScope = class
@@ -844,7 +857,6 @@ 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);
@@ -891,6 +903,8 @@ type
       Data: TObject; ErrorEl: TPasElement); virtual;
     procedure PromiseSetElListReference(Id: integer; List: TFPList; Index: integer;
       AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
+    procedure PromiseSetElArrReference(Id: integer; Arr: TPasElementArray; Index: integer;
+      AddRef: TPCUAddRef; ErrorEl: TPasElement); virtual;
     procedure ReadHeaderMagic(Obj: TJSONObject); virtual;
     procedure ReadHeaderVersion(Obj: TJSONObject); virtual;
     procedure ReadGUID(Obj: TJSONObject); virtual;
@@ -923,6 +937,9 @@ type
     procedure ReadElementList(Obj: TJSONObject; Parent: TPasElement;
       const PropName: string; ListOfElements: TFPList; AddRef: TPCUAddRef;
       aContext: TPCUReaderContext); virtual;
+    procedure ReadElementArray(Obj: TJSONObject; Parent: TPasElement;
+      const PropName: string; var ArrOfElements: TPasElementArray; AddRef: TPCUAddRef;
+      aContext: TPCUReaderContext); virtual;
     procedure ReadElType(Obj: TJSONObject; const PropName: string; El: TPasElement;
       const Setter: TOnSetElReference; aContext: TPCUReaderContext); virtual;
     function ReadResolvedRefFlags(Obj: TJSONObject; El: TPasElement;
@@ -1408,6 +1425,7 @@ begin
     // msIgnoreAttributes: Result:=47;
     msOmitRTTI: Result:=48;
     msMultiHelpers: Result:=49;
+    msImplicitFunctionSpec: Result:=50;
   end;
 end;
 
@@ -2750,6 +2768,36 @@ begin
     end;
 end;
 
+procedure TPCUWriter.WriteElementArray(Obj: TJSONObject; Parent: TPasElement;
+  const PropName: string; ArrOfElements: TPasElementArray;
+  aContext: TPCUWriterContext; ReferencesAllowed: boolean);
+var
+  Arr: TJSONArray;
+  i: Integer;
+  SubObj: TJSONObject;
+  Item: TPasElement;
+begin
+  if length(ArrOfElements)=0 then exit;
+  Arr:=TJSONArray.Create;
+  Obj.Add(PropName,Arr);
+  for i:=0 to length(ArrOfElements)-1 do
+    begin
+    Item:=ArrOfElements[i];
+    if Item.Parent<>Parent then
+      begin
+      if not ReferencesAllowed then
+        RaiseMsg(20180209191444,Item,GetObjName(Parent)+'<>'+GetObjName(Item.Parent));
+      AddReferenceToArray(Arr,Item);
+      end
+    else
+      begin
+      SubObj:=TJSONObject.Create;
+      Arr.Add(SubObj);
+      WriteElement(SubObj,Item,aContext);
+      end;
+    end;
+end;
+
 procedure TPCUWriter.WriteElement(Obj: TJSONObject;
   El: TPasElement; aContext: TPCUWriterContext);
 var
@@ -3298,7 +3346,7 @@ begin
     TemplObj:=TJSONObject.Create;
     Arr.Add(TemplObj);
     TemplObj.Add('Name',Templ.Name);
-    WritePasExprArray(TemplObj,Parent,'Constraints',Templ.Constraints,aContext);
+    WriteElementArray(TemplObj,Parent,'Constraints',Templ.Constraints,aContext,true);
     end;
 end;
 
@@ -3328,7 +3376,8 @@ procedure TPCUWriter.WriteInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUWriterContext);
 begin
   WritePasExpr(Obj,Expr,pekSpecialize,eopNone,aContext);
-  WriteElType(Obj,Expr,'Dest',Expr.DestType,aContext);
+  WriteExpr(Obj,Expr,'Name',Expr.NameExpr,aContext);
+  WriteElementList(Obj,Expr,'Params',Expr.Params,aContext);
 end;
 
 procedure TPCUWriter.WriteRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -3782,7 +3831,7 @@ begin
           TemplObj:=TJSONObject.Create;
           TemplArr.Add(TemplObj);
           TemplObj.Add('Name',GenType.Name);
-          WritePasExprArray(TemplObj,El,'Constraints',GenType.Constraints,aContext);
+          WriteElementArray(TemplObj,El,'Constraints',GenType.Constraints,aContext,true);
           end;
         end;
       end;
@@ -4249,21 +4298,6 @@ 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;
@@ -4771,6 +4805,7 @@ var
   RefItem: TPCUFilerPendingElRef;
   PendingElRef: TPCUReaderPendingElRef;
   PendingElListRef: TPCUReaderPendingElListRef;
+  PendingElArrRef: TPCUReaderPendingElArrRef;
   {$IF defined(VerbosePCUFiler) or defined(memcheck)}
   Node: TAVLTreeNode;
   {$ENDIF}
@@ -4840,6 +4875,13 @@ begin
           if PendingElListRef.AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
             Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(PendingElListRef.AddRef){$ENDIF};
           end
+        else if RefItem is TPCUReaderPendingElArrRef then
+          begin
+          PendingElArrRef:=TPCUReaderPendingElArrRef(RefItem);
+          PendingElArrRef.Arr[PendingElArrRef.Index]:=Ref.Element;
+          if PendingElArrRef.AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
+            Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(PendingElArrRef.AddRef){$ENDIF};
+          end
         else
           RaiseMsg(20180207153056,ErrorEl,RefItem.ClassName);
         Ref.Pending:=RefItem.Next;
@@ -4901,6 +4943,33 @@ begin
     end;
 end;
 
+procedure TPCUReader.PromiseSetElArrReference(Id: integer;
+  Arr: TPasElementArray; Index: integer; AddRef: TPCUAddRef;
+  ErrorEl: TPasElement);
+var
+  Ref: TPCUFilerElementRef;
+  PendingItem: TPCUReaderPendingElArrRef;
+begin
+  Ref:=AddElReference(Id,ErrorEl,nil);
+  if Ref.Element<>nil then
+    begin
+    // element was already created -> set list item immediately
+    Arr[Index]:=Ref.Element;
+    if AddRef{$IFDEF CheckPasTreeRefCount}<>''{$ENDIF} then
+      Ref.Element.AddRef{$IFDEF CheckPasTreeRefCount}(AddRef){$ENDIF};
+    end
+  else
+    begin
+    // element was not yet created -> store
+    PendingItem:=TPCUReaderPendingElArrRef.Create;
+    PendingItem.Arr:=Arr;
+    PendingItem.Index:=Index;
+    PendingItem.AddRef:=AddRef;
+    PendingItem.ErrorEl:=ErrorEl;
+    Ref.AddPending(PendingItem);
+    end;
+end;
+
 procedure TPCUReader.ReadHeaderMagic(Obj: TJSONObject);
 begin
   {$IFDEF VerbosePCUFiler}
@@ -6006,7 +6075,7 @@ begin
       // reference
       Id:=Data.AsInteger;
       ListOfElements.Add(nil);
-      PromiseSetElListReference(Id,ListOfElements,ListOfElements.Count-1,AddRef,Parent);
+      PromiseSetElListReference(Id,ListOfElements,i,AddRef,Parent);
       end
     else if Data is TJSONObject then
       begin
@@ -6019,6 +6088,40 @@ begin
     end;
 end;
 
+procedure TPCUReader.ReadElementArray(Obj: TJSONObject; Parent: TPasElement;
+  const PropName: string; var ArrOfElements: TPasElementArray;
+  AddRef: TPCUAddRef; aContext: TPCUReaderContext);
+var
+  Arr: TJSONArray;
+  i, Id: Integer;
+  Data: TJSONData;
+  SubObj: TJSONObject;
+  SubEl: TPasElement;
+begin
+  if not ReadArray(Obj,PropName,Arr,Parent) then exit;
+  for i:=0 to Arr.Count-1 do
+    begin
+    Data:=Arr[i];
+    if Data is TJSONIntegerNumber then
+      begin
+      // reference
+      Id:=Data.AsInteger;
+      SetLength(ArrOfElements,i+1);
+      ArrOfElements[i]:=nil;
+      PromiseSetElArrReference(Id,ArrOfElements,i,AddRef,Parent);
+      end
+    else if Data is TJSONObject then
+      begin
+      SubObj:=TJSONObject(Data);
+      SubEl:=ReadElement(SubObj,Parent,aContext);
+      SetLength(ArrOfElements,i+1);
+      ArrOfElements[i]:=SubEl;
+      end
+    else
+      RaiseMsg(20180210201001,Parent,'['+IntToStr(i)+'] is '+GetObjName(Data));
+    end;
+end;
+
 procedure TPCUReader.ReadElType(Obj: TJSONObject; const PropName: string;
   El: TPasElement; const Setter: TOnSetElReference; aContext: TPCUReaderContext
   );
@@ -6691,7 +6794,9 @@ begin
       RaiseMsg(20190720224130,Parent,IntToStr(i));
     GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,Parent));
     GenericTemplateTypes.Add(GenType);
-    ReadPasExprArray(TemplObj,Parent,'Constraints',GenType.Constraints,aContext);
+    ReadElementArray(TemplObj,Parent,'Constraints',GenType.Constraints,
+      {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
+      aContext);
     end;
 end;
 
@@ -6723,7 +6828,10 @@ procedure TPCUReader.ReadInlineSpecializeExpr(Obj: TJSONObject;
   Expr: TInlineSpecializeExpr; aContext: TPCUReaderContext);
 begin
   Expr.Kind:=pekSpecialize;
-  ReadElType(Obj,'Dest',Expr,@Set_InlineSpecializeExpr_DestType,aContext);
+  Expr.NameExpr:=ReadExpr(Obj,Expr,'Name',aContext);
+  ReadElementList(Obj,Expr,'Params',Expr.Params,
+    {$IFDEF CheckPasTreeRefCount}'TInlineSpecializeExpr.Params'{$ELSE}true{$ENDIF},
+    aContext);
 end;
 
 procedure TPCUReader.ReadRangeType(Obj: TJSONObject; El: TPasRangeType;
@@ -7512,7 +7620,9 @@ begin
             RaiseMsg(20190718114244,El,IntToStr(i)+','+IntToStr(j));
           GenType:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,GenTypeName,El));
           Templates.Add(GenType);
-          ReadPasExprArray(TemplObj,El,'Constraints',GenType.Constraints,aContext);
+          ReadElementArray(TemplObj,El,'Constraints',GenType.Constraints,
+             {$IFDEF CheckPasTreeRefCount}'TPasGenericTemplateType.Constraints'{$ELSE}true{$ENDIF},
+             aContext);
           end;
         end;
       end;

+ 5 - 3
packages/pastojs/src/pas2jsfs.pp

@@ -115,7 +115,8 @@ Type
     function ExpandExecutable(const Filename: string): string; virtual;
     Function FormatPath(Const aFileName: string): String; virtual;
     Function DirectoryExists(Const aDirectory: string): boolean; virtual;
-    function TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String): Boolean; virtual;
+    function TryCreateRelativePath(const Filename, BaseDirectory: String;
+      UsePointDirectory, AlwaysRequireSharedBaseFolder: boolean; out RelPath: String): Boolean; virtual;
     procedure DeleteDuplicateFiles(List: TStrings); virtual;
     function IndexOfFile(FileList: TStrings; aFilename: string; Start: integer = 0): integer; virtual;// -1 if not found
     Procedure WriteFoldersAndSearchPaths; virtual;
@@ -255,12 +256,13 @@ begin
   Result:=aDirectory='';
 end;
 
-function TPas2JSFS.TryCreateRelativePath(const Filename, BaseDirectory: String; UsePointDirectory: boolean; out RelPath: String
+function TPas2JSFS.TryCreateRelativePath(const Filename, BaseDirectory: String;
+  UsePointDirectory, AlwaysRequireSharedBaseFolder: boolean; out RelPath: String
   ): Boolean;
 begin
   Result:=True;
   RelPath:=FileName;
-  if (BaseDirectory='') or UsePointDirectory then ;
+  if (BaseDirectory='') or UsePointDirectory or AlwaysRequireSharedBaseFolder then ;
 end;
 
 procedure TPas2JSFS.DeleteDuplicateFiles(List: TStrings);

+ 29 - 25
packages/pastojs/src/pas2jslibcompiler.pp

@@ -18,6 +18,10 @@ unit pas2jslibcompiler;
 {$mode objfpc}
 {$H+}
 
+{$IFDEF darwin}
+{$DEFINE UseCDecl}
+{$ENDIF}
+
 interface
 
 uses
@@ -34,15 +38,15 @@ Const
 Type
   PDirectoryCache = Pointer;
 
-  TLibLogCallBack = Procedure (Data : Pointer; Msg : PAnsiChar; MsgLen : Integer); stdcall;
+  TLibLogCallBack = Procedure (Data : Pointer; Msg : PAnsiChar; MsgLen : Integer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
   TWriteJSCallBack = Procedure (Data : Pointer;
     AFileName: PAnsiChar; AFileNameLen : Integer;
-    AFileData : PAnsiChar; AFileDataLen: Int32); stdcall;
+    AFileData : PAnsiChar; AFileDataLen: Int32); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
   TReadPasCallBack = Procedure (Data : Pointer;
     AFileName: PAnsiChar; AFileNameLen : Integer;
-    AFileData : PAnsiChar; Var AFileDataLen: Int32); stdcall;
+    AFileData : PAnsiChar; Var AFileDataLen: Int32); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
   TReadDirCallBack = Function (Data : Pointer;
-    P : PDirectoryCache; ADirPath: PAnsiChar): boolean; stdcall;
+    P : PDirectoryCache; ADirPath: PAnsiChar): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
   { TLibraryPas2JSCompiler }
 
@@ -68,7 +72,7 @@ Type
   Public
     Constructor Create; override;
     Procedure DoLibraryLog(Sender : TObject; Const Msg : String);
-    Function LibraryRun(ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) :Boolean; stdcall;
+    Function LibraryRun(ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) :Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
     Property LastError : String Read FLastError Write FLastError;
     Property LastErrorClass : String Read FLastErrorClass Write FLastErrorClass;
     Property OnLibLogCallBack : TLibLogCallBack Read FOnLibLogCallBack Write FOnLibLogCallBack;
@@ -85,16 +89,16 @@ Type
 Type
   PPas2JSCompiler = Pointer;
 
-Procedure SetPas2JSWriteJSCallBack(P : PPas2JSCompiler; ACallBack : TWriteJSCallBack; CallBackData : Pointer); stdcall;
-Procedure SetPas2JSCompilerLogCallBack(P : PPas2JSCompiler; ACallBack : TLibLogCallBack; CallBackData : Pointer); stdcall;
-Procedure SetPas2JSReadPasCallBack(P : PPas2JSCompiler; ACallBack : TReadPasCallBack; CallBackData : Pointer; ABufferSize : Cardinal); stdcall;
-Procedure SetPas2JSReadDirCallBack(P : PPas2JSCompiler; ACallBack : TReadDirCallBack; CallBackData : Pointer); stdcall;
+Procedure SetPas2JSWriteJSCallBack(P : PPas2JSCompiler; ACallBack : TWriteJSCallBack; CallBackData : Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Procedure SetPas2JSCompilerLogCallBack(P : PPas2JSCompiler; ACallBack : TLibLogCallBack; CallBackData : Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Procedure SetPas2JSReadPasCallBack(P : PPas2JSCompiler; ACallBack : TReadPasCallBack; CallBackData : Pointer; ABufferSize : Cardinal); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Procedure SetPas2JSReadDirCallBack(P : PPas2JSCompiler; ACallBack : TReadDirCallBack; CallBackData : Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 Procedure AddPas2JSDirectoryEntry(P: PDirectoryCache; AFilename: PAnsiChar;
-  AAge: TPas2jsFileAgeTime; AAttr: TPas2jsFileAttr; ASize: TPas2jsFileSize); stdcall;
-Function RunPas2JSCompiler(P : PPas2JSCompiler; ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) : Boolean; stdcall;
-Procedure FreePas2JSCompiler(P : PPas2JSCompiler); stdcall;
-Function GetPas2JSCompiler : PPas2JSCompiler; stdcall;
-Procedure GetPas2JSCompilerLastError(P : PPas2JSCompiler; AError : PAnsiChar; Var AErrorLength : Longint; AErrorClass : PAnsiChar; Var AErrorClassLength : Longint); stdcall;
+  AAge: TPas2jsFileAgeTime; AAttr: TPas2jsFileAttr; ASize: TPas2jsFileSize); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Function RunPas2JSCompiler(P : PPas2JSCompiler; ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) : Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Procedure FreePas2JSCompiler(P : PPas2JSCompiler); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Function GetPas2JSCompiler : PPas2JSCompiler; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Procedure GetPas2JSCompilerLastError(P : PPas2JSCompiler; AError : PAnsiChar; Var AErrorLength : Longint; AErrorClass : PAnsiChar; Var AErrorClassLength : Longint); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 implementation
 
@@ -117,7 +121,7 @@ begin
   Result:=Assigned(OnWriteJSCallBack);
   if Result then
     try
-      Src:=aWriter.AsAnsistring;
+      Src:=aWriter.{$IF FPC_FULLVERSION>30300}AsString{$ELSE}AsAnsistring{$ENDIF};
       OnWriteJSCallBack(OnWriteJSData,PAnsiChar(DestFileName),Length(DestFileName),PAnsiChar(Src),Length(Src));
     except
       Result:=False;
@@ -197,7 +201,7 @@ begin
 end;
 
 function TLibraryPas2JSCompiler.LibraryRun(ACompilerExe, AWorkingDir: PAnsiChar;
-  CommandLine: PPAnsiChar; DoReset: Boolean): Boolean; stdcall;
+  CommandLine: PPAnsiChar; DoReset: Boolean): Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 Var
   C,W : AnsiString;
@@ -241,7 +245,7 @@ end;
   ---------------------------------------------------------------------}
 
 procedure SetPas2JSWriteJSCallBack(P: PPas2JSCompiler;
-  ACallBack: TWriteJSCallBack; CallBackData: Pointer); stdcall;
+  ACallBack: TWriteJSCallBack; CallBackData: Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 begin
   TLibraryPas2JSCompiler(P).OnWriteJSCallBack:=ACallBack;
@@ -249,7 +253,7 @@ begin
 end;
 
 procedure SetPas2JSCompilerLogCallBack(P: PPas2JSCompiler;
-  ACallBack: TLibLogCallBack; CallBackData: Pointer); stdcall;
+  ACallBack: TLibLogCallBack; CallBackData: Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 begin
   TLibraryPas2JSCompiler(P).OnLibLogCallBack:=ACallBack;
@@ -258,7 +262,7 @@ end;
 
 procedure SetPas2JSReadPasCallBack(P: PPas2JSCompiler;
   ACallBack: TReadPasCallBack; CallBackData: Pointer; ABufferSize: Cardinal);
-  stdcall;
+  {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 begin
   TLibraryPas2JSCompiler(P).OnReadPasData:=CallBackData;
@@ -269,7 +273,7 @@ begin
 end;
 
 procedure SetPas2JSReadDirCallBack(P: PPas2JSCompiler;
-  ACallBack: TReadDirCallBack; CallBackData: Pointer); stdcall;
+  ACallBack: TReadDirCallBack; CallBackData: Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   TLibraryPas2JSCompiler(P).OnReadDir:=ACallBack;
   TLibraryPas2JSCompiler(P).OnReadDirData:=CallBackData;
@@ -277,26 +281,26 @@ end;
 
 procedure AddPas2JSDirectoryEntry(P: PDirectoryCache; AFilename: PAnsiChar;
   AAge: TPas2jsFileAgeTime; AAttr: TPas2jsFileAttr; ASize: TPas2jsFileSize);
-  stdcall;
+  {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 begin
   TPas2jsCachedDirectory(P).Add(AFilename,AAge,AAttr,ASize);
 end;
 
 function RunPas2JSCompiler(P: PPas2JSCompiler; ACompilerExe,
   AWorkingDir: PAnsiChar; CommandLine: PPAnsiChar; DoReset: Boolean): Boolean;
-  stdcall;
+  {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 begin
   Result:=TLibraryPas2JSCompiler(P).LibraryRun(ACompilerExe,AWorkingDir,CommandLine,DoReset)
 end;
 
-procedure FreePas2JSCompiler(P: PPas2JSCompiler); stdcall;
+procedure FreePas2JSCompiler(P: PPas2JSCompiler); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 begin
   TLibraryPas2JSCompiler(P).Free;
 end;
 
-function GetPas2JSCompiler: PPas2JSCompiler; stdcall;
+function GetPas2JSCompiler: PPas2JSCompiler; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 begin
   Result:=TLibraryPas2JSCompiler.Create;
@@ -304,7 +308,7 @@ end;
 
 procedure GetPas2JSCompilerLastError(P: PPas2JSCompiler; AError: PAnsiChar;
   Var AErrorLength: Longint; AErrorClass: PAnsiChar;
-  Var AErrorClassLength: Longint); stdcall;
+  Var AErrorClassLength: Longint); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
 begin
   TLibraryPas2JSCompiler(P).GetLastError(AError,AErrorLength,AErrorClass,AErrorClassLength);

+ 35 - 1
packages/pastojs/tests/tcfiler.pas

@@ -83,6 +83,7 @@ type
     procedure CheckRestoredAnalyzerElement(const Path: string; Orig, Rest: TPasElement); virtual;
     procedure CheckRestoredElement(const Path: string; Orig, Rest: TPasElement); virtual;
     procedure CheckRestoredElementList(const Path: string; Orig, Rest: TFPList); virtual;
+    procedure CheckRestoredElementArray(const Path: string; Orig, Rest: TPasElementArray); virtual;
     procedure CheckRestoredElRefList(const Path: string; OrigParent: TPasElement;
       Orig: TFPList; RestParent: TPasElement; Rest: TFPList; AllowInSitu: boolean); virtual;
     procedure CheckRestoredPasExpr(const Path: string; Orig, Rest: TPasExpr); virtual;
@@ -100,6 +101,7 @@ type
     procedure CheckRestoredPointerType(const Path: string; Orig, Rest: TPasPointerType); virtual;
     procedure CheckRestoredSpecializedType(const Path: string; Orig, Rest: TPasSpecializeType); virtual;
     procedure CheckRestoredInlineSpecializedExpr(const Path: string; Orig, Rest: TInlineSpecializeExpr); virtual;
+    procedure CheckRestoredGenericTemplateType(const Path: string; Orig, Rest: TPasGenericTemplateType); virtual;
     procedure CheckRestoredRangeType(const Path: string; Orig, Rest: TPasRangeType); virtual;
     procedure CheckRestoredArrayType(const Path: string; Orig, Rest: TPasArrayType); virtual;
     procedure CheckRestoredFileType(const Path: string; Orig, Rest: TPasFileType); virtual;
@@ -1130,6 +1132,8 @@ begin
     CheckRestoredSpecializedType(Path,TPasSpecializeType(Orig),TPasSpecializeType(Rest))
   else if C=TInlineSpecializeExpr then
     CheckRestoredInlineSpecializedExpr(Path,TInlineSpecializeExpr(Orig),TInlineSpecializeExpr(Rest))
+  else if C=TPasGenericTemplateType then
+    CheckRestoredGenericTemplateType(Path,TPasGenericTemplateType(Orig),TPasGenericTemplateType(Rest))
   else if C=TPasRangeType then
     CheckRestoredRangeType(Path,TPasRangeType(Orig),TPasRangeType(Rest))
   else if C=TPasArrayType then
@@ -1219,6 +1223,29 @@ begin
     end;
 end;
 
+procedure TCustomTestPrecompile.CheckRestoredElementArray(const Path: string;
+  Orig, Rest: TPasElementArray);
+var
+  OrigItem, RestItem: TPasElement;
+  i: Integer;
+  SubPath: String;
+begin
+  AssertEquals(Path+'.length',length(Orig),length(Rest));
+  for i:=0 to length(Orig)-1 do
+    begin
+    SubPath:=Path+'['+IntToStr(i)+']';
+    OrigItem:=Orig[i];
+    if not (OrigItem is TPasElement) then
+      Fail(SubPath+' Orig='+GetObjName(OrigItem));
+    RestItem:=Rest[i];
+    if not (RestItem is TPasElement) then
+      Fail(SubPath+' Rest='+GetObjName(RestItem));
+    //writeln('TCustomTestPrecompile.CheckRestoredElementList ',GetObjName(OrigItem),' ',GetObjName(RestItem));
+    SubPath:=Path+'['+IntToStr(i)+']"'+TPasElement(OrigItem).Name+'"';
+    CheckRestoredElement(SubPath,TPasElement(OrigItem),TPasElement(RestItem));
+    end;
+end;
+
 procedure TCustomTestPrecompile.CheckRestoredElRefList(const Path: string;
   OrigParent: TPasElement; Orig: TFPList; RestParent: TPasElement;
   Rest: TFPList; AllowInSitu: boolean);
@@ -1360,7 +1387,14 @@ end;
 procedure TCustomTestPrecompile.CheckRestoredInlineSpecializedExpr(
   const Path: string; Orig, Rest: TInlineSpecializeExpr);
 begin
-  CheckRestoredElement(Path+'.DestType',Orig.DestType,Rest.DestType);
+  CheckRestoredElement(Path+'.Name',Orig.NameExpr,Rest.NameExpr);
+  CheckRestoredElementList(Path+'.Params',Orig.Params,Rest.Params);
+end;
+
+procedure TCustomTestPrecompile.CheckRestoredGenericTemplateType(
+  const Path: string; Orig, Rest: TPasGenericTemplateType);
+begin
+  CheckRestoredElementArray(Path+'.Constraints',Orig.Constraints,Rest.Constraints);
 end;
 
 procedure TCustomTestPrecompile.CheckRestoredRangeType(const Path: string;

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

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testregistry,
-  TCModules;
+  TCModules, FPPas2Js;
 
 type
 
@@ -21,9 +21,27 @@ type
     Procedure TestGen_ClassEmpty;
     Procedure TestGen_Class_EmptyMethod;
     Procedure TestGen_Class_TList;
+    Procedure TestGen_ClassAncestor;
+    Procedure TestGen_TypeInfo;
+    // ToDo: TBird, TBird<T>, TBird<S,T>
+    // ToDo: rename local const T
 
     // generic external class
     procedure TestGen_ExtClass_Array;
+
+    // statements
+    Procedure TestGen_InlineSpec_Constructor;
+    Procedure TestGen_CallUnitImplProc;
+    Procedure TestGen_IntAssignTemplVar;
+    // ToDo: TBird<word>(o).field:=3;
+
+    // generic helper
+    // ToDo: helper for gen array: TArray<word>.Fly(aword);
+
+    // generic functions
+    // ToDo: Fly<word>(3);
+    // ToDo: TestGenProc_ProcT
+    // ToDo: inference Fly(3);
   end;
 
 implementation
@@ -204,6 +222,83 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ClassAncestor;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  end;',
+  '  generic TEagle<T> = class(specialize TBird<T>)',
+  '  end;',
+  'var a: specialize TEagle<word>;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_ClassAncestor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G2", $mod.TObject, function () {',
+    '});',
+    'rtl.createClass($mod, "TEagle$G1", $mod.TBird$G2, function () {',
+    '});',
+    'this.a = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_TypeInfo;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '  published',
+  '    m: T;',
+  '  end;',
+  '  TEagle = specialize TBird<word>;',
+  'var',
+  '  b: specialize TBird<word>;',
+  '  p: pointer;',
+  'begin',
+  '  p:=typeinfo(TEagle);',
+  '  p:=typeinfo(b);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_TypeInfo',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.m = 0;',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addField("m", rtl.word);',
+    '});',
+    'this.b = null;',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TBird$G1"];',
+    '$mod.p = $mod.b.$rtti;',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);
@@ -263,6 +358,141 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_InlineSpec_Constructor;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class',
+  '  public',
+  '    constructor Create;',
+  '  end;',
+  '  generic TBird<T> = class',
+  '  end;',
+  'constructor TObject.Create; begin end;',
+  'var b: specialize TBird<word>;',
+  'begin',
+  '  b:=specialize TBird<word>.Create;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_InlineSpec_Constructor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Create = function () {',
+    '    return this;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '});',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.b = $mod.TBird$G1.$create("Create");',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_CallUnitImplProc;
+begin
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+    'type',
+    '  generic TBird<T> = class',
+    '    procedure Fly;',
+    '  end;',
+    'var b: specialize TBird<boolean>;',
+    '']),
+  LinesToStr([
+    'procedure DoIt;',
+    'var b: specialize TBird<word>;',
+    'begin',
+    '  b:=specialize TBird<word>.Create;',
+    '  b.Fly;',
+    'end;',
+    'procedure TBird.Fly;',
+    'begin',
+    '  DoIt;',
+    'end;',
+    '']));
+  StartProgram(true,[supTObject]);
+  Add('uses UnitA;');
+  Add('begin');
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.createClass($mod, "TBird$G1", pas.system.TObject, function () {',
+    '    this.Fly = function () {',
+    '      $impl.DoIt();',
+    '    };',
+    '  });',
+    '  rtl.createClass($mod, "TBird$G2", pas.system.TObject, function () {',
+    '    this.Fly = function () {',
+    '      $impl.DoIt();',
+    '    };',
+    '  });',
+    '  this.b = null;',
+    '}, null, function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  $impl.DoIt = function () {',
+    '    var b = null;',
+    '    b = $mod.TBird$G2.$create("Create");',
+    '    b.Fly();',
+    '  };',
+    '});',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_IntAssignTemplVar;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    m: T;',
+  '    procedure Fly;',
+  '  end;',
+  'var b: specialize TBird<word>;',
+  'procedure TBird.Fly;',
+  'var i: nativeint;',
+  'begin',
+  '  i:=m;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_IntAssignTemplVar',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.m = 0;',
+    '  };',
+    '  this.Fly = function () {',
+    '    var i = 0;',
+    '    i = this.m;',
+    '  };',
+    '});',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 Initialization
   RegisterTests([TTestGenerics]);
 end.

+ 447 - 58
packages/pastojs/tests/tcmodules.pas

@@ -330,6 +330,7 @@ type
     Procedure TestProc_OverloadForward;
     Procedure TestProc_OverloadIntfImpl;
     Procedure TestProc_OverloadNested;
+    Procedure TestProc_OverloadNestedForward;
     Procedure TestProc_OverloadUnitCycle;
     Procedure TestProc_Varargs;
     Procedure TestProc_ConstOrder;
@@ -386,6 +387,7 @@ type
     Procedure TestArithmeticOperators1;
     Procedure TestLogicalOperators;
     Procedure TestBitwiseOperators;
+    Procedure TestBitwiseOperatorsLongword;
     Procedure TestFunctionInt;
     Procedure TestFunctionString;
     Procedure TestIfThen;
@@ -523,6 +525,8 @@ type
     Procedure TestClass_ExternalOverrideFail;
     Procedure TestClass_ExternalVar;
     Procedure TestClass_Const;
+    Procedure TestClass_LocalConstDuplicate;
+    // ToDo: Procedure TestAdvRecord_LocalConstDuplicate;
     Procedure TestClass_LocalVarSelfFail;
     Procedure TestClass_ArgSelfFail;
     Procedure TestClass_NestedProcSelf;
@@ -566,6 +570,7 @@ type
     Procedure TestExternalClass_DuplicateVarFail;
     Procedure TestExternalClass_Method;
     Procedure TestExternalClass_ClassMethod;
+    Procedure TestExternalClass_ClassMethodStatic;
     Procedure TestExternalClass_FunctionResultInTypeCast;
     Procedure TestExternalClass_NonExternalOverride;
     Procedure TestExternalClass_OverloadHint;
@@ -583,6 +588,8 @@ type
     Procedure TestExternalClass_FuncClassOf_New;
     Procedure TestExternalClass_New_PasClassFail;
     Procedure TestExternalClass_New_PasClassBracketsFail;
+    Procedure TestExternalClass_Constructor;
+    Procedure TestExternalClass_ConstructorBrackets;
     Procedure TestExternalClass_LocalConstSameName;
     Procedure TestExternalClass_ReintroduceOverload;
     Procedure TestExternalClass_Inherited;
@@ -665,6 +672,7 @@ type
     Procedure TestClassHelper_PassProperty;
     Procedure TestExtClassHelper_ClassVar;
     Procedure TestExtClassHelper_Method_Call;
+    Procedure TestExtClassHelper_ClassMethod_MissingStatic;
     Procedure TestRecordHelper_ClassVar;
     Procedure TestRecordHelper_Method_Call;
     Procedure TestRecordHelper_Constructor;
@@ -688,6 +696,7 @@ type
     Procedure TestTypeHelper_Word;
     Procedure TestTypeHelper_Double;
     Procedure TestTypeHelper_StringChar;
+    Procedure TestTypeHelper_JSValue;
     Procedure TestTypeHelper_Array;
     Procedure TestTypeHelper_EnumType;
     Procedure TestTypeHelper_SetType;
@@ -2323,7 +2332,6 @@ begin
   FFilename:='ns1.test1.pp';
   StartProgram(true);
   Add('uses unIt2;');
-  Add('implementation');
   Add('var');
   Add('  i: longint;');
   Add('begin');
@@ -2404,7 +2412,6 @@ begin
   FFilename:='Ns1.SubNs1.Test1.pp';
   StartProgram(true);
   Add('uses Ns2.sUbnS2.unIt2;');
-  Add('implementation');
   Add('var');
   Add('  i: longint;');
   Add('begin');
@@ -3144,6 +3151,69 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestBitwiseOperatorsLongword;
+begin
+  StartProgram(false);
+  Add([
+  'var',
+  '  a,b,c:longword;',
+  '  i: longint;',
+  'begin',
+  '  a:=$12345678;',
+  '  b:=$EDCBA987;',
+  '  c:=not a;',
+  '  c:=a and b;',
+  '  c:=a and $ffff0000;',
+  '  c:=a or b;',
+  '  c:=a or $ff00ff00;',
+  '  c:=a xor b;',
+  '  c:=a xor $f0f0f0f0;',
+  '  c:=a shl 1;',
+  '  c:=a shl 16;',
+  '  c:=a shl 24;',
+  '  c:=a shl b;',
+  '  c:=a shr 1;',
+  '  c:=a shr 16;',
+  '  c:=a shr 24;',
+  '  c:=a shr b;',
+  '  c:=(b and c) or (a and b);',
+  '  c:=i and a;',
+  '  c:=i or a;',
+  '  c:=i xor a;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestBitwiseOperatorsLongword',
+    LinesToStr([ // statements
+    'this.a = 0;',
+    'this.b = 0;',
+    'this.c = 0;',
+    'this.i = 0;',
+    '']),
+    LinesToStr([ // this.$main
+    '$mod.a = 0x12345678;',
+    '$mod.b = 0xEDCBA987;',
+    '$mod.c = rtl.lw(~$mod.a);',
+    '$mod.c = rtl.lw($mod.a & $mod.b);',
+    '$mod.c = rtl.lw($mod.a & 0xffff0000);',
+    '$mod.c = rtl.lw($mod.a | $mod.b);',
+    '$mod.c = rtl.lw($mod.a | 0xff00ff00);',
+    '$mod.c = rtl.lw($mod.a ^ $mod.b);',
+    '$mod.c = rtl.lw($mod.a ^ 0xf0f0f0f0);',
+    '$mod.c = rtl.lw($mod.a << 1);',
+    '$mod.c = rtl.lw($mod.a << 16);',
+    '$mod.c = rtl.lw($mod.a << 24);',
+    '$mod.c = rtl.lw($mod.a << $mod.b);',
+    '$mod.c = rtl.lw($mod.a >>> 1);',
+    '$mod.c = rtl.lw($mod.a >>> 16);',
+    '$mod.c = rtl.lw($mod.a >>> 24);',
+    '$mod.c = rtl.lw($mod.a >>> $mod.b);',
+    '$mod.c = rtl.lw(rtl.lw($mod.b & $mod.c) | rtl.lw($mod.a & $mod.b));',
+    '$mod.c = $mod.i & $mod.a;',
+    '$mod.c = $mod.i | $mod.a;',
+    '$mod.c = $mod.i ^ $mod.a;',
+    '']));
+end;
+
 procedure TTestModule.TestPrgProcVar;
 begin
   StartProgram(false);
@@ -4019,6 +4089,52 @@ begin
 end;
 
 procedure TTestModule.TestProc_OverloadNested;
+begin
+  StartProgram(false);
+  Add([
+  'procedure doit(vA: longint);',
+  '  procedure DoIt(vA, vB: longint); overload;',
+  '  begin',
+  '    doit(1);',
+  '    doit(1,2);',
+  '  end;',
+  '  procedure doit(vA, vB, vC: longint);',
+  '  begin',
+  '    doit(1);',
+  '    doit(1,2);',
+  '    doit(1,2,3);',
+  '  end;',
+  'begin',
+  '  doit(1);',
+  '  doit(1,2);',
+  '  doit(1,2,3);',
+  'end;',
+  'begin // main',
+  '  doit(1);']);
+  ConvertProgram;
+  CheckSource('TestProcedureOverloadNested',
+    LinesToStr([ // statements
+    'this.doit = function (vA) {',
+    '  function DoIt$1(vA, vB) {',
+    '    $mod.doit(1);',
+    '    DoIt$1(1, 2);',
+    '  };',
+    '  function doit$2(vA, vB, vC) {',
+    '    $mod.doit(1);',
+    '    DoIt$1(1, 2);',
+    '    doit$2(1, 2, 3);',
+    '  };',
+    '  $mod.doit(1);',
+    '  DoIt$1(1, 2);',
+    '  doit$2(1, 2, 3);',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.doit(1);',
+    '']));
+end;
+
+procedure TTestModule.TestProc_OverloadNestedForward;
 begin
   StartProgram(false);
   Add([
@@ -4075,7 +4191,7 @@ begin
   '  doit(1);',
   '  doit(1,2);']);
   ConvertProgram;
-  CheckSource('TestProcedureOverloadNested',
+  CheckSource('TestProc_OverloadNestedForward',
     LinesToStr([ // statements
     'this.DoIt$1 = function (vB, vC) {',
     '  $mod.DoIt(1);',
@@ -11092,7 +11208,6 @@ begin
   '    Bracket: longint external name ''["A B"]'';',
   '    procedure DoIt;',
   '  end;',
-  'implementation',
   'procedure tcar.doit;',
   'begin',
   '  Intern:=Intern+1;',
@@ -13890,7 +14005,6 @@ begin
   Add('    procedure DoIt;');
   Add('    class procedure DoMore;');
   Add('  end;');
-  Add('implementation');
   Add('procedure tobject.doit;');
   Add('begin');
   Add('  if cI=4 then;');
@@ -13965,6 +14079,65 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClass_LocalConstDuplicate;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    const cI: longint = 3;',
+  '    procedure Fly;',
+  '    procedure Run;',
+  '  end;',
+  '  TBird = class',
+  '    procedure Go;',
+  '  end;',
+  'procedure tobject.fly;',
+  'const cI: word = 4;',
+  'begin',
+  '  if cI=Self.cI then ;',
+  'end;',
+  'procedure tobject.run;',
+  'const cI: word = 5;',
+  'begin',
+  '  if cI=Self.cI then ;',
+  'end;',
+  'procedure tbird.go;',
+  'const cI: word = 6;',
+  'begin',
+  '  if cI=Self.cI then ;',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestClass_LocalConstDuplicate',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.cI = 3;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var cI$1 = 4;',
+    '  this.Fly = function () {',
+    '    if (cI$1 === this.cI) ;',
+    '  };',
+    '  var cI$2 = 5;',
+    '  this.Run = function () {',
+    '    if (cI$2 === this.cI) ;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  var cI$3 = 6;',
+    '  this.Go = function () {',
+    '    if (cI$3 === this.cI) ;',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestClass_LocalVarSelfFail;
 begin
   StartProgram(false);
@@ -15595,14 +15768,17 @@ begin
   '    class procedure DoIt(Id: longint = 1); external name ''$Execute'';',
   '  end;',
   '  TExtB = TExtA;',
+  'var p: Pointer;',
   'begin',
   '  texta.doit;',
   '  texta.doit();',
   '  texta.doit(2);',
+  '  p:[email protected];',
   '  with texta do begin',
   '    doit;',
   '    doit();',
   '    doit(3);',
+  '    p:=@DoIt;',
   '  end;',
   '  textb.doit;',
   '  textb.doit();',
@@ -15616,14 +15792,17 @@ begin
   ConvertProgram;
   CheckSource('TestExternalClass_ClassMethod',
     LinesToStr([ // statements
+    'this.p = null;',
     '']),
     LinesToStr([ // $mod.$main
     'ExtObj.$Execute(1);',
     'ExtObj.$Execute(1);',
     'ExtObj.$Execute(2);',
+    '$mod.p = rtl.createCallback(ExtObj, "$Execute");',
     'ExtObj.$Execute(1);',
     'ExtObj.$Execute(1);',
     'ExtObj.$Execute(3);',
+    '$mod.p = rtl.createCallback(ExtObj, "$Execute");',
     'ExtObj.$Execute(1);',
     'ExtObj.$Execute(1);',
     'ExtObj.$Execute(4);',
@@ -15633,6 +15812,45 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExternalClass_ClassMethodStatic;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtObj''',
+  '    class procedure DoIt(Id: longint = 1); static;',
+  '  end;',
+  'var p: Pointer;',
+  'begin',
+  '  texta.doit;',
+  '  texta.doit();',
+  '  texta.doit(2);',
+  '  p:[email protected];',
+  '  with texta do begin',
+  '    doit;',
+  '    doit();',
+  '    doit(3);',
+  '    p:=@DoIt;',
+  '  end;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_ClassMethodStatic',
+    LinesToStr([ // statements
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    'ExtObj.DoIt(1);',
+    'ExtObj.DoIt(1);',
+    'ExtObj.DoIt(2);',
+    '$mod.p = ExtObj.DoIt;',
+    'ExtObj.DoIt(1);',
+    'ExtObj.DoIt(1);',
+    'ExtObj.DoIt(3);',
+    '$mod.p = ExtObj.DoIt;',
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_FunctionResultInTypeCast;
 begin
   StartProgram(false);
@@ -15681,32 +15899,33 @@ end;
 procedure TTestModule.TestExternalClass_NonExternalOverride;
 begin
   StartProgram(false);
-  Add('{$modeswitch externalclass}');
-  Add('type');
-  Add('  TExtA = class external name ''ExtObjA''');
-  Add('    procedure ProcA; virtual;');
-  Add('    procedure ProcB; virtual;');
-  Add('  end;');
-  Add('  TExtB = class external name ''ExtObjB'' (TExtA)');
-  Add('  end;');
-  Add('  TExtC = class (TExtB)');
-  Add('    procedure ProcA; override;');
-  Add('  end;');
-  Add('procedure TExtC.ProcA;');
-  Add('begin');
-  Add('  ProcA;');
-  Add('  Self.ProcA;');
-  Add('  ProcB;');
-  Add('  Self.ProcB;');
-  Add('end;');
-  Add('var');
-  Add('  A: texta;');
-  Add('  B: textb;');
-  Add('  C: textc;');
-  Add('begin');
-  Add('  a.proca;');
-  Add('  b.proca;');
-  Add('  c.proca;');
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtObjA''',
+  '    procedure ProcA; virtual;',
+  '    procedure ProcB; virtual;',
+  '  end;',
+  '  TExtB = class external name ''ExtObjB'' (TExtA)',
+  '  end;',
+  '  TExtC = class (TExtB)',
+  '    procedure ProcA; override;',
+  '  end;',
+  'procedure TExtC.ProcA;',
+  'begin',
+  '  ProcA;',
+  '  Self.ProcA;',
+  '  ProcB;',
+  '  Self.ProcB;',
+  'end;',
+  'var',
+  '  A: texta;',
+  '  B: textb;',
+  '  C: textc;',
+  'begin',
+  '  a.proca;',
+  '  b.proca;',
+  '  c.proca;']);
   ConvertProgram;
   CheckSource('TestExternalClass_NonExternalOverride',
     LinesToStr([ // statements
@@ -16152,27 +16371,29 @@ end;
 procedure TTestModule.TestExternalClass_New;
 begin
   StartProgram(false);
-  Add('{$modeswitch externalclass}');
-  Add('type');
-  Add('  TExtA = class external name ''ExtA''');
-  Add('    constructor New;');
-  Add('    constructor New(i: longint; j: longint = 2);');
-  Add('  end;');
-  Add('var');
-  Add('  A: texta;');
-  Add('begin');
-  Add('  a:=texta.new;');
-  Add('  a:=texta(texta.new);');
-  Add('  a:=texta.new();');
-  Add('  a:=texta.new(1);');
-  Add('  with texta do begin');
-  Add('    a:=new;');
-  Add('    a:=new();');
-  Add('    a:=new(2);');
-  Add('  end;');
-  Add('  a:=test1.texta.new;');
-  Add('  a:=test1.texta.new();');
-  Add('  a:=test1.texta.new(3);');
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '    constructor New;',
+  '    constructor New(i: longint; j: longint = 2);',
+  '  end;',
+  'var',
+  '  A: texta;',
+  'begin',
+  '  a:=texta.new;',
+  '  a:=texta(texta.new);',
+  '  a:=texta.new();',
+  '  a:=texta.new(1);',
+  '  with texta do begin',
+  '    a:=new;',
+  '    a:=new();',
+  '    a:=new(2);',
+  '  end;',
+  '  a:=test1.texta.new;',
+  '  a:=test1.texta.new();',
+  '  a:=test1.texta.new(3);',
+  '']);
   ConvertProgram;
   CheckSource('TestExternalClass_New',
     LinesToStr([ // statements
@@ -16315,6 +16536,89 @@ begin
   ConvertProgram;
 end;
 
+procedure TTestModule.TestExternalClass_Constructor;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '    constructor Create;',
+  '    constructor Create(i: longint; j: longint = 2);',
+  '  end;',
+  'var',
+  '  A: texta;',
+  'begin',
+  '  a:=texta.create;',
+  '  a:=texta(texta.create);',
+  '  a:=texta.create();',
+  '  a:=texta.create(1);',
+  '  with texta do begin',
+  '    a:=create;',
+  '    a:=create();',
+  '    a:=create(2);',
+  '  end;',
+  '  a:=test1.texta.create;',
+  '  a:=test1.texta.create();',
+  '  a:=test1.texta.create(3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_Constructor',
+    LinesToStr([ // statements
+    'this.A = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A = new ExtA.Create();',
+    '$mod.A = new ExtA.Create();',
+    '$mod.A = new ExtA.Create();',
+    '$mod.A = new ExtA.Create(1,2);',
+    '$mod.A = new ExtA.Create();',
+    '$mod.A = new ExtA.Create();',
+    '$mod.A = new ExtA.Create(2,2);',
+    '$mod.A = new ExtA.Create();',
+    '$mod.A = new ExtA.Create();',
+    '$mod.A = new ExtA.Create(3,2);',
+    '']));
+end;
+
+procedure TTestModule.TestExternalClass_ConstructorBrackets;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '    constructor Create; external name ''{}'';',
+  '  end;',
+  'var',
+  '  A: texta;',
+  'begin',
+  '  a:=texta.create;',
+  '  a:=texta(texta.create);',
+  '  a:=texta.create();',
+  '  with texta do begin',
+  '    a:=create;',
+  '    a:=create();',
+  '  end;',
+  '  a:=test1.texta.create;',
+  '  a:=test1.texta.create();',
+  '']);
+  ConvertProgram;
+  CheckSource('TestExternalClass_ConstructorBrackets',
+    LinesToStr([ // statements
+    'this.A = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A = {};',
+    '$mod.A = {};',
+    '$mod.A = {};',
+    '$mod.A = {};',
+    '$mod.A = {};',
+    '$mod.A = {};',
+    '$mod.A = {};',
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_LocalConstSameName;
 begin
   StartProgram(false);
@@ -16812,8 +17116,8 @@ begin
     '    function Sub() {',
     '    };',
     '    var f = null;',
-    '    f = rtl.createCallback($Self, "DoIt");',
-    '    f = rtl.createCallback($Self, "DoIt").bind(null, 13);',
+    '    f = $Self.DoIt;',
+    '    f = $Self.DoIt.bind(null, 13);',
     '    f = Sub;',
     '    f = $mod.GetIt;',
     '  };',
@@ -16829,7 +17133,7 @@ begin
     '  f = $mod.GetIt;',
     '  f = $mod.GetIt.bind(null, 3);',
     '  f = Sub;',
-    '  f = rtl.createCallback(o, "DoIt");',
+    '  f = $mod.TObject.DoIt;',
     '  f = fi.bind(null, 4);',
     '  return Result;',
     '};',
@@ -18433,10 +18737,10 @@ begin
     'this.DoDefault = function (i, j, o) {',
     '  rtl._AddRef(i);',
     '  try {',
-    '    if ($mod.IUnknown.isPrototypeOf(i)) ;',
+    '    if (rtl.intfIsIntfT(i, $mod.IUnknown)) ;',
     '    if (rtl.queryIntfIsT(o, $mod.IUnknown)) ;',
     '    if (rtl.intfIsClass(i, $mod.TObject)) ;',
-    '    i = rtl.setIntfL(i, rtl.as(j, $mod.IUnknown));',
+    '    i = rtl.setIntfL(i, rtl.intfAsIntfT(j, $mod.IUnknown));',
     '    i = rtl.setIntfL(i, rtl.queryIntfT(o, $mod.IUnknown), true);',
     '    o = rtl.intfAsClass(j, $mod.TObject);',
     '    i = rtl.setIntfL(i, j);',
@@ -21435,6 +21739,27 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestExtClassHelper_ClassMethod_MissingStatic;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtObj''',
+  '    procedure Run(w: word = 10);',
+  '  end;',
+  '  THelper = class helper for TExtA',
+  '    class procedure Fly;',
+  '  end;',
+  'class procedure THelper.Fly;',
+  'begin end;',
+  'begin',
+  '']);
+  SetExpectedPasResolverError(sHelperClassMethodForExtClassMustBeStatic,
+                              nHelperClassMethodForExtClassMustBeStatic);
+  ConvertProgram;
+end;
+
 procedure TTestModule.TestRecordHelper_ClassVar;
 begin
   StartProgram(false);
@@ -23326,7 +23651,7 @@ begin
   '{$modeswitch typehelpers}',
   'type',
   '  Float = type double;',
-  '  THelper = type helper for double',
+  '  THelper = type helper for Float',
   '    const NPI = 3.141592;',
   '    function ToStr: String;',
   '  end;',
@@ -23466,6 +23791,70 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestTypeHelper_JSValue;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch typehelpers}',
+  'type',
+  '  TExtValue = type jsvalue;',
+  '  THelper = type helper for TExtValue',
+  '    function ToStr: String;',
+  '  end;',
+  'function THelper.ToStr: String;',
+  'begin',
+  'end;',
+  'var',
+  '  s: string;',
+  '  v: TExtValue;',
+  'begin',
+  '  s:=v.toStr;',
+  '  s:=v.toStr();',
+  '  TExtValue(s).toStr;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestTypeHelper_JSValue',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "THelper", null, function () {',
+    '  this.ToStr = function () {',
+    '    var Result = "";',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.s = "";',
+    'this.v = undefined;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.s = $mod.THelper.ToStr.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.v;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.v = v;',
+    '    }',
+    '});',
+    '$mod.s = $mod.THelper.ToStr.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.v;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.v = v;',
+    '    }',
+    '});',
+    '$mod.THelper.ToStr.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.s;',
+    '    },',
+    '  set: function (v) {',
+    '      rtl.raiseE("EPropReadOnly");',
+    '    }',
+    '});',
+    '']));
+end;
+
 procedure TTestModule.TestTypeHelper_Array;
 begin
   StartProgram(false);

+ 60 - 20
utils/pas2js/dist/rtl.js

@@ -176,7 +176,8 @@ var rtl = {
 
   loaduseslist: function(module,useslist,f){
     if (useslist==undefined) return;
-    for (var i in useslist){
+    var len = useslist.length;
+    for (var i = 0; i<len; i++) {
       var unitname=useslist[i];
       if (rtl.debug_load_units) rtl.debug('loaduseslist of "'+module.$name+'" uses="'+unitname+'"');
       if (pas[unitname]==undefined)
@@ -627,7 +628,7 @@ var rtl = {
   },
 
   queryIntfIsT: function(obj,intftype){
-    var i = rtl.queryIntfG(obj,intftype.$guid);
+    var i = rtl.getIntfG(obj,intftype.$guid);
     if (!i) return false;
     if (i.$kind === 'com') i._Release();
     return true;
@@ -639,6 +640,18 @@ var rtl = {
     rtl.raiseEInvalidCast();
   },
 
+  intfIsIntfT: function(intf,intftype){
+    return (intf!==null) && rtl.queryIntfIsT(intf.$o,intftype);
+  },
+
+  intfAsIntfT: function (intf,intftype){
+    if (intf){
+      var i = rtl.getIntfG(intf.$o,intftype.$guid);
+      if (i!==null) return i;
+    }
+    rtl.raiseEInvalidCast();
+  },
+
   intfIsClass: function(intf,classtype){
     return (intf!=null) && (rtl.is(intf.$o,classtype));
   },
@@ -797,34 +810,56 @@ var rtl = {
   },
 
   arraySetLength: function(arr,defaultvalue,newlength){
-    // multi dim: (arr,defaultvalue,dim1,dim2,...)
-    var p = arguments;
-    function setLength(src,argNo){
-      var newlen = p[argNo];
-      var a = [];
-      a.length = newlength;
-      if (argNo === p.length-1){
-        var oldlen = src?src.length:0;
+    var stack = [];
+    for (var i=2; i<arguments.length; i++){
+      stack.push({ dim:arguments[i]+0, a:null, i:0, src:null });
+    }
+    var dimmax = stack.length-1;
+    var depth = 0;
+    var lastlen = stack[dimmax].dim;
+    var item = null;
+    var a = null;
+    var src = arr;
+    var oldlen = 0
+    do{
+      a = [];
+      if (depth>0){
+        item=stack[depth-1];
+        item.a[item.i]=a;
+        src = (item.src && item.src.length>item.i)?item.src[item.i]:null;
+        item.i++;
+      }
+      if (depth<dimmax){
+        item = stack[depth];
+        item.a = a;
+        item.i = 0;
+        item.src = src;
+        depth++;
+      } else {
+        oldlen = src?src.length:0;
         if (rtl.isArray(defaultvalue)){
-          for (var i=0; i<newlen; i++) a[i]=(i<oldlen)?src[i]:[]; // array of dyn array
+          for (var i=0; i<lastlen; i++) a[i]=(i<oldlen)?src[i]:[]; // array of dyn array
         } else if (rtl.isObject(defaultvalue)) {
           if (rtl.isTRecord(defaultvalue)){
-            for (var i=0; i<newlen; i++)
+            for (var i=0; i<lastlen; i++){
               a[i]=(i<oldlen)?defaultvalue.$clone(src[i]):defaultvalue.$new(); // e.g. record
+            }
           } else {
-            for (var i=0; i<newlen; i++) a[i]=(i<oldlen)?rtl.refSet(src[i]):{}; // e.g. set
+            for (var i=0; i<lastlen; i++) a[i]=(i<oldlen)?rtl.refSet(src[i]):{}; // e.g. set
           }
         } else {
-          for (var i=0; i<newlen; i++)
+          for (var i=0; i<lastlen; i++)
             a[i]=(i<oldlen)?src[i]:defaultvalue;
         }
-      } else {
-        // multi dim array
-        for (var i=0; i<newlen; i++) a[i]=setLength(src?src[i]:null,argNo+1);
+        while ((depth>0) && (stack[depth-1].i>=stack[depth-1].dim)){
+          depth--;
+        };
+        if (depth===0){
+          if (dimmax===0) return a;
+          return stack[0].a;
+        }
       }
-      return a;
-    }
-    return setLength(arr,2);
+    }while (true);
   },
 
   /*arrayChgLength: function(arr,defaultvalue,newlength){
@@ -1099,6 +1134,11 @@ var rtl = {
     return 0;
   },
 
+  lw: function(l){
+    // fix longword bitwise operation
+    return l<0?l+0x100000000:l;
+  },
+
   and: function(a,b){
     var hi = 0x80000000;
     var low = 0x7fffffff;

+ 12 - 4
utils/pas2js/docs/translation.html

@@ -2691,10 +2691,14 @@ function(){
     An external class is not a TObject and has none of its methods.<br>
     All members are external. If you omit the <i>external</i> modifier the
     external name is the member name. Keep in mind that JS is case sensitive.<br>
-    Destructors are not allowed.<br>
-    Constructors are only allowed with the name <i>New</i> and a call
-    translates to <i>new ExtClass(params)</i>.
     Properties work the same as with Pascal classes, i.e. are replaced by Getter/Setter.<br>
+    Destructors are not allowed.<br>
+    Constructors are supported in three ways:
+    <ul>
+      <li>With name <i>New</i> it is translated to <i>new ExtClass(params)</i>.</li>
+      <li>With external name <i>'{}'</i> it is translated to <i>{}</i>.</li>
+      <li>Otherwise it is translated to <i>new ExtClass.FuncName(params)</i>.</li>
+    </ul>
 
     <table class="sample">
       <tbody>
@@ -2762,7 +2766,8 @@ End.
       <li>You can typecast function addresses and function references to JS
       function, e.g. <i>TJSFunction(@SomeProc)</i>, <i>TJSFunction(OnClick)</i>.
       Keep in mind that typecasting a method address creates a function wrapper
-      to bind the Self argument.</li>
+      to bind the Self argument, except when typecasting to <i>TJSFunction</i>
+      (pas2js 1.5+).</li>
     </ul>
     </div>
 
@@ -3009,6 +3014,7 @@ End.
     <li>{$mode delphi} or {$mode objfpc}: Same as -Mdelphi or -Mobjfpc, but only for this unit. You can use units of both modes in a program. If present must be at the top of the unit, or after the module name.</li>
     <li>{$modeswitch externalclass}: allow declaring external classes</li>
     <li>{$modeswitch arrayoperators}: allow + operator to concatenate arrays, default in mode delphi</li>
+    <li>{$modeswitch OmitRTTI}: treat published sections as public</li>
     <li>{$macro on|off} enables macro replacements. Only macros with a value are replaced. Macros are never replaced inside directives.</li>
     <li>{$I filename} or {$include filename} - insert include file</li>
     <li>{$I %param%}:
@@ -3072,6 +3078,8 @@ End.
         <li>Check type casts, e.g. <i>TBird(AnObject)</i> becomes <i>AnObject as TBird</i></li>
       </ul>
     </li>
+    <li>{$DispatchField Msg}: enable checking <i>message number</i> methods for record field name "Msg"</li>
+    <li>{$DispatchStrField MsgStr}: enable checking <i>message string</i> methods for record field name "Msg"</li>
     </ul>
     Defines:
     <ul>

+ 2 - 2
utils/pas2js/pas2js.lpi

@@ -1,15 +1,15 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <General>
       <Flags>
         <MainUnitHasUsesSectionForAllUnits Value="False"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="pas2js"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>

Some files were not shown because too many files changed in this diff