Browse Source

# revisions: 43198,43199,43201,43202,43204,43206,43207,43209,43210,43212,43213,43214,43215,43216,43219,43220,43221,43222,43223,43224,43225,43228,43229,43285,43286,43287,43288,43295,43296,43297,43303,43304,43310,43316,43317,43318,43320,43321,43322,43323,43325,43326,43329,43330,43331,43332,43333

git-svn-id: branches/fixes_3_2@43380 -
marco 5 years ago
parent
commit
cf2b4ee4f7

+ 3 - 0
.gitattributes

@@ -7000,10 +7000,13 @@ packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
 packages/pastojs/src/pas2jsfs.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfs.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfscompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsfscompiler.pp svneol=native#text/plain
+packages/pastojs/src/pas2jshtmlresources.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsjsresources.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
 packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
+packages/pastojs/src/pas2jsresources.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsresstrfile.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsresstrfile.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsuseanalyzer.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain
 packages/pastojs/src/pas2jsutils.pp svneol=native#text/plain

+ 39 - 3
packages/fcl-passrc/src/pasresolveeval.pas

@@ -71,7 +71,7 @@ unit PasResolveEval;
 interface
 interface
 
 
 uses
 uses
-  Sysutils, Math, PasTree, PScanner;
+  Sysutils, Classes, Math, PasTree, PScanner;
 
 
 // message numbers
 // message numbers
 const
 const
@@ -106,7 +106,7 @@ const
   nTypesAreNotRelatedXY = 3029;
   nTypesAreNotRelatedXY = 3029;
   nAbstractMethodsCannotBeCalledDirectly = 3030;
   nAbstractMethodsCannotBeCalledDirectly = 3030;
   nMissingParameterX = 3031;
   nMissingParameterX = 3031;
-  nCannotAccessThisMemberFromAX = 3032;
+  nInstanceMemberXInaccessible = 3032;
   nInOperatorExpectsSetElementButGot = 3033;
   nInOperatorExpectsSetElementButGot = 3033;
   nWrongNumberOfParametersForTypeCast = 3034;
   nWrongNumberOfParametersForTypeCast = 3034;
   nIllegalTypeConversionTo = 3035;
   nIllegalTypeConversionTo = 3035;
@@ -250,7 +250,7 @@ resourcestring
   sTypesAreNotRelatedXY = 'Types are not related: "%s" and "%s"';
   sTypesAreNotRelatedXY = 'Types are not related: "%s" and "%s"';
   sAbstractMethodsCannotBeCalledDirectly = 'Abstract methods cannot be called directly';
   sAbstractMethodsCannotBeCalledDirectly = 'Abstract methods cannot be called directly';
   sMissingParameterX = 'Missing parameter %s';
   sMissingParameterX = 'Missing parameter %s';
-  sCannotAccessThisMemberFromAX = 'Cannot access this member from a %s';
+  sInstanceMemberXInaccessible = 'Instance member "%s" inaccessible here';
   sInOperatorExpectsSetElementButGot = 'the in-operator expects a set element, but got %s';
   sInOperatorExpectsSetElementButGot = 'the in-operator expects a set element, but got %s';
   sWrongNumberOfParametersForTypeCast = 'wrong number of parameters for type cast to %s';
   sWrongNumberOfParametersForTypeCast = 'wrong number of parameters for type cast to %s';
   sIllegalTypeConversionTo = 'Illegal type conversion: "%s" to "%s"';
   sIllegalTypeConversionTo = 'Illegal type conversion: "%s" to "%s"';
@@ -798,6 +798,8 @@ function CodePointToUnicodeString(u: longword): UnicodeString;
 function GetObjName(o: TObject): string;
 function GetObjName(o: TObject): string;
 function GetObjPath(o: TObject): string;
 function GetObjPath(o: TObject): string;
 function GetGenericParamCommas(Cnt: integer): string;
 function GetGenericParamCommas(Cnt: integer): string;
+function GetElementNameAndParams(El: TPasElement; MaxLvl: integer = 3): string;
+function GetTypeParamNames(Templates: TFPList; MaxLvl: integer = 3): string;
 function dbgs(const Flags: TResEvalFlags): string; overload;
 function dbgs(const Flags: TResEvalFlags): string; overload;
 function dbgs(v: TResEvalValue): string; overload;
 function dbgs(v: TResEvalValue): string; overload;
 function LastPos(c: char; const s: string): sizeint;
 function LastPos(c: char; const s: string): sizeint;
@@ -1081,6 +1083,40 @@ begin
     Result:='<'+StringOfChar(',',Cnt-1)+'>';
     Result:='<'+StringOfChar(',',Cnt-1)+'>';
 end;
 end;
 
 
+function GetElementNameAndParams(El: TPasElement; MaxLvl: integer): string;
+begin
+  if El=nil then
+    exit('(nil)');
+  Result:=El.Name;
+  if El is TPasGenericType then
+    Result:=Result+GetTypeParamNames(TPasGenericType(El).GenericTemplateTypes,MaxLvl-1);
+end;
+
+function GetTypeParamNames(Templates: TFPList; MaxLvl: integer): string;
+var
+  i: Integer;
+  El: TPasElement;
+begin
+  if (Templates=nil) or (Templates.Count=0) then
+    exit('');
+  if MaxLvl<=0 then
+    exit('...');
+  Result:='<';
+  for i:=0 to Templates.Count-1 do
+    begin
+    if i>0 then
+      Result:=Result+',';
+    El:=TPasElement(Templates[i]);
+    if El.Name<>'' then
+      Result:=Result+GetElementNameAndParams(El,MaxLvl-1)
+    else if El is TPasArrayType then
+      Result:=Result+'array...'
+    else
+      Result:=Result+'...';
+    end;
+  Result:=Result+'>';
+end;
+
 function dbgs(const Flags: TResEvalFlags): string;
 function dbgs(const Flags: TResEvalFlags): string;
 var
 var
   s: string;
   s: string;

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


+ 4 - 0
packages/fcl-passrc/src/pastree.pp

@@ -848,6 +848,7 @@ type
     Args: TFPList;        // List of TPasArgument objects
     Args: TFPList;        // List of TPasArgument objects
     CallingConvention: TCallingConvention;
     CallingConvention: TCallingConvention;
     Modifiers: TProcTypeModifiers;
     Modifiers: TProcTypeModifiers;
+    VarArgsType: TPasType;
     property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
     property IsOfObject: Boolean read GetIsOfObject write SetIsOfObject;
     property IsNested : Boolean read GetIsNested write SetIsNested;
     property IsNested : Boolean read GetIsNested write SetIsNested;
     property IsReferenceTo : Boolean Read GetIsReference write SetIsReference;
     property IsReferenceTo : Boolean Read GetIsReference write SetIsReference;
@@ -3501,6 +3502,7 @@ begin
   for i := 0 to Args.Count - 1 do
   for i := 0 to Args.Count - 1 do
     TPasArgument(Args[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasProcedureType.Args'){$ENDIF};
     TPasArgument(Args[i]).Release{$IFDEF CheckPasTreeRefCount}('TPasProcedureType.Args'){$ENDIF};
   FreeAndNil(Args);
   FreeAndNil(Args);
+  ReleaseAndNil(TPasElement(VarArgsType){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
@@ -3526,6 +3528,7 @@ begin
   inherited ForEachCall(aMethodCall, Arg);
   inherited ForEachCall(aMethodCall, Arg);
   for i:=0 to Args.Count-1 do
   for i:=0 to Args.Count-1 do
     ForEachChildCall(aMethodCall,Arg,TPasElement(Args[i]),false);
     ForEachChildCall(aMethodCall,Arg,TPasElement(Args[i]),false);
+  ForEachChildCall(aMethodCall,Arg,VarArgsType,false);
 end;
 end;
 
 
 { TPasResultElement }
 { TPasResultElement }
@@ -4092,6 +4095,7 @@ procedure TPasAliasType.ForEachCall(const aMethodCall: TOnForEachPasElement;
 begin
 begin
   inherited ForEachCall(aMethodCall, Arg);
   inherited ForEachCall(aMethodCall, Arg);
   ForEachChildCall(aMethodCall,Arg,DestType,true);
   ForEachChildCall(aMethodCall,Arg,DestType,true);
+  ForEachChildCall(aMethodCall,Arg,Expr,false);
 end;
 end;
 
 
 procedure TPasAliasType.ClearTypeReferences(aType: TPasElement);
 procedure TPasAliasType.ClearTypeReferences(aType: TPasElement);

+ 96 - 16
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -55,7 +55,7 @@ uses
   {$else}
   {$else}
   AVL_Tree,
   AVL_Tree,
   {$endif}
   {$endif}
-  Classes, SysUtils, Types,
+  Classes, SysUtils, Types, contnrs,
   PasTree, PScanner, PasResolveEval, PasResolver;
   PasTree, PScanner, PasResolveEval, PasResolver;
 
 
 const
 const
@@ -253,6 +253,7 @@ type
     function ElementVisited(El: TPasElement; OtherCheck: TPAOtherCheckedEl): boolean; overload;
     function ElementVisited(El: TPasElement; OtherCheck: TPAOtherCheckedEl): boolean; overload;
     procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess);
     procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess);
     function CanSkipGenericType(El: TPasGenericType): boolean;
     function CanSkipGenericType(El: TPasGenericType): boolean;
+    function CanSkipGenericProc(DeclProc: TPasProcedure): boolean;
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
     procedure UseElement(El: TPasElement; Access: TResolvedRefAccess;
       UseFull: boolean); virtual;
       UseFull: boolean); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
     procedure UseTypeInfo(El: TPasElement); virtual;
@@ -1043,7 +1044,7 @@ begin
   else
   else
     begin
     begin
     // analyze a module
     // analyze a module
-    if ((El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0)) then
+    if (El.GenericTemplateTypes<>nil) and (El.GenericTemplateTypes.Count>0) then
       // generic template -> analyze
       // generic template -> analyze
     else if not Resolver.IsFullySpecialized(El) then
     else if not Resolver.IsFullySpecialized(El) then
       // half specialized -> skip
       // half specialized -> skip
@@ -1051,6 +1052,52 @@ begin
     end;
     end;
 end;
 end;
 
 
+function TPasAnalyzer.CanSkipGenericProc(DeclProc: TPasProcedure): boolean;
+
+  procedure RaiseHalfSpecialized;
+  var
+    Templates: TFPList;
+    ProcScope: TPasProcedureScope;
+    Item: TPRSpecializedItem;
+  begin
+    Templates:=Resolver.GetProcTemplateTypes(DeclProc);
+    if (Templates<>nil) and (Templates.Count>0) then
+      RaiseNotSupported(20191016132828,DeclProc);
+    if not (DeclProc.CustomData is TPasProcedureScope) then
+      RaiseNotSupported(20191016132836,DeclProc,GetObjName(DeclProc.CustomData));
+    ProcScope:=TPasProcedureScope(DeclProc.CustomData);
+    Item:=ProcScope.SpecializedFromItem;
+    if Item=nil then
+      RaiseNotSupported(20191016133013,DeclProc);
+    if Item.SpecializedEl=nil then
+      RaiseNotSupported(20191016133017,DeclProc);
+    if Item.FirstSpecialize=nil then
+      RaiseNotSupported(20191016133019,DeclProc);
+    RaiseNotSupported(20191016133022,DeclProc,'SpecializedAt:'+GetObjPath(Item.FirstSpecialize)+' '+Resolver.GetElementSourcePosStr(Item.FirstSpecialize));
+  end;
+
+var
+  Templates: TFPList;
+begin
+  Result:=false;
+  if ScopeModule=nil then
+    begin
+    // analyze whole program
+    if not Resolver.IsFullySpecialized(DeclProc) then
+      RaiseHalfSpecialized;
+    end
+  else
+    begin
+    // analyze a module
+    Templates:=Resolver.GetProcTemplateTypes(DeclProc);
+    if (Templates<>nil) and (Templates.Count>0) then
+      // generic template -> analyze
+    else if not Resolver.IsFullySpecialized(DeclProc) then
+      // half specialized -> skip
+      exit(true);
+    end;
+end;
+
 procedure TPasAnalyzer.UseElement(El: TPasElement; Access: TResolvedRefAccess;
 procedure TPasAnalyzer.UseElement(El: TPasElement; Access: TResolvedRefAccess;
   UseFull: boolean);
   UseFull: boolean);
 var
 var
@@ -1357,7 +1404,10 @@ begin
       UseVariable(TPasVariable(Decl),rraNone,true);
       UseVariable(TPasVariable(Decl),rraNone,true);
       end
       end
     else if C=TPasResString then
     else if C=TPasResString then
-      UseResourcestring(TPasResString(Decl))
+      begin
+      if OnlyExports then continue;
+      UseResourcestring(TPasResString(Decl));
+      end
     else if C=TPasAttributes then
     else if C=TPasAttributes then
       // attributes are never used directly
       // attributes are never used directly
     else
     else
@@ -1864,6 +1914,7 @@ begin
   ProcScope:=Proc.CustomData as TPasProcedureScope;
   ProcScope:=Proc.CustomData as TPasProcedureScope;
   if ProcScope.DeclarationProc<>nil then
   if ProcScope.DeclarationProc<>nil then
     exit; // skip implementation, Note:PasResolver always refers the declaration
     exit; // skip implementation, Note:PasResolver always refers the declaration
+  if CanSkipGenericProc(Proc) then exit;
 
 
   if not MarkElementAsUsed(Proc) then exit;
   if not MarkElementAsUsed(Proc) then exit;
   {$IFDEF VerbosePasAnalyzer}
   {$IFDEF VerbosePasAnalyzer}
@@ -1932,7 +1983,7 @@ begin
   writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
   writeln('TPasAnalyzer.UseProcedureType ',GetElModName(ProcType));
   {$ENDIF}
   {$ENDIF}
   if not MarkElementAsUsed(ProcType) then exit;
   if not MarkElementAsUsed(ProcType) then exit;
-  if (ScopeModule=nil) and not Resolver.IsFullySpecialized(ProcType) then
+  if CanSkipGenericType(ProcType) then
     RaiseNotSupported(20190817151651,ProcType);
     RaiseNotSupported(20190817151651,ProcType);
 
 
   for i:=0 to ProcType.Args.Count-1 do
   for i:=0 to ProcType.Args.Count-1 do
@@ -2630,8 +2681,10 @@ var
   C: TClass;
   C: TClass;
   Usage: TPAElement;
   Usage: TPAElement;
   i: Integer;
   i: Integer;
-  Member: TPasElement;
+  Member, SpecEl: TPasElement;
   Members: TFPList;
   Members: TFPList;
+  GenScope: TPasGenericScope;
+  SpecializedItems: TObjectList;
 begin
 begin
   {$IFDEF VerbosePasAnalyzer}
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
   writeln('TPasAnalyzer.EmitTypeHints ',GetElModName(El));
@@ -2640,6 +2693,21 @@ begin
   if Usage=nil then
   if Usage=nil then
     begin
     begin
     // the whole type was never used
     // the whole type was never used
+    if IsSpecializedGenericType(El) then
+      exit; // no hints for not used specializations
+    if (El.CustomData is TPasGenericScope) then
+      begin
+      GenScope:=TPasGenericScope(El.CustomData);
+      SpecializedItems:=GenScope.SpecializedItems;
+      if SpecializedItems<>nil then
+        for i:=0 to SpecializedItems.Count-1 do
+          begin
+          SpecEl:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
+          if FindElement(SpecEl)<>nil then
+            exit; // a specialization of this generic type is used
+          end;
+      end;
+
     if (El.Visibility in [visPrivate,visStrictPrivate]) then
     if (El.Visibility in [visPrivate,visStrictPrivate]) then
       EmitMessage(20170312000020,mtHint,nPAPrivateTypeXNeverUsed,
       EmitMessage(20170312000020,mtHint,nPAPrivateTypeXNeverUsed,
         sPAPrivateTypeXNeverUsed,[El.FullName],El)
         sPAPrivateTypeXNeverUsed,[El.FullName],El)
@@ -2647,10 +2715,9 @@ begin
       begin
       begin
       if (El is TPasClassType) and (TPasClassType(El).ObjKind=okInterface) then
       if (El is TPasClassType) and (TPasClassType(El).ObjKind=okInterface) then
         exit;
         exit;
-      if IsSpecializedGenericType(El) then exit;
 
 
       EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
       EmitMessage(20170312000025,mtHint,nPALocalXYNotUsed,
-        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
+        sPALocalXYNotUsed,[El.ElementTypeName,GetElementNameAndParams(El)],El);
       end;
       end;
     exit;
     exit;
     end;
     end;
@@ -2726,6 +2793,8 @@ var
   Usage: TPAElement;
   Usage: TPAElement;
   ProcScope: TPasProcedureScope;
   ProcScope: TPasProcedureScope;
   DeclProc, ImplProc: TPasProcedure;
   DeclProc, ImplProc: TPasProcedure;
+  SpecializedItems: TObjectList;
+  SpecEl: TPasElement;
 begin
 begin
   {$IFDEF VerbosePasAnalyzer}
   {$IFDEF VerbosePasAnalyzer}
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
   writeln('TPasAnalyzer.EmitProcedureHints ',GetElModName(El));
@@ -2746,15 +2815,26 @@ begin
   if not PAElementExists(DeclProc) then
   if not PAElementExists(DeclProc) then
     begin
     begin
     // procedure never used
     // procedure never used
-    if ProcScope.DeclarationProc=nil then
-      begin
-      if El.Visibility in [visPrivate,visStrictPrivate] then
-        EmitMessage(20170312093348,mtHint,nPAPrivateMethodIsNeverUsed,
-          sPAPrivateMethodIsNeverUsed,[El.FullName],El)
-      else
-        EmitMessage(20170312093418,mtHint,nPALocalXYNotUsed,
-          sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
-      end;
+    if ProcScope.DeclarationProc<>nil then
+      exit;
+
+    if ProcScope.SpecializedFromItem<>nil then
+      exit; // no hint for not used specialized procedure
+    SpecializedItems:=ProcScope.SpecializedItems;
+    if SpecializedItems<>nil then
+      for i:=0 to SpecializedItems.Count-1 do
+        begin
+        SpecEl:=TPRSpecializedItem(SpecializedItems[i]).SpecializedEl;
+        if FindElement(SpecEl)<>nil then
+          exit; // a specialization of this generic procedure is used
+        end;
+
+    if El.Visibility in [visPrivate,visStrictPrivate] then
+      EmitMessage(20170312093348,mtHint,nPAPrivateMethodIsNeverUsed,
+        sPAPrivateMethodIsNeverUsed,[El.FullName],El)
+    else
+      EmitMessage(20170312093418,mtHint,nPALocalXYNotUsed,
+        sPALocalXYNotUsed,[El.ElementTypeName,El.Name],El);
     exit;
     exit;
     end;
     end;
 
 

+ 168 - 113
packages/fcl-passrc/src/pparser.pp

@@ -410,7 +410,7 @@ type
     function ArrayExprToText(Expr: TPasExprArray): String;
     function ArrayExprToText(Expr: TPasExprArray): String;
     // Type declarations
     // Type declarations
     function ResolveTypeReference(Name: string; Parent: TPasElement; ParamCnt: integer = 0): TPasType;
     function ResolveTypeReference(Name: string; Parent: TPasElement; ParamCnt: integer = 0): TPasType;
-    function ParseComplexType(Parent : TPasElement = Nil): TPasType;
+    function ParseVarType(Parent : TPasElement = Nil): TPasType;
     function ParseTypeDecl(Parent: TPasElement): TPasType;
     function ParseTypeDecl(Parent: TPasElement): TPasType;
     function ParseGenericTypeDecl(Parent: TPasElement; AddToParent: boolean): TPasGenericType;
     function ParseGenericTypeDecl(Parent: TPasElement; AddToParent: boolean): TPasGenericType;
     function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false): TPasType;
     function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false): TPasType;
@@ -420,7 +420,7 @@ type
     function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
     function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
     function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasType;
     function ParseAliasType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasType;
     function ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; out Expr: TPasExpr): TPasType;
     function ParseTypeReference(Parent: TPasElement; NeedExpr: boolean; out Expr: TPasExpr): TPasType;
-    function ParseSpecializeType(Parent: TPasElement; const TypeName, GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType;
+    function ParseSpecializeType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName, GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType;
     function ParsePointerType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasPointerType;
     function ParsePointerType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasPointerType;
     Function ParseArrayType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String; PackMode : TPackMode) : TPasArrayType;
     Function ParseArrayType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String; PackMode : TPackMode) : TPasArrayType;
     Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName  : String) : TPasFileType;
     Function ParseFileType(Parent : TPasElement; Const NamePos: TPasSourcePos; Const TypeName  : String) : TPasFileType;
@@ -530,6 +530,79 @@ type
   TDeclType = (declNone, declConst, declResourcestring, declType,
   TDeclType = (declNone, declConst, declResourcestring, declType,
                declVar, declThreadvar, declProperty, declExports);
                declVar, declThreadvar, declProperty, declExports);
 
 
+{$IF FPC_FULLVERSION<30301}
+Function SplitCommandLine(S: String) : TStringDynArray;
+
+  Function GetNextWord : String;
+
+  Const
+    WhiteSpace = [' ',#9,#10,#13];
+    Literals = ['"',''''];
+
+  Var
+    Wstart,wend : Integer;
+    InLiteral : Boolean;
+    LastLiteral : Char;
+
+    Procedure AppendToResult;
+
+    begin
+      Result:=Result+Copy(S,WStart,WEnd-WStart);
+      WStart:=Wend+1;
+    end;
+
+  begin
+    Result:='';
+    WStart:=1;
+    While (WStart<=Length(S)) and charinset(S[WStart],WhiteSpace) do
+      Inc(WStart);
+    WEnd:=WStart;
+    InLiteral:=False;
+    LastLiteral:=#0;
+    While (Wend<=Length(S)) and (Not charinset(S[Wend],WhiteSpace) or InLiteral) do
+      begin
+      if charinset(S[Wend],Literals) then
+        If InLiteral then
+          begin
+          InLiteral:=Not (S[Wend]=LastLiteral);
+          if not InLiteral then
+            AppendToResult;
+          end
+        else
+          begin
+          InLiteral:=True;
+          LastLiteral:=S[Wend];
+          AppendToResult;
+          end;
+       inc(wend);
+       end;
+     AppendToResult;
+     While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
+       inc(Wend);
+     Delete(S,1,WEnd-1);
+  end;
+
+Var
+  W : String;
+  len : Integer;
+
+begin
+  Len:=0;
+  Result:=Default(TStringDynArray);
+  SetLength(Result,(Length(S) div 2)+1);
+  While Length(S)>0 do
+    begin
+    W:=GetNextWord;
+    If (W<>'') then
+      begin
+      Result[Len]:=W;
+      Inc(Len);
+      end;
+    end;
+  SetLength(Result,Len);
+end;
+{$ENDIF}
+
 Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
 Function IsHintToken(T : String; Out AHint : TPasMemberHint) : boolean;
 
 
 Const
 Const
@@ -610,96 +683,27 @@ end;
 
 
 function ParseSource(AEngine: TPasTreeContainer;
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
   const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
-
+var
+  FPCParams: TStringDynArray;
 begin
 begin
-  Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[]);
+  FPCParams:=SplitCommandLine(FPCCommandLine);
+  Result:=ParseSource(AEngine, FPCParams, OSTarget, CPUTarget,[]);
 end;
 end;
 
 
 {$ifdef HasStreams}
 {$ifdef HasStreams}
 function ParseSource(AEngine: TPasTreeContainer;
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String; UseStreams : Boolean): TPasModule;
   const FPCCommandLine, OSTarget, CPUTarget: String; UseStreams : Boolean): TPasModule;
-
+var
+  FPCParams: TStringDynArray;
 begin
 begin
+  FPCParams:=SplitCommandLine(FPCCommandLine);
   if UseStreams then
   if UseStreams then
-    Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[poUseStreams])
+    Result:=ParseSource(AEngine,FPCParams, OSTarget, CPUTarget,[poUseStreams])
   else
   else
-    Result:=ParseSource(AEngine,FPCCommandLine, OSTarget, CPUTarget,[]);
+    Result:=ParseSource(AEngine,FPCParams, OSTarget, CPUTarget,[]);
 end;
 end;
 {$endif}
 {$endif}
 
 
-{$IF FPC_FULLVERSION<30301}
-Function SplitCommandLine(S: String) : TStringDynArray;
-
-  Function GetNextWord : String;
-
-  Const
-    WhiteSpace = [' ',#9,#10,#13];
-    Literals = ['"',''''];
-
-  Var
-    Wstart,wend : Integer;
-    InLiteral : Boolean;
-    LastLiteral : Char;
-
-    Procedure AppendToResult;
-
-    begin
-      Result:=Result+Copy(S,WStart,WEnd-WStart);
-      WStart:=Wend+1;
-    end;
-
-  begin
-    Result:='';
-    WStart:=1;
-    While (WStart<=Length(S)) and charinset(S[WStart],WhiteSpace) do
-      Inc(WStart);
-    WEnd:=WStart;
-    InLiteral:=False;
-    LastLiteral:=#0;
-    While (Wend<=Length(S)) and (Not charinset(S[Wend],WhiteSpace) or InLiteral) do
-      begin
-      if charinset(S[Wend],Literals) then
-        If InLiteral then
-          begin
-          InLiteral:=Not (S[Wend]=LastLiteral);
-          if not InLiteral then
-            AppendToResult;
-          end
-        else
-          begin
-          InLiteral:=True;
-          LastLiteral:=S[Wend];
-          AppendToResult;
-          end;
-       inc(wend);
-       end;
-     AppendToResult;
-     While (WEnd<=Length(S)) and (S[Wend] in WhiteSpace) do
-       inc(Wend);
-     Delete(S,1,WEnd-1);
-  end;
-
-Var
-  W : String;
-  len : Integer;
-
-begin
-  Len:=0;
-  Result:=Default(TStringDynArray);
-  SetLength(Result,(Length(S) div 2)+1);
-  While Length(S)>0 do
-    begin
-    W:=GetNextWord;
-    If (W<>'') then
-      begin
-      Result[Len]:=W;
-      Inc(Len);
-      end;
-    end;
-  SetLength(Result,Len);
-end;
-{$ENDIF}
-
 function ParseSource(AEngine: TPasTreeContainer;
 function ParseSource(AEngine: TPasTreeContainer;
   const FPCCommandLine, OSTarget, CPUTarget: String;
   const FPCCommandLine, OSTarget, CPUTarget: String;
   Options : TParseSourceOptions): TPasModule;
   Options : TParseSourceOptions): TPasModule;
@@ -1500,10 +1504,11 @@ begin
       begin
       begin
       Params:=TParamsExpr(CreateElement(TParamsExpr,'',Result));
       Params:=TParamsExpr(CreateElement(TParamsExpr,'',Result));
       Params.Value:=Result.Expr;
       Params.Value:=Result.Expr;
+      Params.Value.Parent:=Params;
       Result.Expr:=Params;
       Result.Expr:=Params;
       LengthAsText:='';
       LengthAsText:='';
       NextToken;
       NextToken;
-      LengthExpr:=DoParseExpression(Result,nil,false);
+      LengthExpr:=DoParseExpression(Params,nil,false);
       Params.AddParam(LengthExpr);
       Params.AddParam(LengthExpr);
       CheckToken(tkSquaredBraceClose);
       CheckToken(tkSquaredBraceClose);
       LengthAsText:=ExprToText(LengthExpr);
       LengthAsText:=ExprToText(LengthExpr);
@@ -1580,7 +1585,7 @@ begin
     else if (CurToken = tkLessThan)
     else if (CurToken = tkLessThan)
         and (MustBeSpecialize or (msDelphi in CurrentModeswitches)) then // A = B<t>;
         and (MustBeSpecialize or (msDelphi in CurrentModeswitches)) then // A = B<t>;
       begin
       begin
-      Result:=ParseSpecializeType(Parent,TypeName,Name,Expr);
+      Result:=ParseSpecializeType(Parent,NamePos,TypeName,Name,Expr);
       ok:=true;
       ok:=true;
       exit;
       exit;
       end
       end
@@ -1672,11 +1677,13 @@ function TPasParser.ParseTypeReference(Parent: TPasElement; NeedExpr: boolean;
 var
 var
   Name: String;
   Name: String;
   IsSpecialize, ok: Boolean;
   IsSpecialize, ok: Boolean;
+  NamePos: TPasSourcePos;
 begin
 begin
   Result:=nil;
   Result:=nil;
   Expr:=nil;
   Expr:=nil;
   ok:=false;
   ok:=false;
   try
   try
+    NamePos:=CurSourcePos;
     if CurToken=tkspecialize then
     if CurToken=tkspecialize then
       begin
       begin
       IsSpecialize:=true;
       IsSpecialize:=true;
@@ -1693,9 +1700,11 @@ begin
       // specialize
       // specialize
       if IsSpecialize or (msDelphi in CurrentModeswitches) then
       if IsSpecialize or (msDelphi in CurrentModeswitches) then
         begin
         begin
-        Result:=ParseSpecializeType(Parent,'',Name,Expr);
+        Result:=ParseSpecializeType(Parent,NamePos,'',Name,Expr);
         NextToken;
         NextToken;
-        end;
+        end
+      else
+        CheckToken(tkend);
       end
       end
     else if IsSpecialize then
     else if IsSpecialize then
       CheckToken(tkLessThan)
       CheckToken(tkLessThan)
@@ -1717,8 +1726,9 @@ begin
   end;
   end;
 end;
 end;
 
 
-function TPasParser.ParseSpecializeType(Parent: TPasElement; const TypeName,
-  GenName: string; var GenNameExpr: TPasExpr): TPasSpecializeType;
+function TPasParser.ParseSpecializeType(Parent: TPasElement;
+  const NamePos: TPasSourcePos; const TypeName, GenName: string;
+  var GenNameExpr: TPasExpr): TPasSpecializeType;
 // after parsing CurToken is at >
 // after parsing CurToken is at >
 var
 var
   ST: TPasSpecializeType;
   ST: TPasSpecializeType;
@@ -1726,7 +1736,7 @@ begin
   Result:=nil;
   Result:=nil;
   if CurToken<>tkLessThan then
   if CurToken<>tkLessThan then
     ParseExcTokenError('[20190801112729]');
     ParseExcTokenError('[20190801112729]');
-  ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,TypeName,Parent));
+  ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,TypeName,Parent,NamePos));
   try
   try
     if GenNameExpr<>nil then
     if GenNameExpr<>nil then
       begin
       begin
@@ -1992,7 +2002,9 @@ begin
   Result.IsReferenceTo:=True;
   Result.IsReferenceTo:=True;
 end;
 end;
 
 
-function TPasParser.ParseComplexType(Parent : TPasElement = Nil): TPasType;
+function TPasParser.ParseVarType(Parent : TPasElement = Nil): TPasType;
+var
+  NamePos: TPasSourcePos;
 begin
 begin
   NextToken;
   NextToken;
   case CurToken of
   case CurToken of
@@ -2011,8 +2023,9 @@ begin
           UngetToken;        // Unget semicolon
           UngetToken;        // Unget semicolon
       end;
       end;
   else
   else
+    NamePos:=CurSourcePos;
     UngetToken;
     UngetToken;
-    Result := ParseType(Parent,CurSourcePos);
+    Result := ParseType(Parent,NamePos);
   end;
   end;
 end;
 end;
 
 
@@ -2404,6 +2417,7 @@ begin
       try
       try
         ProcExpr:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
         ProcExpr:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
         ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType,false));
         ProcExpr.Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(ProcExpr,ProcType,false));
+        Engine.FinishScope(stProcedure,ProcExpr.Proc);
         Result:=ProcExpr;
         Result:=ProcExpr;
       finally
       finally
         if Result=nil then
         if Result=nil then
@@ -2413,16 +2427,15 @@ begin
       end;
       end;
     tkCaret:
     tkCaret:
       begin
       begin
-      // is this still needed?
-      // ^A..^_ characters. See #16341
+      // Why is this still needed?
+      // ^A..^_ characters
       NextToken;
       NextToken;
       if not (length(CurTokenText)=1) or not (CurTokenText[1] in ['A'..'_']) then
       if not (length(CurTokenText)=1) or not (CurTokenText[1] in ['A'..'_']) then
         begin
         begin
         UngetToken;
         UngetToken;
         ParseExcExpectedIdentifier;
         ParseExcExpectedIdentifier;
         end;
         end;
-      Result:=CreatePrimitiveExpr(AParent,pekString, '^'+CurTokenText);
-      exit;
+      Last:=CreatePrimitiveExpr(AParent,pekString, '^'+CurTokenText);
       end;
       end;
     tkBraceOpen:
     tkBraceOpen:
       begin
       begin
@@ -2947,6 +2960,7 @@ begin
       Functions.Add(AProc);
       Functions.Add(AProc);
       end;
       end;
     end;
     end;
+  Engine.FinishScope(stProcedure,AProc);
 end;
 end;
 
 
 // Return the parent of a function declaration. This is AParent,
 // Return the parent of a function declaration. This is AParent,
@@ -3546,13 +3560,9 @@ begin
       SetBlock(declNone);
       SetBlock(declNone);
       SaveComments;
       SaveComments;
       NextToken;
       NextToken;
-      If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
-        begin
-        pt:=GetProcTypeFromToken(CurToken,True);
-        AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
-        end
-      else
-        CheckToken(tkprocedure);
+      CheckTokens([tkprocedure,tkFunction,tkConstructor,tkDestructor,tkoperator]);
+      pt:=GetProcTypeFromToken(CurToken,True);
+      AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
       end;
       end;
     tkIdentifier:
     tkIdentifier:
       begin
       begin
@@ -3667,7 +3677,7 @@ begin
     tkGeneric:
     tkGeneric:
       begin
       begin
       NextToken;
       NextToken;
-      if (CurToken in [tkprocedure,tkfunction]) then
+      if (CurToken in [tkclass,tkprocedure,tkfunction]) then
         begin
         begin
         if msDelphi in CurrentModeswitches then
         if msDelphi in CurrentModeswitches then
           ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
           ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
@@ -4614,14 +4624,15 @@ begin
                                         AVisibility,CurTokenPos));
                                         AVisibility,CurTokenPos));
       VarList.Add(VarEl);
       VarList.Add(VarEl);
       NextToken;
       NextToken;
-      if Not (CurToken in [tkComma,tkColon]) then
-        ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
-      if CurToken=tkComma then
-        ExpectIdentifier;
+      case CurToken of
+      tkColon: break;
+      tkComma: ExpectIdentifier;
+      else     ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
+      end;
     Until (CurToken=tkColon);
     Until (CurToken=tkColon);
     OldForceCaret:=Scanner.SetForceCaret(True);
     OldForceCaret:=Scanner.SetForceCaret(True);
     try
     try
-      VarType := ParseComplexType(VarEl);
+      VarType := ParseVarType(VarEl);
       {$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF};
       {$IFDEF CheckPasTreeRefCount}if VarType.RefIds.IndexOf('CreateElement')>=0 then VarType.ChangeRefId('CreateElement','TPasVariable.VarType'){$ENDIF};
     finally
     finally
       Scanner.SetForceCaret(OldForceCaret);
       Scanner.SetForceCaret(OldForceCaret);
@@ -5102,10 +5113,28 @@ end;
 
 
 procedure TPasParser.HandleProcedureTypeModifier(ProcType: TPasProcedureType;
 procedure TPasParser.HandleProcedureTypeModifier(ProcType: TPasProcedureType;
   ptm: TProcTypeModifier);
   ptm: TProcTypeModifier);
+var
+  Expr: TPasExpr;
 begin
 begin
   if ptm in ProcType.Modifiers then
   if ptm in ProcType.Modifiers then
     ParseExcSyntaxError;
     ParseExcSyntaxError;
   Include(ProcType.Modifiers,ptm);
   Include(ProcType.Modifiers,ptm);
+  if ptm=ptmVarargs then
+    begin
+    NextToken;
+    if CurToken<>tkof then
+      begin
+      UngetToken;
+      exit;
+      end;
+    NextToken;
+    Expr:=nil;
+    try
+      ProcType.VarArgsType:=ParseTypeReference(ProcType,false,Expr);
+    finally
+      if Expr<>nil then Expr.Release{$IFDEF CheckPasTreeRefCount}('20191029145019'){$ENDIF};
+    end;
+    end;
 end;
 end;
 
 
 // Next token is expected to be a "(", ";" or for a function ":". The caller
 // Next token is expected to be a "(", ";" or for a function ":". The caller
@@ -5398,8 +5427,6 @@ begin
      or IsAnonymous)
      or IsAnonymous)
   then
   then
     ParseProcedureBody(Parent);
     ParseProcedureBody(Parent);
-  if not IsProcType then
-    Engine.FinishScope(stProcedure,Parent);
 end;
 end;
 
 
 // starts after the semicolon
 // starts after the semicolon
@@ -6498,12 +6525,14 @@ var
   end;
   end;
 
 
 var
 var
-  Name: String;
+  N,Name: String;
   PC : TPTreeElement;
   PC : TPTreeElement;
   Ot : TOperatorType;
   Ot : TOperatorType;
   IsTokenBased , ok: Boolean;
   IsTokenBased , ok: Boolean;
   j, i: Integer;
   j, i: Integer;
+
 begin
 begin
+  N:='';
   NameParts:=nil;
   NameParts:=nil;
   Result:=nil;
   Result:=nil;
   ok:=false;
   ok:=false;
@@ -6518,10 +6547,28 @@ begin
       if IsTokenBased then
       if IsTokenBased then
         OT:=TPasOperator.TokenToOperatorType(CurTokenText)
         OT:=TPasOperator.TokenToOperatorType(CurTokenText)
       else
       else
+        begin
         OT:=TPasOperator.NameToOperatorType(CurTokenString);
         OT:=TPasOperator.NameToOperatorType(CurTokenString);
+        N:=CurTokenString;
+        // Case Class operator TMyRecord.+
+        if (OT=otUnknown) then
+          begin
+          NextToken;
+          if CurToken<>tkDot then
+            ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[N]);
+          NextToken;
+          IsTokenBased:=CurToken<>tkIdentifier;
+          if IsTokenBased then
+            OT:=TPasOperator.TokenToOperatorType(CurTokenText)
+          else
+            OT:=TPasOperator.NameToOperatorType(CurTokenString);
+          end;
+        end;
       if (ot=otUnknown) then
       if (ot=otUnknown) then
         ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
         ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
       Name:=OperatorNames[Ot];
       Name:=OperatorNames[Ot];
+      if N<>'' then
+        Name:=N+'.'+Name;
       NamePos:=CurTokenPos;
       NamePos:=CurTokenPos;
       end;
       end;
     ptAnonymousProcedure,ptAnonymousFunction:
     ptAnonymousProcedure,ptAnonymousFunction:
@@ -6696,8 +6743,10 @@ Var
   OldCount, i: Integer;
   OldCount, i: Integer;
   CurEl: TPasElement;
   CurEl: TPasElement;
   LastToken: TToken;
   LastToken: TToken;
+  AllowVisibility: Boolean;
 begin
 begin
-  if AllowMethods then
+  AllowVisibility:=msAdvancedRecords in CurrentModeswitches;
+  if AllowVisibility then
     v:=visPublic
     v:=visPublic
   else
   else
     v:=visDefault;
     v:=visDefault;
@@ -6780,13 +6829,14 @@ begin
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
           TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
         else
         else
           ARec.Members.Add(Proc);
           ARec.Members.Add(Proc);
+        Engine.FinishScope(stProcedure,Proc);
         end;
         end;
       tkDestructor:
       tkDestructor:
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
         ParseExc(nParserNoConstructorAllowed,SParserNoConstructorAllowed);
       tkGeneric,tkSelf, // Counts as field name
       tkGeneric,tkSelf, // Counts as field name
       tkIdentifier :
       tkIdentifier :
         begin
         begin
-        If AllowMethods and CheckVisibility(CurTokenString,v) then
+        If AllowVisibility and CheckVisibility(CurTokenString,v) then
           begin
           begin
           if not (v in [visPrivate,visPublic,visStrictPrivate]) then
           if not (v in [visPrivate,visPublic,visStrictPrivate]) then
             ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
             ParseExc(nParserInvalidRecordVisibility,SParserInvalidRecordVisibility);
@@ -6849,14 +6899,18 @@ function TPasParser.ParseRecordDecl(Parent: TPasElement;
 
 
 var
 var
   ok: Boolean;
   ok: Boolean;
+  allowadvanced : Boolean;
+
 begin
 begin
   Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent, NamePos));
   Result := TPasRecordType(CreateElement(TPasRecordType, TypeName, Parent, NamePos));
   ok:=false;
   ok:=false;
   try
   try
     Result.PackMode:=PackMode;
     Result.PackMode:=PackMode;
     NextToken;
     NextToken;
-    ParseRecordMembers(Result,tkEnd,
-      (msAdvancedRecords in Scanner.CurrentModeSwitches) and not (Parent is TProcedureBody));
+    allowAdvanced:=(msAdvancedRecords in Scanner.CurrentModeSwitches)
+                   and not (Parent is TProcedureBody)
+                   and (Result.Name<>'');
+    ParseRecordMembers(Result,tkEnd,allowAdvanced);
     Engine.FinishScope(stTypeDef,Result);
     Engine.FinishScope(stTypeDef,Result);
     ok:=true;
     ok:=true;
   finally
   finally
@@ -6934,6 +6988,7 @@ begin
     TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
     TPasOverloadedProc(Proc.Parent).Overloads.Add(Proc)
   else
   else
     AType.Members.Add(Proc);
     AType.Members.Add(Proc);
+  Engine.FinishScope(stProcedure,Proc);
 end;
 end;
 
 
 procedure TPasParser.ParseClassFields(AType: TPasClassType;
 procedure TPasParser.ParseClassFields(AType: TPasClassType;

+ 274 - 39
packages/fcl-passrc/src/pscanner.pp

@@ -80,12 +80,16 @@ const
   nMisplacedGlobalCompilerSwitch = 1029;
   nMisplacedGlobalCompilerSwitch = 1029;
   nLogMacroXSetToY = 1030;
   nLogMacroXSetToY = 1030;
   nInvalidDispatchFieldName = 1031;
   nInvalidDispatchFieldName = 1031;
+  nErrWrongSwitchToggle = 1032;
+  nNoResourceSupport = 1033;
+  nResourceFileNotFound = 1034;
 
 
 // resourcestring patterns of messages
 // resourcestring patterns of messages
 resourcestring
 resourcestring
   SErrInvalidCharacter = 'Invalid character ''%s''';
   SErrInvalidCharacter = 'Invalid character ''%s''';
   SErrOpenString = 'string exceeds end of line';
   SErrOpenString = 'string exceeds end of line';
   SErrIncludeFileNotFound = 'Could not find include file ''%s''';
   SErrIncludeFileNotFound = 'Could not find include file ''%s''';
+  SErrResourceFileNotFound = 'Could not find resource file ''%s''';
   SErrIfXXXNestingLimitReached = 'Nesting of $IFxxx too deep';
   SErrIfXXXNestingLimitReached = 'Nesting of $IFxxx too deep';
   SErrInvalidPPElse = '$ELSE without matching $IFxxx';
   SErrInvalidPPElse = '$ELSE without matching $IFxxx';
   SErrInvalidPPEndif = '$ENDIF without matching $IFxxx';
   SErrInvalidPPEndif = '$ENDIF without matching $IFxxx';
@@ -116,6 +120,8 @@ resourcestring
   SMisplacedGlobalCompilerSwitch = 'Misplaced global compiler switch, ignored';
   SMisplacedGlobalCompilerSwitch = 'Misplaced global compiler switch, ignored';
   SLogMacroXSetToY = 'Macro %s set to %s';
   SLogMacroXSetToY = 'Macro %s set to %s';
   SInvalidDispatchFieldName = 'Invalid Dispatch field name';
   SInvalidDispatchFieldName = 'Invalid Dispatch field name';
+  SErrWrongSwitchToggle = 'Wrong switch toggle, use ON/OFF or +/-';
+  SNoResourceSupport = 'No support for resources of type "%s"';
 
 
 type
 type
   TMessageType = (
   TMessageType = (
@@ -138,7 +144,7 @@ type
     tkIdentifier,
     tkIdentifier,
     tkString,
     tkString,
     tkNumber,
     tkNumber,
-    tkChar,
+    tkChar, // ^A .. ^Z
     // Simple (one-character) tokens
     // Simple (one-character) tokens
     tkBraceOpen,             // '('
     tkBraceOpen,             // '('
     tkBraceClose,            // ')'
     tkBraceClose,            // ')'
@@ -495,6 +501,7 @@ type
   TBaseFileResolver = class
   TBaseFileResolver = class
   private
   private
     FBaseDirectory: string;
     FBaseDirectory: string;
+    FResourcePaths,
     FIncludePaths: TStringList;
     FIncludePaths: TStringList;
     FStrictFileCase : Boolean;
     FStrictFileCase : Boolean;
   Protected
   Protected
@@ -502,10 +509,13 @@ type
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetBaseDirectory(AValue: string); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
     procedure SetStrictFileCase(AValue: Boolean); virtual;
     Property IncludePaths: TStringList Read FIncludePaths;
     Property IncludePaths: TStringList Read FIncludePaths;
+    Property ResourcePaths: TStringList Read FResourcePaths;
   public
   public
     constructor Create; virtual;
     constructor Create; virtual;
     destructor Destroy; override;
     destructor Destroy; override;
     procedure AddIncludePath(const APath: string); virtual;
     procedure AddIncludePath(const APath: string); virtual;
+    procedure AddResourcePath(const APath: string); virtual;
+    function FindResourceFileName(const AName: string): String; virtual; abstract;
     function FindSourceFile(const AName: string): TLineReader; virtual; abstract;
     function FindSourceFile(const AName: string): TLineReader; virtual; abstract;
     function FindIncludeFile(const AName: string): TLineReader; virtual; abstract;
     function FindIncludeFile(const AName: string): TLineReader; virtual; abstract;
     Property StrictFileCase : Boolean Read FStrictFileCase Write SetStrictFileCase;
     Property StrictFileCase : Boolean Read FStrictFileCase Write SetStrictFileCase;
@@ -522,9 +532,11 @@ type
     FUseStreams: Boolean;
     FUseStreams: Boolean;
     {$endif}
     {$endif}
   Protected
   Protected
+    function SearchLowUpCase(FN: string): string;
     Function FindIncludeFileName(const AName: string): String; override;
     Function FindIncludeFileName(const AName: string): String; override;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
     Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
   Public
   Public
+    function FindResourceFileName(const AFileName: string): String; override;
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindIncludeFile(const AName: string): TLineReader; override;
     function FindIncludeFile(const AName: string): TLineReader; override;
     {$ifdef HasStreams}
     {$ifdef HasStreams}
@@ -549,6 +561,7 @@ type
     constructor Create; override;
     constructor Create; override;
     destructor Destroy; override;
     destructor Destroy; override;
     Procedure Clear;
     Procedure Clear;
+    function FindResourceFileName(const AFileName: string): String; override;
     Procedure AddStream(Const AName : String; AStream : TStream);
     Procedure AddStream(Const AName : String; AStream : TStream);
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindSourceFile(const AName: string): TLineReader; override;
     function FindIncludeFile(const AName: string): TLineReader; override;
     function FindIncludeFile(const AName: string): TLineReader; override;
@@ -676,11 +689,18 @@ type
   TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
   TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
   TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
   TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
 
 
+  // aFileName: full filename (search is already done) aOptions: list of name:value pairs.
+  TResourceHandler = Procedure (Sender : TObject; const aFileName : String; aOptions : TStrings) of object;
+
   TPasScannerTokenPos = {$ifdef UsePChar}PChar{$else}integer{$endif};
   TPasScannerTokenPos = {$ifdef UsePChar}PChar{$else}integer{$endif};
 
 
   TPascalScanner = class
   TPascalScanner = class
   private
   private
     type
     type
+      TResourceHandlerRecord = record
+        Ext : String;
+        Handler : TResourceHandler;
+      end;
       TWarnMsgNumberState = record
       TWarnMsgNumberState = record
         Number: integer;
         Number: integer;
         State: TWarnMsgState;
         State: TWarnMsgState;
@@ -734,6 +754,7 @@ type
     FIncludeStack: TFPList;
     FIncludeStack: TFPList;
     FFiles: TStrings;
     FFiles: TStrings;
     FWarnMsgStates: TWarnMsgNumberStateArr;
     FWarnMsgStates: TWarnMsgNumberStateArr;
+    FResourceHandlers : Array of TResourceHandlerRecord;
 
 
     // Preprocessor $IFxxx skipping data
     // Preprocessor $IFxxx skipping data
     PPSkipMode: TPascalScannerPPSkipMode;
     PPSkipMode: TPascalScannerPPSkipMode;
@@ -761,6 +782,9 @@ type
     procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
     procedure SetReadOnlyModeSwitches(const AValue: TModeSwitches);
     procedure SetReadOnlyValueSwitches(const AValue: TValueSwitches);
     procedure SetReadOnlyValueSwitches(const AValue: TValueSwitches);
   protected
   protected
+    // extension without initial dot (.)
+    Function IndexOfResourceHandler(Const aExt : string) : Integer;
+    Function FindResourceHandler(Const aExt : string) : TResourceHandler;
     function ReadIdentifier(const AParam: string): string;
     function ReadIdentifier(const AParam: string): string;
     function FetchLine: boolean;
     function FetchLine: boolean;
     procedure AddFile(aFilename: string); virtual;
     procedure AddFile(aFilename: string); virtual;
@@ -788,7 +812,10 @@ type
     procedure HandleError(Param: String); virtual;
     procedure HandleError(Param: String); virtual;
     procedure HandleMessageDirective(Param: String); virtual;
     procedure HandleMessageDirective(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
     procedure HandleIncludeFile(Param: String); virtual;
+    procedure HandleResource(Param : string); virtual;
+
     procedure HandleUnDefine(Param: String); virtual;
     procedure HandleUnDefine(Param: String); virtual;
+
     function HandleInclude(const Param: String): TToken; virtual;
     function HandleInclude(const Param: String): TToken; virtual;
     procedure HandleMode(const Param: String); virtual;
     procedure HandleMode(const Param: String); virtual;
     procedure HandleModeSwitch(const Param: String); virtual;
     procedure HandleModeSwitch(const Param: String); virtual;
@@ -813,6 +840,9 @@ type
   public
   public
     constructor Create(AFileResolver: TBaseFileResolver);
     constructor Create(AFileResolver: TBaseFileResolver);
     destructor Destroy; override;
     destructor Destroy; override;
+    // extension without initial dot  (.), case insensitive
+    Procedure RegisterResourceHandler(aExtension : String; aHandler : TResourceHandler); overload;
+    Procedure RegisterResourceHandler(aExtensions : Array of String; aHandler : TResourceHandler); overload;
     procedure OpenFile(AFilename: string);
     procedure OpenFile(AFilename: string);
     procedure FinishedModule; virtual; // called by parser after end.
     procedure FinishedModule; virtual; // called by parser after end.
     function FormatPath(const aFilename: string): string; virtual;
     function FormatPath(const aFilename: string): string; virtual;
@@ -2426,10 +2456,12 @@ constructor TBaseFileResolver.Create;
 begin
 begin
   inherited Create;
   inherited Create;
   FIncludePaths := TStringList.Create;
   FIncludePaths := TStringList.Create;
+  FResourcePaths := TStringList.Create;
 end;
 end;
 
 
 destructor TBaseFileResolver.Destroy;
 destructor TBaseFileResolver.Destroy;
 begin
 begin
+  FResourcePaths.Free;
   FIncludePaths.Free;
   FIncludePaths.Free;
   inherited Destroy;
   inherited Destroy;
 end;
 end;
@@ -2453,35 +2485,56 @@ begin
     end;
     end;
 end;
 end;
 
 
+procedure TBaseFileResolver.AddResourcePath(const APath: string);
+Var
+  FP : String;
+
+begin
+  if (APath='') then
+    FResourcePaths.Add('./')
+  else
+    begin
+{$IFDEF HASFS}
+    FP:=IncludeTrailingPathDelimiter(ExpandFileName(APath));
+{$ELSE}
+    FP:=APath;
+{$ENDIF}
+    FResourcePaths.Add(FP);
+    end;
+end;
+
+
 {$IFDEF HASFS}
 {$IFDEF HASFS}
 
 
 { ---------------------------------------------------------------------
 { ---------------------------------------------------------------------
   TFileResolver
   TFileResolver
   ---------------------------------------------------------------------}
   ---------------------------------------------------------------------}
 
 
-function TFileResolver.FindIncludeFileName(const AName: string): String;
 
 
-  function SearchLowUpCase(FN: string): string;
+function TFileResolver.SearchLowUpCase(FN: string): string;
 
 
-  var
-    Dir: String;
+var
+  Dir: String;
+
+begin
+  If FileExists(FN) then
+    Result:=FN
+  else if StrictFileCase then
+    Result:=''
+  else
+    begin
+    Dir:=ExtractFilePath(FN);
+    FN:=ExtractFileName(FN);
+    Result:=Dir+LowerCase(FN);
+    If FileExists(Result) then exit;
+    Result:=Dir+uppercase(Fn);
+    If FileExists(Result) then exit;
+    Result:='';
+    end;
+end;
+
+function TFileResolver.FindIncludeFileName(const AName: string): String;
 
 
-  begin
-    If FileExists(FN) then
-      Result:=FN
-    else if StrictFileCase then
-      Result:=''
-    else
-      begin
-      Dir:=ExtractFilePath(FN);
-      FN:=ExtractFileName(FN);
-      Result:=Dir+LowerCase(FN);
-      If FileExists(Result) then exit;
-      Result:=Dir+uppercase(Fn);
-      If FileExists(Result) then exit;
-      Result:='';
-      end;
-  end;
 
 
   Function FindInPath(FN : String) : String;
   Function FindInPath(FN : String) : String;
 
 
@@ -2502,7 +2555,6 @@ function TFileResolver.FindIncludeFileName(const AName: string): String;
   end;
   end;
 
 
 var
 var
-  i: Integer;
   FN : string;
   FN : string;
 
 
 begin
 begin
@@ -2552,6 +2604,45 @@ begin
     Result:=TFileLineReader.Create(AFileName);
     Result:=TFileLineReader.Create(AFileName);
 end;
 end;
 
 
+function TFileResolver.FindResourceFileName(const AFileName: string): String;
+
+  Function FindInPath(FN : String) : String;
+
+  var
+    I : integer;
+
+  begin
+    Result:='';
+    I:=0;
+    While (Result='') and (I<FResourcePaths.Count) do
+      begin
+      Result:=SearchLowUpCase(FResourcePaths[i]+FN);
+      Inc(I);
+      end;
+    // search in BaseDirectory
+    if (Result='') and (BaseDirectory<>'') then
+      Result:=SearchLowUpCase(BaseDirectory+FN);
+  end;
+
+var
+  FN : string;
+
+begin
+  Result := '';
+  // convert pathdelims to system
+  FN:=SetDirSeparators(AFileName);
+  If FilenameIsAbsolute(FN) then
+    begin
+    Result := SearchLowUpCase(FN);
+    end
+  else
+    begin
+    // file name is relative
+    // search in include path
+    Result:=FindInPath(FN);
+    end;
+end;
+
 function TFileResolver.FindSourceFile(const AName: string): TLineReader;
 function TFileResolver.FindSourceFile(const AName: string): TLineReader;
 begin
 begin
   Result := nil;
   Result := nil;
@@ -2597,6 +2688,12 @@ begin
   Result:='';
   Result:='';
 end;
 end;
 
 
+function TStreamResolver.FindResourceFileName(const AFileName: string): String;
+begin
+  raise EFileNotFoundError.Create('TStreamResolver.FindResourceFileName not supported '+aFileName);
+  Result:='';
+end;
+
 constructor TStreamResolver.Create;
 constructor TStreamResolver.Create;
 begin
 begin
   Inherited;
   Inherited;
@@ -2738,6 +2835,36 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
+procedure TPascalScanner.RegisterResourceHandler(aExtension: String; aHandler: TResourceHandler);
+
+Var
+  Idx: Integer;
+
+begin
+  if (aExtension='') then
+    exit;
+  if (aExtension[1]='.') then
+    aExtension:=copy(aExtension,2,Length(aExtension)-1);
+  Idx:=IndexOfResourceHandler(lowerCase(aExtension));
+  if Idx=-1 then
+    begin
+    Idx:=Length(FResourceHandlers);
+    SetLength(FResourceHandlers,Idx+1);
+    FResourceHandlers[Idx].Ext:=LowerCase(aExtension);
+    end;
+  FResourceHandlers[Idx].handler:=aHandler;
+end;
+
+procedure TPascalScanner.RegisterResourceHandler(aExtensions: array of String; aHandler: TResourceHandler);
+
+Var
+  S : String;
+
+begin
+  For S in aExtensions do
+    RegisterResourceHandler(S,aHandler);
+end;
+
 procedure TPascalScanner.ClearFiles;
 procedure TPascalScanner.ClearFiles;
 
 
 begin
 begin
@@ -3214,6 +3341,53 @@ begin
     DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(FCurFileName)],True);
     DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(FCurFileName)],True);
 end;
 end;
 
 
+procedure TPascalScanner.HandleResource(Param: string);
+
+Var
+  Ext,aFullFileName,aFilename,aOptions : String;
+  P: Integer;
+  H : TResourceHandler;
+  OptList : TStrings;
+
+begin
+  aFilename:='';
+  aOptions:='';
+  P:=Pos(';',Param);
+  If P=0 then
+    aFileName:=Trim(Param)
+  else
+    begin
+    aFileName:=Trim(Copy(Param,1,P-1));
+    aOptions:=Copy(Param,P+1,Length(Param)-P);
+    end;
+  Ext:=ExtractFileExt(aFileName);
+  // Construct & find filename
+  If (ChangeFileExt(aFileName,'')='*') then
+    aFileName:=ChangeFileExt(ExtractFileName(CurFilename),Ext);
+  aFullFileName:=FileResolver.FindResourceFileName(aFileName);
+  if aFullFileName='' then
+    Error(nResourceFileNotFound,SErrResourceFileNotFound,[aFileName]);
+  // Check if we can find a handler.
+  if Ext<>'' then
+    Ext:=Copy(Ext,2,Length(Ext)-1);
+  H:=FindResourceHandler(LowerCase(Ext));
+  if (H=Nil) then
+    H:=FindResourceHandler('*');
+  if (H=Nil) then
+    Error(nNoResourceSupport,SNoResourceSupport,[Ext]);
+  // Let the handler take care of the rest.
+  OptList:=TStringList.Create;
+  try
+    OptList.NameValueSeparator:=':';
+    OptList.Delimiter:=';';
+    OptList.StrictDelimiter:=True;
+    OptList.DelimitedText:=aOptions;
+    H(Self,aFullFileName,OptList);
+  finally
+    OptList.Free;
+  end;
+end;
+
 function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
 function TPascalScanner.HandleMacro(AIndex : integer) : TToken;
 
 
 Var
 Var
@@ -3496,36 +3670,74 @@ begin
 end;
 end;
 
 
 procedure TPascalScanner.HandleModeSwitch(const Param: String);
 procedure TPascalScanner.HandleModeSwitch(const Param: String);
-
+// $modeswitch param
+// name, name-, name+, name off, name on, name- comment, name on comment
 Var
 Var
   MS : TModeSwitch;
   MS : TModeSwitch;
   MSN,PM : String;
   MSN,PM : String;
-  P : Integer;
+  p : Integer;
+  Enable: Boolean;
 
 
 begin
 begin
-  MSN:=Uppercase(Param);
-  P:=Pos(' ',MSN);
-  if P<>0 then
-    begin
-    PM:=Trim(Copy(MSN,P+1,Length(MSN)-P));
-    MSN:=Copy(MSN,1,P-1);
-    end;
+  PM:=Param;
+  p:=1;
+  while (p<=length(PM)) and (PM[p] in ['a'..'z','A'..'Z','_','0'..'9']) do
+    inc(p);
+  MSN:=LeftStr(PM,p-1);
+  Delete(PM,1,p-1);
   MS:=StrToModeSwitch(MSN);
   MS:=StrToModeSwitch(MSN);
   if (MS=msNone) or not (MS in AllowedModeSwitches) then
   if (MS=msNone) or not (MS in AllowedModeSwitches) then
     begin
     begin
     if po_CheckModeSwitches in Options then
     if po_CheckModeSwitches in Options then
-      Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param])
+      Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[MSN])
+    else
+      DoLog(mtWarning,nErrInvalidModeSwitch,SErrInvalidModeSwitch,[MSN]);
+    exit; // ignore
+    end;
+  if PM='' then
+    Enable:=true
+  else
+    case PM[1] of
+    '+','-':
+      begin
+      Enable:=PM[1]='+';
+      p:=2;
+      if (p<=length(PM)) and not (PM[p] in [' ',#9]) then
+        Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
+      end;
+    ' ',#9:
+      begin
+      PM:=TrimLeft(PM);
+      if PM<>'' then
+        begin
+        p:=1;
+        while (p<=length(PM)) and (PM[p] in ['A'..'Z']) do inc(p);
+        if (p<=length(PM)) and not (PM[p] in [' ',#9]) then
+          Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
+        PM:=LeftStr(PM,p-1);
+        if PM='ON' then
+          Enable:=true
+        else if PM='OFF' then
+          Enable:=false
+        else
+          Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
+        end;
+      end;
     else
     else
-      exit; // ignore
+      Error(nErrWrongSwitchToggle,SErrWrongSwitchToggle,[]);
     end;
     end;
-  if (PM='-') or (PM='OFF') then
+
+  if MS in CurrentModeSwitches=Enable then
+    exit; // no change
+  if MS in ReadOnlyModeSwitches then
     begin
     begin
-    if MS in ReadOnlyModeSwitches then
-      Error(nErrInvalidModeSwitch,SErrInvalidModeSwitch,[Param]);
-    CurrentModeSwitches:=CurrentModeSwitches-[MS]
-    end
+    DoLog(mtWarning,nErrInvalidModeSwitch,SErrInvalidModeSwitch,[MSN]);
+    exit;
+    end;
+  if Enable then
+    CurrentModeSwitches:=CurrentModeSwitches+[MS]
   else
   else
-    CurrentModeSwitches:=CurrentModeSwitches+[MS];
+    CurrentModeSwitches:=CurrentModeSwitches-[MS];
 end;
 end;
 
 
 procedure TPascalScanner.PushSkipMode;
 procedure TPascalScanner.PushSkipMode;
@@ -3789,6 +4001,8 @@ begin
           DoBoolDirective(bsOverflowChecks);
           DoBoolDirective(bsOverflowChecks);
         'POINTERMATH':
         'POINTERMATH':
           DoBoolDirective(bsPointerMath);
           DoBoolDirective(bsPointerMath);
+        'R' :
+          HandleResource(Param);
         'RANGECHECKS':
         'RANGECHECKS':
           DoBoolDirective(bsRangeChecks);
           DoBoolDirective(bsRangeChecks);
         'SCOPEDENUMS':
         'SCOPEDENUMS':
@@ -4797,6 +5011,27 @@ begin
   FReadOnlyValueSwitches:=AValue;
   FReadOnlyValueSwitches:=AValue;
 end;
 end;
 
 
+function TPascalScanner.IndexOfResourceHandler(const aExt: string): Integer;
+
+begin
+  Result:=Length(FResourceHandlers)-1;
+  While (Result>=0) and (FResourceHandlers[Result].Ext<>aExt) do
+    Dec(Result);
+end;
+
+function TPascalScanner.FindResourceHandler(const aExt: string): TResourceHandler;
+
+Var
+  Idx : Integer;
+
+begin
+  Idx:=IndexOfResourceHandler(aExt);
+  if Idx=-1 then
+    Result:=Nil
+  else
+    Result:=FResourceHandlers[Idx].handler;
+end;
+
 function TPascalScanner.ReadIdentifier(const AParam: string): string;
 function TPascalScanner.ReadIdentifier(const AParam: string): string;
 var
 var
   p, l: Integer;
   p, l: Integer;

+ 226 - 24
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -58,6 +58,10 @@ type
     // generic class
     // generic class
     procedure TestGen_Class;
     procedure TestGen_Class;
     procedure TestGen_ClassDelphi;
     procedure TestGen_ClassDelphi;
+    procedure TestGen_ClassDelphi_TypeOverload;
+    procedure TestGen_ClassObjFPC;
+    procedure TestGen_ClassObjFPC_OverloadFail;
+    procedure TestGen_ClassObjFPC_OverloadOtherUnit;
     procedure TestGen_ClassForward;
     procedure TestGen_ClassForward;
     procedure TestGen_ClassForwardConstraints;
     procedure TestGen_ClassForwardConstraints;
     procedure TestGen_ClassForwardConstraintNameMismatch;
     procedure TestGen_ClassForwardConstraintNameMismatch;
@@ -65,8 +69,8 @@ type
     procedure TestGen_ClassForwardConstraintTypeMismatch;
     procedure TestGen_ClassForwardConstraintTypeMismatch;
     procedure TestGen_ClassForward_Circle;
     procedure TestGen_ClassForward_Circle;
     procedure TestGen_Class_RedeclareInUnitImplFail;
     procedure TestGen_Class_RedeclareInUnitImplFail;
-    procedure TestGen_Class_AnotherInUnitImpl;
-    procedure TestGen_Class_Method;
+    procedure TestGen_Class_TypeOverloadInUnitImpl;
+    procedure TestGen_Class_MethodObjFPC;
     procedure TestGen_Class_MethodOverride;
     procedure TestGen_Class_MethodOverride;
     procedure TestGen_Class_MethodDelphi;
     procedure TestGen_Class_MethodDelphi;
     procedure TestGen_Class_MethodDelphiTypeParamMissing;
     procedure TestGen_Class_MethodDelphiTypeParamMissing;
@@ -105,6 +109,7 @@ type
     procedure TestGen_PointerDirectSpecializeFail;
     procedure TestGen_PointerDirectSpecializeFail;
 
 
     // ToDo: helpers for generics
     // ToDo: helpers for generics
+    procedure TestGen_HelperForArray;
     // ToDo: default class prop array helper: arr<b>[c]
     // ToDo: default class prop array helper: arr<b>[c]
 
 
     // generic statements
     // generic statements
@@ -139,20 +144,26 @@ type
     procedure TestGenProc_TypeParamCntOverload;
     procedure TestGenProc_TypeParamCntOverload;
     procedure TestGenProc_TypeParamCntOverloadNoParams;
     procedure TestGenProc_TypeParamCntOverloadNoParams;
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
     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;
+    // ToDo: NestedResultAssign
+
+    // generic function infer types
+    procedure TestGenProc_Infer_NeedExplicitFail;
+    procedure TestGenProc_Infer_Overload;
+    procedure TestGenProc_Infer_OverloadForward;
+    procedure TestGenProc_Infer_Var_Overload;
+    procedure TestGenProc_Infer_Widen;
+    procedure TestGenProc_Infer_DefaultValue;
+    procedure TestGenProc_Infer_DefaultValueMismatch;
+    procedure TestGenProc_Infer_ProcT;
+    procedure TestGenProc_Infer_Mismatch;
+    procedure TestGenProc_Infer_ArrayOfT;
+    procedure TestGenProc_Infer_PassAsArgDelphi;
+    procedure TestGenProc_Infer_PassAsArgObjFPC;
+    // ToDo procedure TestGenProc_Infer_ProcType;
 
 
     // generic methods
     // generic methods
     procedure TestGenMethod_VirtualFail;
     procedure TestGenMethod_VirtualFail;
+    procedure TestGenMethod_PublishedFail;
     procedure TestGenMethod_ClassInterfaceMethodFail;
     procedure TestGenMethod_ClassInterfaceMethodFail;
     procedure TestGenMethod_ClassConstructorFail;
     procedure TestGenMethod_ClassConstructorFail;
     procedure TestGenMethod_TemplNameDifferFail;
     procedure TestGenMethod_TemplNameDifferFail;
@@ -751,6 +762,96 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolveGenerics.TestGen_ClassDelphi_TypeOverload;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  {#a}TBird = word;',
+  '  {#b}TBird<T> = class',
+  '    v: T;',
+  '  end;',
+  '  {=b}TEagle = TBird<word>;',
+  'var',
+  '  b: {@b}TBird<word>;',
+  '  {=a}w: TBird;',
+  'begin',
+  '  b.v:=w;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    v: TBird;',
+  '  end;',
+  'var',
+  '  b: specialize TBird<word>;',
+  'begin',
+  '  b.v:=b;',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadFail;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = word;',
+  '  generic TBird<T> = class',
+  '    v: T;',
+  '  end;',
+  'begin',
+  '']);
+  CheckResolverException('Duplicate identifier "TBird" at afile.pp(5,8)',nDuplicateIdentifier);
+end;
+
+procedure TTestResolveGenerics.TestGen_ClassObjFPC_OverloadOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit1.pas',
+    LinesToStr([
+    'type',
+    '  TBird = class b1: word; end;',
+    '  generic TAnt<T> = class a1: T; end;',
+    '']),
+    LinesToStr([
+    '']));
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  generic TBird<T> = class b2:T; end;',
+    '  TAnt = class a2:word; end;',
+    '']),
+    LinesToStr([
+    '']));
+  StartProgram(true,[supTObject]);
+  Add([
+  'uses unit1, unit2;',
+  'var',
+  '  b1: TBird;',
+  '  b2: specialize TBird<word>;',
+  '  a1: specialize TAnt<word>;',
+  '  a2: TAnt;',
+  'begin',
+  '  b1.b1:=1;',
+  '  b2.b2:=2;',
+  '  a1.a1:=3;',
+  '  a2.a2:=4;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_ClassForward;
 procedure TTestResolveGenerics.TestGen_ClassForward;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -905,7 +1006,7 @@ begin
     nDuplicateIdentifier);
     nDuplicateIdentifier);
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGen_Class_AnotherInUnitImpl;
+procedure TTestResolveGenerics.TestGen_Class_TypeOverloadInUnitImpl;
 begin
 begin
   StartUnit(false);
   StartUnit(false);
   Add([
   Add([
@@ -919,7 +1020,7 @@ begin
   ParseUnit;
   ParseUnit;
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGen_Class_Method;
+procedure TTestResolveGenerics.TestGen_Class_MethodObjFPC;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -930,10 +1031,18 @@ begin
   '  generic TBird<{#Templ}T> = class',
   '  generic TBird<{#Templ}T> = class',
   '    function Fly(p:T): T; virtual; abstract;',
   '    function Fly(p:T): T; virtual; abstract;',
   '    function Run(p:T): T;',
   '    function Run(p:T): T;',
+  '    procedure Jump(p:T);',
+  '    class procedure Go(p:T);',
   '  end;',
   '  end;',
   'function TBird.Run(p:T): T;',
   'function TBird.Run(p:T): T;',
   'begin',
   'begin',
   'end;',
   'end;',
+  'generic procedure TBird<T>.Jump(p:T);',
+  'begin',
+  'end;',
+  'generic class procedure TBird<T>.Go(p:T);',
+  'begin',
+  'end;',
   'var',
   'var',
   '  b: specialize TBird<word>;',
   '  b: specialize TBird<word>;',
   '  {=Typ}w: T;',
   '  {=Typ}w: T;',
@@ -1520,6 +1629,27 @@ begin
   CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 4 column 11',nParserExpectTokenError);
   CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 4 column 11',nParserExpectTokenError);
 end;
 end;
 
 
+procedure TTestResolveGenerics.TestGen_HelperForArray;
+begin
+  StartProgram(false);
+  Add([
+  '{$ModeSwitch typehelpers}',
+  'type',
+  '  generic TArr<T> = array[1..2] of T;',
+  '  TWordArrHelper = type helper for specialize TArr<word>',
+  '    procedure Fly(w: word);',
+  '  end;',
+  'procedure TWordArrHelper.Fly(w: word);',
+  'begin',
+  'end;',
+  'var',
+  '  a: specialize TArr<word>;',
+  'begin',
+  '  a.Fly(3);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGen_LocalVar;
 procedure TTestResolveGenerics.TestGen_LocalVar;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -2061,7 +2191,7 @@ begin
   CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
   CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_NeedExplicitFail;
+procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2076,7 +2206,7 @@ begin
     nCouldNotInferTypeArgXForMethodY);
     nCouldNotInferTypeArgXForMethodY);
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_Overload;
+procedure TTestResolveGenerics.TestGenProc_Infer_Overload;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2098,7 +2228,7 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_OverloadForward;
+procedure TTestResolveGenerics.TestGenProc_Infer_OverloadForward;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2126,7 +2256,7 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_Var_Overload;
+procedure TTestResolveGenerics.TestGenProc_Infer_Var_Overload;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2152,7 +2282,24 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_DefaultValue;
+procedure TTestResolveGenerics.TestGenProc_Infer_Widen;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure {#A}Run<S>(a: S; b: S);',
+  'begin',
+  'end;',
+  'begin',
+  '  {@A}Run(word(1),longint(2));',
+  '  {@A}Run(int64(1),longint(2));',
+  '  {@A}Run(boolean(false),wordbool(2));',
+  '  {@A}Run(''a'',''foo'');',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Infer_DefaultValue;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2169,7 +2316,7 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_DefaultValueMismatch;
+procedure TTestResolveGenerics.TestGenProc_Infer_DefaultValueMismatch;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2185,7 +2332,7 @@ begin
                          nIncompatibleTypesGotExpected);
                          nIncompatibleTypesGotExpected);
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_ProcT;
+procedure TTestResolveGenerics.TestGenProc_Infer_ProcT;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2207,7 +2354,7 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_Mismatch;
+procedure TTestResolveGenerics.TestGenProc_Infer_Mismatch;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2222,7 +2369,7 @@ begin
     nInferredTypeXFromDiffArgsMismatchFromMethodY);
     nInferredTypeXFromDiffArgsMismatchFromMethodY);
 end;
 end;
 
 
-procedure TTestResolveGenerics.TestGenProc_Inference_ArrayOfT;
+procedure TTestResolveGenerics.TestGenProc_Infer_ArrayOfT;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
@@ -2239,6 +2386,43 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolveGenerics.TestGenProc_Infer_PassAsArgDelphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'function Run<T>(a: T): T;',
+  'var b: T;',
+  'begin',
+  '  Run(Run<word>(3));',
+  '  Run(Run(4));',
+  'end;',
+  'begin',
+  '  Run(Run<word>(5));',
+  '  Run(Run(6));',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolveGenerics.TestGenProc_Infer_PassAsArgObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$ModeSwitch implicitfunctionspecialization}',
+  'generic function Run<T>(a: T): T;',
+  'var b: T;',
+  'begin',
+  '  Run(specialize Run<word>(3));',
+  '  Run(Run(4));',
+  'end;',
+  'begin',
+  '  Run(specialize Run<word>(5));',
+  '  Run(Run(6));',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
 procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -2253,6 +2437,24 @@ begin
     nXMethodsCannotHaveTypeParams);
     nXMethodsCannotHaveTypeParams);
 end;
 end;
 
 
+procedure TTestResolveGenerics.TestGenMethod_PublishedFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '  published',
+  '    generic procedure Run<T>(a: T);',
+  '  end;',
+  'generic procedure TObject.Run<T>(a: T);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  CheckResolverException('published methods cannot have type parameters',
+    nXMethodsCannotHaveTypeParams);
+end;
+
 procedure TTestResolveGenerics.TestGenMethod_ClassInterfaceMethodFail;
 procedure TTestResolveGenerics.TestGenMethod_ClassInterfaceMethodFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 265 - 22
packages/fcl-passrc/tests/tcresolver.pas

@@ -131,8 +131,9 @@ type
     procedure OnCheckElementParent(El: TPasElement; arg: pointer);
     procedure OnCheckElementParent(El: TPasElement; arg: pointer);
     procedure FreeSrcMarkers;
     procedure FreeSrcMarkers;
     procedure OnPasResolverLog(Sender: TObject; const Msg: String);
     procedure OnPasResolverLog(Sender: TObject; const Msg: String);
-    procedure ScannerDirective(Sender: TObject; Directive, Param: String;
+    procedure OnScannerDirective(Sender: TObject; Directive, Param: String;
       var Handled: boolean);
       var Handled: boolean);
+    procedure OnScannerLog(Sender: TObject; const Msg: String);
   Protected
   Protected
     FirstSrcMarker, LastSrcMarker: PSrcMarker;
     FirstSrcMarker, LastSrcMarker: PSrcMarker;
     Procedure SetUp; override;
     Procedure SetUp; override;
@@ -382,6 +383,7 @@ type
     // procs
     // procs
     Procedure TestProcParam;
     Procedure TestProcParam;
     Procedure TestProcParamAccess;
     Procedure TestProcParamAccess;
+    Procedure TestProcParamConstRefFail;
     Procedure TestFunctionResult;
     Procedure TestFunctionResult;
     Procedure TestProcedureResultFail;
     Procedure TestProcedureResultFail;
     Procedure TestProc_ArgVarPrecisionLossFail;
     Procedure TestProc_ArgVarPrecisionLossFail;
@@ -447,6 +449,8 @@ type
     Procedure TestProcedureExternal;
     Procedure TestProcedureExternal;
     Procedure TestProc_UntypedParam_Forward;
     Procedure TestProc_UntypedParam_Forward;
     Procedure TestProc_Varargs;
     Procedure TestProc_Varargs;
+    Procedure TestProc_VarargsOfT;
+    Procedure TestProc_VarargsOfTMismatch;
     Procedure TestProc_ParameterExprAccess;
     Procedure TestProc_ParameterExprAccess;
     Procedure TestProc_FunctionResult_DeclProc;
     Procedure TestProc_FunctionResult_DeclProc;
     Procedure TestProc_TypeCastFunctionResult;
     Procedure TestProc_TypeCastFunctionResult;
@@ -640,6 +644,9 @@ type
     Procedure TestNestedClass_Forward;
     Procedure TestNestedClass_Forward;
     procedure TestNestedClass_StrictPrivateFail;
     procedure TestNestedClass_StrictPrivateFail;
     procedure TestNestedClass_AccessStrictPrivate;
     procedure TestNestedClass_AccessStrictPrivate;
+    procedure TestNestedClass_AccessParent;
+    procedure TestNestedClass_BodyAccessParentVarFail;
+    procedure TestNestedClass_PropertyAccessParentVarFail;
 
 
     // external class
     // external class
     Procedure TestExternalClass;
     Procedure TestExternalClass;
@@ -712,8 +719,8 @@ type
     Procedure TestClassProperty;
     Procedure TestClassProperty;
     Procedure TestClassPropertyNonStaticFail;
     Procedure TestClassPropertyNonStaticFail;
     Procedure TestClassPropertyNonStaticAllow;
     Procedure TestClassPropertyNonStaticAllow;
-    //Procedure TestClassPropertyStaticMismatchFail;
     Procedure TestArrayProperty;
     Procedure TestArrayProperty;
+    Procedure TestArrayProperty_PassImplicitCallClassFunc;
     Procedure TestProperty_WrongTypeAsIndexFail;
     Procedure TestProperty_WrongTypeAsIndexFail;
     Procedure TestProperty_Option_ClassPropertyNonStatic;
     Procedure TestProperty_Option_ClassPropertyNonStatic;
     Procedure TestDefaultProperty;
     Procedure TestDefaultProperty;
@@ -803,6 +810,7 @@ type
     Procedure TestArray_OpenArrayAsDynArraySetLengthFail;
     Procedure TestArray_OpenArrayAsDynArraySetLengthFail;
     Procedure TestArray_OpenArrayAsDynArray;
     Procedure TestArray_OpenArrayAsDynArray;
     Procedure TestArray_OpenArrayDelphi;
     Procedure TestArray_OpenArrayDelphi;
+    Procedure TestArray_OpenArrayChar;
     Procedure TestArray_CopyConcat;
     Procedure TestArray_CopyConcat;
     Procedure TestStaticArray_CopyConcat;// ToDo
     Procedure TestStaticArray_CopyConcat;// ToDo
     Procedure TestArray_CopyMismatchFail;
     Procedure TestArray_CopyMismatchFail;
@@ -1046,7 +1054,8 @@ begin
   FModules:=TObjectList.Create(true);
   FModules:=TObjectList.Create(true);
   inherited SetUp;
   inherited SetUp;
   Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
   Parser.Options:=Parser.Options+[po_ResolveStandardTypes];
-  Scanner.OnDirective:=@ScannerDirective;
+  Scanner.OnDirective:=@OnScannerDirective;
+  Scanner.OnLog:=@OnScannerLog;
 end;
 end;
 
 
 procedure TCustomTestResolver.TearDown;
 procedure TCustomTestResolver.TearDown;
@@ -1455,7 +1464,9 @@ var
         if El.CustomData is TResolvedReference then
         if El.CustomData is TResolvedReference then
           Ref:=TResolvedReference(El.CustomData).Declaration
           Ref:=TResolvedReference(El.CustomData).Declaration
         else if El.CustomData is TPasPropertyScope then
         else if El.CustomData is TPasPropertyScope then
-          Ref:=TPasPropertyScope(El.CustomData).AncestorProp;
+          Ref:=TPasPropertyScope(El.CustomData).AncestorProp
+        else if El.CustomData is TPasSpecializeTypeData then
+          Ref:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
         if Ref<>nil then
         if Ref<>nil then
           for j:=0 to LabelElements.Count-1 do
           for j:=0 to LabelElements.Count-1 do
             begin
             begin
@@ -1471,11 +1482,17 @@ var
         El:=TPasElement(ReferenceElements[i]);
         El:=TPasElement(ReferenceElements[i]);
         write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.Row,',',aMarker^.StartCol,'-',aMarker^.EndCol,')');
         write('Reference candidate for "',aMarker^.Identifier,'" at reference ',aMarker^.Filename,'(',aMarker^.Row,',',aMarker^.StartCol,'-',aMarker^.EndCol,')');
         write(' El=',GetObjName(El));
         write(' El=',GetObjName(El));
+        if EL is TPrimitiveExpr then
+          begin
+           writeln('CheckResolverReference ',TPrimitiveExpr(El).Value);
+          end;
         Ref:=nil;
         Ref:=nil;
         if El.CustomData is TResolvedReference then
         if El.CustomData is TResolvedReference then
           Ref:=TResolvedReference(El.CustomData).Declaration
           Ref:=TResolvedReference(El.CustomData).Declaration
         else if El.CustomData is TPasPropertyScope then
         else if El.CustomData is TPasPropertyScope then
-          Ref:=TPasPropertyScope(El.CustomData).AncestorProp;
+          Ref:=TPasPropertyScope(El.CustomData).AncestorProp
+        else if El.CustomData is TPasSpecializeTypeData then
+          Ref:=TPasSpecializeTypeData(El.CustomData).SpecializedType;
         if Ref<>nil then
         if Ref<>nil then
           begin
           begin
           write(' Decl=',GetObjName(Ref));
           write(' Decl=',GetObjName(Ref));
@@ -1483,7 +1500,7 @@ var
           write(',',Ref.SourceFilename,'(',aLine,',',aCol,')');
           write(',',Ref.SourceFilename,'(',aLine,',',aCol,')');
           end
           end
         else
         else
-          write(' has no TResolvedReference');
+          write(' has no TResolvedReference. El.CustomData=',GetObjName(El.CustomData));
         writeln;
         writeln;
         end;
         end;
       for i:=0 to LabelElements.Count-1 do
       for i:=0 to LabelElements.Count-1 do
@@ -1526,7 +1543,7 @@ var
       for i:=0 to ReferenceElements.Count-1 do
       for i:=0 to ReferenceElements.Count-1 do
         begin
         begin
         El:=TPasElement(ReferenceElements[i]);
         El:=TPasElement(ReferenceElements[i]);
-        //writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDesc(El,2));
+        //writeln('CheckDirectReference ',i,'/',ReferenceElements.Count,' ',GetTreeDbg(El,2));
         if El.ClassType=TPasVariable then
         if El.ClassType=TPasVariable then
           begin
           begin
           if TPasVariable(El).VarType=nil then
           if TPasVariable(El).VarType=nil then
@@ -1575,6 +1592,8 @@ var
         begin
         begin
         El:=TPasElement(ReferenceElements[i]);
         El:=TPasElement(ReferenceElements[i]);
         writeln('  Reference ',GetObjName(El),' at ',ResolverEngine.GetElementSourcePosStr(El));
         writeln('  Reference ',GetObjName(El),' at ',ResolverEngine.GetElementSourcePosStr(El));
+        //if EL is TPasVariable then
+        //  writeln('CheckDirectReference ',GetObjPath(TPasVariable(El).VarType),' ',ResolverEngine.GetElementSourcePosStr(TPasVariable(EL).VarType));
         end;
         end;
       RaiseErrorAtSrcMarker('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
       RaiseErrorAtSrcMarker('wrong direct reference "'+aMarker^.Identifier+'"',aMarker);
     finally
     finally
@@ -2544,7 +2563,7 @@ begin
   FResolverMsgs.Add(Item);
   FResolverMsgs.Add(Item);
 end;
 end;
 
 
-procedure TCustomTestResolver.ScannerDirective(Sender: TObject; Directive,
+procedure TCustomTestResolver.OnScannerDirective(Sender: TObject; Directive,
   Param: String; var Handled: boolean);
   Param: String; var Handled: boolean);
 var
 var
   aScanner: TPascalScanner;
   aScanner: TPascalScanner;
@@ -2559,6 +2578,17 @@ begin
   if Param='' then ;
   if Param='' then ;
 end;
 end;
 
 
+procedure TCustomTestResolver.OnScannerLog(Sender: TObject; const Msg: String);
+var
+  aScanner: TPascalScanner;
+begin
+  aScanner:=TPascalScanner(Sender);
+  if aScanner=nil then exit;
+  {$IFDEF VerbosePasResolver}
+  writeln('TCustomTestResolver.OnScannerLog ',GetObjName(Sender),' ',aScanner.LastMsgType,' ',aScanner.LastMsgNumber,' Msg="', Msg,'"');
+  {$ENDIF}
+end;
+
 function TCustomTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
 function TCustomTestResolver.GetModules(Index: integer): TTestEnginePasResolver;
 begin
 begin
   Result:=TTestEnginePasResolver(FModules[Index]);
   Result:=TTestEnginePasResolver(FModules[Index]);
@@ -6099,6 +6129,16 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestProcParamConstRefFail;
+begin
+  StartProgram(false);
+  Add('procedure Run(constref a: word);');
+  Add('begin');
+  Add('end;');
+  Add('begin');
+  CheckResolverException('not yet implemented: constref',nNotYetImplemented);
+end;
+
 procedure TTestResolver.TestFunctionResult;
 procedure TTestResolver.TestFunctionResult;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -7269,7 +7309,7 @@ begin
   Add('procedure {#ProcA}ProcA(var {#A}A); forward;');
   Add('procedure {#ProcA}ProcA(var {#A}A); forward;');
   Add('procedure {#ProcB}ProcB(const {#B}B); forward;');
   Add('procedure {#ProcB}ProcB(const {#B}B); forward;');
   Add('procedure {#ProcC}ProcC(out {#C}C); forward;');
   Add('procedure {#ProcC}ProcC(out {#C}C); forward;');
-  Add('procedure {#ProcD}ProcD(constref {#D}D); forward;');
+  //Add('procedure {#ProcD}ProcD(constref {#D}D); forward;');
   Add('procedure ProcA(var A);');
   Add('procedure ProcA(var A);');
   Add('begin');
   Add('begin');
   Add('end;');
   Add('end;');
@@ -7279,15 +7319,15 @@ begin
   Add('procedure ProcC(out C);');
   Add('procedure ProcC(out C);');
   Add('begin');
   Add('begin');
   Add('end;');
   Add('end;');
-  Add('procedure ProcD(constref D);');
-  Add('begin');
-  Add('end;');
+  //Add('procedure ProcD(constref D);');
+  //Add('begin');
+  //Add('end;');
   Add('var i: longint;');
   Add('var i: longint;');
   Add('begin');
   Add('begin');
   Add('  {@ProcA}ProcA(i);');
   Add('  {@ProcA}ProcA(i);');
   Add('  {@ProcB}ProcB(i);');
   Add('  {@ProcB}ProcB(i);');
   Add('  {@ProcC}ProcC(i);');
   Add('  {@ProcC}ProcC(i);');
-  Add('  {@ProcD}ProcD(i);');
+  //Add('  {@ProcD}ProcD(i);');
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
@@ -7316,6 +7356,41 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestProc_VarargsOfT;
+begin
+  StartProgram(false);
+  Add([
+  'procedure ProcA(i:longint); varargs of word; external;',
+  'procedure ProcB; varargs of boolean; external;',
+  'procedure ProcC(i: longint = 17); varargs of double; external;',
+  'begin',
+  '  ProcA(1);',
+  '  ProcA(2,3);',
+  '  ProcA(4,5,6);',
+  '  ProcB;',
+  '  ProcB();',
+  '  ProcB(false);',
+  '  ProcB(true,false);',
+  '  ProcC;',
+  '  ProcC();',
+  '  ProcC(7);',
+  '  ProcC(8,9.3);',
+  '  ProcC(8,9.3,1.3);',
+  '']);
+  ParseProgram;
+end;
+
+procedure TTestResolver.TestProc_VarargsOfTMismatch;
+begin
+  StartProgram(false);
+  Add([
+  'procedure ProcA(i:longint); varargs of word; external;',
+  'begin',
+  '  ProcA(1,false);',
+  '']);
+  CheckResolverException('Incompatible type arg no. 2: Got "Boolean", expected "Word"',nIncompatibleTypeArgNo);
+end;
+
 procedure TTestResolver.TestProc_ParameterExprAccess;
 procedure TTestResolver.TestProc_ParameterExprAccess;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -10340,8 +10415,8 @@ begin
   Add('  end;');
   Add('  end;');
   Add('begin');
   Add('begin');
   Add('  if TObject.i=7 then ;');
   Add('  if TObject.i=7 then ;');
-  CheckResolverException(sCannotAccessThisMemberFromAX,
-    nCannotAccessThisMemberFromAX);
+  CheckResolverException(sInstanceMemberXInaccessible,
+    nInstanceMemberXInaccessible);
 end;
 end;
 
 
 procedure TTestResolver.TestClass_FuncReturningObjectMember;
 procedure TTestResolver.TestClass_FuncReturningObjectMember;
@@ -11475,6 +11550,88 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestNestedClass_AccessParent;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '  end;',
+  '  TLimb = class',
+  '    {#tlimb_d}d: longint;',
+  '  end;',
+  '  TAnt = boolean;',
+  '  TBird = class',
+  '  public type',
+  '    TBody = class',
+  '    public type',
+  '      TAnt = word;',
+  '      TWing = class(TLimb)',
+  '        {#ant}ant: TAnt;',
+  '        procedure Fly(i: longint);',
+  '      end;',
+  '    public',
+  '      class var {#tbody_a}a, {#tbody_b}b, {#tbody_d}d, {#tbody_e}e: longint;',
+  '    end;',
+  '  public',
+  '    class var {#tbird_a}a, {#tbird_b}b, {#tbird_c}c, {#tbird_d}d, {#tbird_e}e: longint;',
+  '  end;',
+  'var {#intf_a}a, {#intf_d}d: longint;',
+  'implementation',
+  'var {#impl_e}e: longint;',
+  'procedure TBird.TBody.TWing.Fly(i: longint);',
+  'begin',
+  '  {@ant}ant:=2;',
+  '  {@intf_a}a:=3;',
+  '  {@tbody_b}b:=4;',
+  '  {@tbird_c}c:=5;',
+  '  {@tlimb_d}d:=6;',
+  '  {@impl_e}e:=7;',
+  'end;',
+  '']);
+  ParseUnit;
+end;
+
+procedure TTestResolver.TestNestedClass_BodyAccessParentVarFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TBird = class',
+  '  public type',
+  '    TWing = class',
+  '      procedure Fly;',
+  '    end;',
+  '  public',
+  '    var i: longint;',
+  '  end;',
+  'procedure TBird.TWing.Fly;',
+  'begin',
+  '  i:=3;',
+  'end;',
+  'begin']);
+  CheckResolverException('Instance member "i" inaccessible here',nInstanceMemberXInaccessible);
+end;
+
+procedure TTestResolver.TestNestedClass_PropertyAccessParentVarFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  TBird = class',
+  '    fSize: word;',
+  '  public type',
+  '    TWing = class',
+  '      property Size: word read fSize;',
+  '    end;',
+  '  end;',
+  'begin']);
+  CheckResolverException('identifier not found "fSize"',nIdentifierNotFound);
+end;
+
 procedure TTestResolver.TestExternalClass;
 procedure TTestResolver.TestExternalClass;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -11736,8 +11893,8 @@ begin
   Add('  oc: TObjectClass;');
   Add('  oc: TObjectClass;');
   Add('begin');
   Add('begin');
   Add('  oc.Id:=3;');
   Add('  oc.Id:=3;');
-  CheckResolverException(sCannotAccessThisMemberFromAX,
-    nCannotAccessThisMemberFromAX);
+  CheckResolverException(sInstanceMemberXInaccessible,
+    nInstanceMemberXInaccessible);
 end;
 end;
 
 
 procedure TTestResolver.TestClassOfDotClassProc;
 procedure TTestResolver.TestClassOfDotClassProc;
@@ -11796,8 +11953,8 @@ begin
   Add('  oc: TObjectClass;');
   Add('  oc: TObjectClass;');
   Add('begin');
   Add('begin');
   Add('  oc.ProcA;');
   Add('  oc.ProcA;');
-  CheckResolverException(sCannotAccessThisMemberFromAX,
-    nCannotAccessThisMemberFromAX);
+  CheckResolverException(sInstanceMemberXInaccessible,
+    nInstanceMemberXInaccessible);
 end;
 end;
 
 
 procedure TTestResolver.TestClassOfDotClassProperty;
 procedure TTestResolver.TestClassOfDotClassProperty;
@@ -11843,8 +12000,8 @@ begin
   Add('  oc: TObjectClass;');
   Add('  oc: TObjectClass;');
   Add('begin');
   Add('begin');
   Add('  if oc.A=3 then ;');
   Add('  if oc.A=3 then ;');
-  CheckResolverException(sCannotAccessThisMemberFromAX,
-    nCannotAccessThisMemberFromAX);
+  CheckResolverException(sInstanceMemberXInaccessible,
+    nInstanceMemberXInaccessible);
 end;
 end;
 
 
 procedure TTestResolver.TestClass_ClassProcSelf;
 procedure TTestResolver.TestClass_ClassProcSelf;
@@ -12773,6 +12930,76 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestArrayProperty_PassImplicitCallClassFunc;
+var
+  aMarker: PSrcMarker;
+  Elements: TFPList;
+  ActualImplicitCallWithoutParams, ExpectedImplicitCallWithoutParams: Boolean;
+  i: Integer;
+  El: TPasElement;
+  Ref: TResolvedReference;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    function GetItems(s: string): string;',
+  '    property Items[s: string]: string read GetItems; default;',
+  '    class function Desc: string; virtual; abstract;',
+  '  end;',
+  'function TObject.GetItems(s: string): string;',
+  'begin',
+  '  Result:=Items[{#a_implicit}Desc];',
+  '  Result:=Items[{#b_direct}Desc()];',
+  '  Result:=Items[Self.{#c_implicit}Desc];',
+  '  Result:=Items[Self.{#d_direct}Desc()];',
+  'end;',
+  'var b: TObject;',
+  '  s: string;',
+  'begin',
+  '  s:=b.Items[b.{#m_implicit}Desc];',
+  '  s:=b.Items[b.{#n_direct}Desc()];',
+  '  s:=b.Items[TObject.{#o_implicit}Desc];',
+  '  s:=b.Items[TObject.{#p_direct}Desc()];',
+  '  s:=b[b.{#q_implicit}Desc];',
+  '  s:=b[b.{#r_direct}Desc()];',
+  '  s:=b[TObject.{#s_implicit}Desc];',
+  '  s:=b[TObject.{#t_direct}Desc()];',
+  '']);
+  ParseProgram;
+  aMarker:=FirstSrcMarker;
+  while aMarker<>nil do
+    begin
+    //writeln('TTestResolver.TestArrayProperty_PassImplicitCallClassFunc ',aMarker^.Identifier,' ',aMarker^.StartCol,' ',aMarker^.EndCol);
+    Elements:=FindElementsAt(aMarker);
+    try
+      ActualImplicitCallWithoutParams:=false;
+      Ref:=nil;
+      for i:=0 to Elements.Count-1 do
+        begin
+        El:=TPasElement(Elements[i]);
+        //writeln('TTestResolver.TestArrayProperty_PassImplicitCallClassFunc ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
+        if not (El.CustomData is TResolvedReference) then continue;
+        Ref:=TResolvedReference(El.CustomData);
+        if Ref.Declaration is TPasProcedure then
+          break
+        else
+          Ref:=nil;
+        end;
+      if Ref=nil then
+        RaiseErrorAtSrcMarker('missing proc ref at "#'+aMarker^.Identifier+'"',aMarker);
+      ActualImplicitCallWithoutParams:=rrfImplicitCallWithoutParams in Ref.Flags;
+      ExpectedImplicitCallWithoutParams:=RightStr(aMarker^.Identifier,length('_implicit'))='_implicit';
+      if ActualImplicitCallWithoutParams<>ExpectedImplicitCallWithoutParams then
+        RaiseErrorAtSrcMarker('wrong implicit call at "#'+aMarker^.Identifier
+          +', ExpectedImplicitCall='+BoolToStr(ExpectedImplicitCallWithoutParams,true)+'"',aMarker);
+    finally
+      Elements.Free;
+    end;
+    aMarker:=aMarker^.Next;
+    end;
+end;
+
 procedure TTestResolver.TestProperty_WrongTypeAsIndexFail;
 procedure TTestResolver.TestProperty_WrongTypeAsIndexFail;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -14534,6 +14761,21 @@ begin
   ParseProgram;
   ParseProgram;
 end;
 end;
 
 
+procedure TTestResolver.TestArray_OpenArrayChar;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'Function CharInSet(Ch: Char;Const CSet : array of char) : Boolean;',
+  'begin',
+  'end;',
+  'var Key: Char;',
+  'begin',
+  '  if CharInSet(Key, [^V, ^X, ^C]) then ;',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestArray_CopyConcat;
 procedure TTestResolver.TestArray_CopyConcat;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -17610,7 +17852,8 @@ begin
   'begin',
   'begin',
   '  TFlag.Fly;',
   '  TFlag.Fly;',
   '']);
   '']);
-  CheckResolverException('Cannot access this member from a type helper',nCannotAccessThisMemberFromAX);
+  CheckResolverException('Instance member "Fly" inaccessible here',
+    nInstanceMemberXInaccessible);
 end;
 end;
 
 
 procedure TTestResolver.TestTypeHelper_Set;
 procedure TTestResolver.TestTypeHelper_Set;

+ 1 - 1
packages/fcl-passrc/tests/tcscanner.pas

@@ -1730,7 +1730,7 @@ begin
       if SModeSwitchNames[M]<>'' then
       if SModeSwitchNames[M]<>'' then
         begin
         begin
         Scanner.CurrentModeSwitches:=[];
         Scanner.CurrentModeSwitches:=[];
-        NewSource('{$MODESWITCH '+SModeSwitchNames[M]+' '+C+'}');
+        NewSource('{$MODESWITCH '+SModeSwitchNames[M]+C+'}');
         While not (Scanner.FetchToken=tkEOF) do;
         While not (Scanner.FetchToken=tkEOF) do;
         if C in [' ','+'] then
         if C in [' ','+'] then
           AssertTrue(SModeSwitchNames[M]+C+' sets '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches)
           AssertTrue(SModeSwitchNames[M]+C+' sets '+GetEnumName(TypeInfo(TModeSwitch),Ord(M)),M in Scanner.CurrentModeSwitches)

+ 81 - 0
packages/fcl-passrc/tests/tctypeparser.pas

@@ -361,6 +361,9 @@ type
     Procedure TestAdvRec_ProcOverrideFail;
     Procedure TestAdvRec_ProcOverrideFail;
     Procedure TestAdvRec_ProcMessageFail;
     Procedure TestAdvRec_ProcMessageFail;
     Procedure TestAdvRec_DestructorFail;
     Procedure TestAdvRec_DestructorFail;
+    Procedure TestAdvRecordInFunction;
+    Procedure TestAdvRecordInAnonFunction;
+    Procedure TestAdvRecordClassOperator;
   end;
   end;
 
 
   { TTestProcedureTypeParser }
   { TTestProcedureTypeParser }
@@ -2607,6 +2610,84 @@ begin
   ParseRecordFail(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
   ParseRecordFail(SParserNoConstructorAllowed,nParserNoConstructorAllowed);
 end;
 end;
 
 
+procedure TTestRecordTypeParser.TestAdvRecordInFunction;
+
+// Src from bug report 36179
+
+Const
+   Src =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    '  procedure DoThis;'+sLineBreak+
+    '  type'+sLineBreak+
+    '    TMyRecord = record'+sLineBreak+
+    '      private'+sLineBreak+
+    '        x, y, z: integer;'+sLineBreak+
+    '    end;'+sLineBreak+
+    '  begin'+sLineBreak+
+    '  end;'+sLineBreak+
+    'begin'+sLineBreak+
+    'end.';
+
+begin
+  Source.Text:=Src;
+  ParseModule; // We're just interested in that it parses.
+end;
+
+procedure TTestRecordTypeParser.TestAdvRecordInAnonFunction;
+
+// Src from bug report 36179, modified to put record in anonymous function
+//  Delphi 10.3.2 allows this
+
+Const
+   Src =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    'var a : Procedure;'+sLineBreak+
+    'begin'+sLineBreak+
+    ' a := '+sLineBreak+
+    '  procedure '+sLineBreak+
+    '  type'+sLineBreak+
+    '    TMyRecord = record'+sLineBreak+
+    '      private'+sLineBreak+
+    '        x, y, z: integer;'+sLineBreak+
+    '    end;'+sLineBreak+
+    '  begin'+sLineBreak+
+    '  end;'+sLineBreak+
+    'end.';
+
+begin
+  Source.Text:=Src;
+  ParseModule; // We're just interested in that it parses.
+end;
+
+procedure TTestRecordTypeParser.TestAdvRecordClassOperator;
+
+// Source from bug id 36180
+
+Const
+   SRC =
+    '{$mode objfpc}'+sLineBreak+
+    '{$modeswitch advancedrecords}'+sLineBreak+
+    'program afile;'+sLineBreak+
+    'type'+sLineBreak+
+    '  TMyRecord = record'+sLineBreak+
+    '    class operator = (a, b: TMyRecord): boolean;'+sLineBreak+
+    '  end;'+sLineBreak+
+    'class operator TMyRecord.= (a, b: TMyRecord): boolean;'+sLineBreak+
+    'begin'+sLineBreak+
+    '  result := (@a = @b);'+sLineBreak+
+    'end;'+sLineBreak+
+    'begin'+sLineBreak+
+    'end.';
+
+begin
+  Source.Text:=Src;
+  ParseModule;   // We're just interested in that it parses.
+end;
+
 { TBaseTestTypeParser }
 { TBaseTestTypeParser }
 
 
 Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;
 Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;

+ 24 - 1
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -134,6 +134,7 @@ type
     procedure TestM_Hint_FunctionResultAssembler;
     procedure TestM_Hint_FunctionResultAssembler;
     procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_AbsoluteVar;
     procedure TestM_Hint_AbsoluteVar;
+    procedure TestM_Hint_GenFunctionResultArgNotUsed;
 
 
     // whole program optimization
     // whole program optimization
     procedure TestWP_LocalVar;
     procedure TestWP_LocalVar;
@@ -841,9 +842,9 @@ begin
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
   'resourcestring',
   'resourcestring',
-  'resourcestring',
   '  {#a_used}a = ''txt'';',
   '  {#a_used}a = ''txt'';',
   '  {#b_used}b = ''foo'';',
   '  {#b_used}b = ''foo'';',
+  '  {#c_notused}c = ''bar'';',
   'procedure {#DoIt_used}DoIt(s: string);',
   'procedure {#DoIt_used}DoIt(s: string);',
   'var',
   'var',
   '  {#d_used}d: string;',
   '  {#d_used}d: string;',
@@ -2282,6 +2283,28 @@ begin
   CheckUseAnalyzerUnexpectedHints;
   CheckUseAnalyzerUnexpectedHints;
 end;
 end;
 
 
+procedure TTestUseAnalyzer.TestM_Hint_GenFunctionResultArgNotUsed;
+begin
+  StartProgram(true);
+  Add([
+  'type',
+  '  generic TPoint<U> = record X,Y: U; end;',
+  'generic procedure Three<S>(out x: S);',
+  'begin',
+  '  x:=3;',
+  'end;',
+  'generic function Point<T>(): specialize TPoint<T>;',
+  'begin',
+  '  specialize Three<T>(Result.X)',
+  'end;',
+  'begin',
+  '  specialize Point<word>();',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestWP_LocalVar;
 procedure TTestUseAnalyzer.TestWP_LocalVar;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

+ 258 - 95
packages/pastojs/src/fppas2js.pp

@@ -400,22 +400,24 @@ Works:
   - pass class property, static class property
   - pass class property, static class property
   - pass array property
   - pass array property
 - array of const, TVarRec
 - array of const, TVarRec
+- attributes
+- overflow check:
+  -Co   : Overflow checking of integer operations
+- generics
 
 
 ToDos:
 ToDos:
 - range check:
 - range check:
    type helper self:=
    type helper self:=
-- overflow check:
-   ?
 - cmd line param to set modeswitch
 - cmd line param to set modeswitch
 - Result:=inherited;
 - Result:=inherited;
 - asm-block annotate/reference
 - asm-block annotate/reference
   - pas()  test or use or read or write
   - pas()  test or use or read or write
+  - trailing [,,,]
 - bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
 - bug: DoIt(typeinfo(i))  where DoIt is in another unit and has TTypeInfo
 - $OPTIMIZATION ON|OFF
 - $OPTIMIZATION ON|OFF
 - $optimization REMOVEEMPTYPROCS
 - $optimization REMOVEEMPTYPROCS
 - $optimization REMOVEEMPTYPROCS,RemoveNotUsedDeclarations-
 - $optimization REMOVEEMPTYPROCS,RemoveNotUsedDeclarations-
 - setlength(dynarray)  modeswitch to not create a copy
 - setlength(dynarray)  modeswitch to not create a copy
-- 'new', 'Function' -> class var use .prototype
 - static arrays
 - static arrays
   - clone multi dim static array
   - clone multi dim static array
 - RTTI
 - RTTI
@@ -428,50 +430,22 @@ ToDos:
 - stdcall of methods: pass original 'this' as first parameter
 - stdcall of methods: pass original 'this' as first parameter
 - property read Arr[0]  https://bugs.freepascal.org/view.php?id=33416
 - property read Arr[0]  https://bugs.freepascal.org/view.php?id=33416
 - write, writeln
 - write, writeln
-- array of const
 - call array of proc element without ()
 - call array of proc element without ()
 - enums with custom values
 - enums with custom values
 - library
 - library
 - constref
 - constref
 - option overflow checking -Co
 - option overflow checking -Co
   +, -, *, Succ, Pred, Inc, Dec
   +, -, *, Succ, Pred, Inc, Dec
-  -Co   : Overflow checking of integer operations
   -CO   : Check for possible overflow of integer operations
   -CO   : Check for possible overflow of integer operations
 -C3 : Turn on ieee error checking for constants
 -C3 : Turn on ieee error checking for constants
 - optimizations:
 - optimizations:
-  - move rtl.js functions to system.pp
-  - add $mod only if needed
-  - add Self only if needed
-  - use a number for small sets
-  - put set literals into constants
-  - shortcut for test set is empty  a=[]  a<>[]
-  - set operators on literals without temporary arrays, a in [b], [a]*b<>[]
-  - combine multiple var a=0,b=0
-  - init a local var with the first assignment
-  - skip clone array for new array and arraysetlength
-  - SetLength(scope.a,l) -> read scope only once, same for
-    Include, Exclude, Inc, Dec, +=, -=, *=, /=
-  - inline  -Si
-  - autoinline
-  -O1 insert unit vars for complex literals
-  -O1 no function Result var when assigned only once
-  -O1 replace constant expression with result
-  -O1 pass array element by ref: when index is constant, use that directly
-  -O1 case-of with 6+ elements as binary tree
-  -O2 insert local/unit vars for global type references:
-      at start of intf var $r1=null;
-      at end of impl: $r1=path;
-  -O2 removeemptyprocs
-  -O2 skip dead code If(false){...}
-  -O2 CSE
-  -O3 DFA
+  see https://wiki.lazarus.freepascal.org/Pas2js_optimizations
 - objects
 - objects
 - generics
 - generics
 - operator overloading
 - operator overloading
   - operator enumerator
   - operator enumerator
 - inline
 - inline
 - extended RTTI
 - extended RTTI
-- attributes
 
 
 Debugging this unit: -d<x>
 Debugging this unit: -d<x>
    VerbosePas2JS
    VerbosePas2JS
@@ -562,6 +536,7 @@ const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
   IsExtModePasClassInstance = 1;
   IsExtModePasClassInstance = 1;
   IsExtModePasClass = 2;
   IsExtModePasClass = 2;
+  LocalVarHide = '-';
 
 
 type
 type
   TPas2JSBuiltInName = (
   TPas2JSBuiltInName = (
@@ -645,6 +620,7 @@ type
     pbifnRTTINewClassRef,// typeinfo of tkClassRef $ClassRef
     pbifnRTTINewClassRef,// typeinfo of tkClassRef $ClassRef
     pbifnRTTINewDynArray,// typeinfo of tkDynArray $DynArray
     pbifnRTTINewDynArray,// typeinfo of tkDynArray $DynArray
     pbifnRTTINewEnum,// typeinfo of tkEnumeration $Enum
     pbifnRTTINewEnum,// typeinfo of tkEnumeration $Enum
+    pbifnRTTINewExtClass,// typeinfo creator of tkExtClass $ExtClass
     pbifnRTTINewInt,// typeinfo of tkInt $Int
     pbifnRTTINewInt,// typeinfo of tkInt $Int
     pbifnRTTINewInterface,// typeinfo creator of tkInterface $Interface
     pbifnRTTINewInterface,// typeinfo creator of tkInterface $Interface
     pbifnRTTINewMethodVar,// typeinfo of tkMethod $MethodVar
     pbifnRTTINewMethodVar,// typeinfo of tkMethod $MethodVar
@@ -701,16 +677,18 @@ type
     pbivnRTTIInt_MinValue,
     pbivnRTTIInt_MinValue,
     pbivnRTTIInt_OrdType,
     pbivnRTTIInt_OrdType,
     pbivnRTTILocal, // $r
     pbivnRTTILocal, // $r
-    pbivnRTTIMemberAttributes,
+    pbivnRTTIMemberAttributes, // attr
     pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
     pbivnRTTIMethodKind, // tTypeInfoMethodVar has methodkind
-    pbivnRTTIPointer_RefType,
-    pbivnRTTIProcFlags,
-    pbivnRTTIProcVar_ProcSig,
-    pbivnRTTIPropDefault,
-    pbivnRTTIPropIndex,
-    pbivnRTTIPropStored,
-    pbivnRTTISet_CompType,
-    pbivnRTTITypeAttributes,
+    pbivnRTTIPointer_RefType, // reftype
+    pbivnRTTIProcFlags, // flags
+    pbivnRTTIProcVar_ProcSig, // procsig
+    pbivnRTTIPropDefault, // Default
+    pbivnRTTIPropIndex, // index
+    pbivnRTTIPropStored, // stored
+    pbivnRTTISet_CompType, // comptype
+    pbivnRTTITypeAttributes, // attr
+    pbivnRTTIExtClass_Ancestor, // ancestor
+    pbivnRTTIExtClass_JSClass, // jsclass
     pbivnSelf,
     pbivnSelf,
     pbivnTObjectDestroy,
     pbivnTObjectDestroy,
     pbivnWith,
     pbivnWith,
@@ -722,6 +700,7 @@ type
     pbitnTIClassRef,
     pbitnTIClassRef,
     pbitnTIDynArray,
     pbitnTIDynArray,
     pbitnTIEnum,
     pbitnTIEnum,
+    pbitnTIExtClass,
     pbitnTIHelper,
     pbitnTIHelper,
     pbitnTIInteger,
     pbitnTIInteger,
     pbitnTIInterface,
     pbitnTIInterface,
@@ -816,6 +795,7 @@ const
     '$ClassRef',
     '$ClassRef',
     '$DynArray',
     '$DynArray',
     '$Enum',
     '$Enum',
+    '$ExtClass',
     '$Int',
     '$Int',
     '$Interface',
     '$Interface',
     '$MethodVar',
     '$MethodVar',
@@ -881,6 +861,8 @@ const
     'stored', // pbivnRTTIPropStored
     'stored', // pbivnRTTIPropStored
     'comptype', // pbivnRTTISet_CompType
     'comptype', // pbivnRTTISet_CompType
     'attr', // pbivnRTTITypeAttributes
     'attr', // pbivnRTTITypeAttributes
+    'ancestor', // pbivnRTTIExtClass_Ancestor
+    'jsclass', // pbivnRTTIExtClass_JSClass
     '$Self', // pbivnSelf
     '$Self', // pbivnSelf
     'tObjectDestroy', // rtl.tObjectDestroy  pbivnTObjectDestroy
     'tObjectDestroy', // rtl.tObjectDestroy  pbivnTObjectDestroy
     '$with', // pbivnWith
     '$with', // pbivnWith
@@ -891,6 +873,7 @@ const
     'tTypeInfoClassRef', // pbitnTIClassRef
     'tTypeInfoClassRef', // pbitnTIClassRef
     'tTypeInfoDynArray', // pbitnTIDynArray
     'tTypeInfoDynArray', // pbitnTIDynArray
     'tTypeInfoEnum', // pbitnTIEnum
     'tTypeInfoEnum', // pbitnTIEnum
+    'tTypeInfoExtClass', // pbitnTIExtClass
     'tTypeInfoHelper', // pbitnTIHelper
     'tTypeInfoHelper', // pbitnTIHelper
     'tTypeInfoInteger', // pbitnTIInteger
     'tTypeInfoInteger', // pbitnTIInteger
     'tTypeInfoInterface', // pbitnTIInterface
     'tTypeInfoInterface', // pbitnTIInterface
@@ -1217,7 +1200,8 @@ const
     msArrayOperators,
     msArrayOperators,
     msPrefixedAttributes,
     msPrefixedAttributes,
     msOmitRTTI,
     msOmitRTTI,
-    msMultiHelpers];
+    msMultiHelpers,
+    msImplicitFunctionSpec];
 
 
   bsAllPas2jsBoolSwitchesReadOnly = [
   bsAllPas2jsBoolSwitchesReadOnly = [
     bsLongStrings
     bsLongStrings
@@ -1870,7 +1854,7 @@ type
     Function CreateCloneStaticArray(El: TPasElement; ArrTypeEl: TPasArrayType;
     Function CreateCloneStaticArray(El: TPasElement; ArrTypeEl: TPasArrayType;
       ArrayExpr: TJSElement; AContext: TConvertContext): TJSElement; virtual;
       ArrayExpr: TJSElement; AContext: TConvertContext): TJSElement; virtual;
     // class
     // class
-    Procedure AddInstanceMemberFunction(El: TPasClassType; Src: TJSSourceElements;
+    Procedure AddClassConDestructorFunction(El: TPasClassType; Src: TJSSourceElements;
       ClassContext: TConvertContext; IsTObject: boolean; Ancestor: TPasType;
       ClassContext: TConvertContext; IsTObject: boolean; Ancestor: TPasType;
       Kind: TMemberFunc);
       Kind: TMemberFunc);
     Procedure AddClassRTTI(El: TPasClassType; Src: TJSSourceElements;
     Procedure AddClassRTTI(El: TPasClassType; Src: TJSSourceElements;
@@ -1902,6 +1886,7 @@ type
       AContext: TConvertContext): TJSElement; virtual;
       AContext: TConvertContext): TJSElement; virtual;
     Procedure AddRTTIArgument(Arg: TPasArgument; TargetParams: TJSArrayLiteral;
     Procedure AddRTTIArgument(Arg: TPasArgument; TargetParams: TJSArrayLiteral;
       AContext: TConvertContext); virtual;
       AContext: TConvertContext); virtual;
+    Function GetClassBIName(El: TPasClassType): string; virtual;
     Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
     Function CreateRTTINewType(El: TPasType; const CallFuncName: string;
       IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
       IsForward: boolean; AContext: TConvertContext; out ObjLit: TJSObjectLiteral): TJSCallExpression; virtual;
     Function CreateRTTIAttributes(const Attr: TPasExprArray; PosEl: TPasElement; aContext: TConvertContext): TJSElement; virtual;
     Function CreateRTTIAttributes(const Attr: TPasExprArray; PosEl: TPasElement; aContext: TConvertContext): TJSElement; virtual;
@@ -2037,6 +2022,7 @@ type
     Function ConvertClassType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertClassType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertClassForwardType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertClassForwardType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertClassOfType(El: TPasClassOfType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertClassOfType(El: TPasClassOfType; AContext: TConvertContext): TJSElement; virtual;
+    Function ConvertExtClassType(El: TPasClassType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertEnumType(El: TPasEnumType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertEnumType(El: TPasEnumType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertSetType(El: TPasSetType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertSetType(El: TPasSetType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRangeType(El: TPasRangeType; AContext: TConvertContext): TJSElement; virtual;
     Function ConvertRangeType(El: TPasRangeType; AContext: TConvertContext): TJSElement; virtual;
@@ -2312,7 +2298,7 @@ begin
     end;
     end;
   {$ENDIF}
   {$ENDIF}
   {$IFDEF VerbosePasResolver}
   {$IFDEF VerbosePasResolver}
-  if FindElevatedLocal(Item.Identifier)<>Item then
+  if Find(Item.Identifier)<>Item then
     raise Exception.Create('20160925183849');
     raise Exception.Create('20160925183849');
   {$ENDIF}
   {$ENDIF}
 end;
 end;
@@ -2858,6 +2844,8 @@ begin
     if ProcScope.DeclarationProc<>nil then
     if ProcScope.DeclarationProc<>nil then
       // implementation proc -> only count the header -> skip
       // implementation proc -> only count the header -> skip
       exit(false);
       exit(false);
+    if ProcScope.SpecializedFromItem<>nil then
+      exit(false);
     end;
     end;
   Result:=true;
   Result:=true;
 end;
 end;
@@ -4075,13 +4063,7 @@ begin
               // constructor of external class can't be overriden -> forbid virtual
               // constructor of external class can't be overriden -> forbid virtual
               RaiseMsg(20170323100447,nInvalidXModifierY,sInvalidXModifierY,
               RaiseMsg(20170323100447,nInvalidXModifierY,sInvalidXModifierY,
                 [Proc.ElementTypeName,'virtual,external'],Proc);
                 [Proc.ElementTypeName,'virtual,external'],Proc);
-            ExtName:=ComputeConstString(Proc.LibrarySymbolName,true,true);
-            if CompareText(Proc.Name,'new')=0 then
-              begin
-              if ExtName<>Proc.Name then
-                RaiseMsg(20170323083511,nVirtualMethodNameMustMatchExternal,
-                  sVirtualMethodNameMustMatchExternal,[],Proc.LibrarySymbolName);
-              end;
+            ComputeConstString(Proc.LibrarySymbolName,true,true);
             end
             end
           else
           else
             RaiseMsg(20170322163210,nPasElementNotSupported,sPasElementNotSupported,
             RaiseMsg(20170322163210,nPasElementNotSupported,sPasElementNotSupported,
@@ -4881,6 +4863,9 @@ var
   TypeEl: TPasType;
   TypeEl: TPasType;
   FoundClass: TPasClassType;
   FoundClass: TPasClassType;
   ScopeDepth: Integer;
   ScopeDepth: Integer;
+  TemplType: TPasGenericTemplateType;
+  ConEl: TPasElement;
+  ConToken: TToken;
 begin
 begin
   Param:=Params.Params[0];
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
   ComputeElement(Param,ParamResolved,[rcNoImplicitProc]);
@@ -4939,7 +4924,11 @@ begin
       TIName:=Pas2JSBuiltInNames[pbitnTIRecord]
       TIName:=Pas2JSBuiltInNames[pbitnTIRecord]
     else if C=TPasClassType then
     else if C=TPasClassType then
       case TPasClassType(TypeEl).ObjKind of
       case TPasClassType(TypeEl).ObjKind of
-      okClass: TIName:=Pas2JSBuiltInNames[pbitnTIClass];
+      okClass:
+        if TPasClassType(TypeEl).IsExternal then
+          TIName:=Pas2JSBuiltInNames[pbitnTIExtClass]
+        else
+          TIName:=Pas2JSBuiltInNames[pbitnTIClass];
       okInterface: TIName:=Pas2JSBuiltInNames[pbitnTIInterface];
       okInterface: TIName:=Pas2JSBuiltInNames[pbitnTIInterface];
       okClassHelper,okRecordHelper,okTypeHelper: TIName:=Pas2JSBuiltInNames[pbitnTIHelper];
       okClassHelper,okRecordHelper,okTypeHelper: TIName:=Pas2JSBuiltInNames[pbitnTIHelper];
       else
       else
@@ -4960,7 +4949,37 @@ begin
         TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
         TIName:=Pas2JSBuiltInNames[pbitnTIDynArray];
       end
       end
     else if C=TPasPointerType then
     else if C=TPasPointerType then
-      TIName:=Pas2JSBuiltInNames[pbitnTIPointer];
+      TIName:=Pas2JSBuiltInNames[pbitnTIPointer]
+    else if C=TPasGenericTemplateType then
+      begin
+      TemplType:=TPasGenericTemplateType(TypeEl);
+      if length(TemplType.Constraints)>0 then
+        begin
+        ConEl:=TemplType.Constraints[0];
+        ConToken:=GetGenericConstraintKeyword(ConEl);
+        case ConToken of
+        tkrecord: TIName:=Pas2JSBuiltInNames[pbitnTIRecord];
+        tkclass,tkConstructor: TIName:=Pas2JSBuiltInNames[pbitnTIClass];
+        else
+          if not (ConEl is TPasType) then
+            RaiseNotYetImplemented(20191018180031,ConEl,GetObjPath(Param));
+          if ConEl is TPasClassType then
+            begin
+            if TPasClassType(ConEl).IsExternal then
+              TIName:=Pas2JSBuiltInNames[pbitnTIExtClass]
+            else
+              TIName:=Pas2JSBuiltInNames[pbitnTIClass];
+            end
+          else
+            RaiseNotYetImplemented(20191018180131,ConEl,GetObjPath(Param));
+        end;
+        end;
+      if TIName='' then
+        begin
+        // generic template without constraints
+        TIName:=Pas2JSBuiltInNames[pbitnTI];
+        end;
+      end;
     end
     end
   else if ParamResolved.BaseType=btSet then
   else if ParamResolved.BaseType=btSet then
     begin
     begin
@@ -4989,7 +5008,7 @@ begin
     else if ParamResolved.BaseType in [btChar,btBoolean] then
     else if ParamResolved.BaseType in [btChar,btBoolean] then
       TIName:=Pas2JSBuiltInNames[pbitnTI]
       TIName:=Pas2JSBuiltInNames[pbitnTI]
     end;
     end;
-  //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName);
+  //writeln('TPas2JSResolver.BI_TypeInfo_OnGetCallResult TIName=',TIName,' ',GetObjName(TypeEl));
   if TIName='' then
   if TIName='' then
     begin
     begin
     {$IFDEF VerbosePas2JS}
     {$IFDEF VerbosePas2JS}
@@ -5818,12 +5837,30 @@ end;
 function TPas2JSResolver.GetOverloadName(El: TPasElement): string;
 function TPas2JSResolver.GetOverloadName(El: TPasElement): string;
 var
 var
   Data: TObject;
   Data: TObject;
+  ProcScope, GenScope: TPas2JSProcedureScope;
+  GenEl: TPasElement;
 begin
 begin
   Data:=El.CustomData;
   Data:=El.CustomData;
   if Data is TPas2JSProcedureScope then
   if Data is TPas2JSProcedureScope then
     begin
     begin
-    Result:=TPas2JSProcedureScope(Data).OverloadName;
-    if Result<>'' then exit;
+    ProcScope:=TPas2JSProcedureScope(Data);
+    if ProcScope.SpecializedFromItem<>nil then
+      begin
+      // specialized proc -> generic name + 's' + index
+      GenEl:=ProcScope.SpecializedFromItem.GenericEl;
+      GenScope:=TPas2JSProcedureScope(GenEl.CustomData);
+      Result:=GenScope.OverloadName;
+      if Result='' then
+        Result:=GenEl.Name+'$';
+      Result:=Result+'s'+IntToStr(ProcScope.SpecializedFromItem.Index);
+      end
+    else
+      begin
+      Result:=ProcScope.OverloadName;
+      if Result='' then
+        Result:=El.Name;
+      end;
+    exit;
     end;
     end;
   Result:=El.Name;
   Result:=El.Name;
 end;
 end;
@@ -5841,8 +5878,6 @@ function TPas2JSResolver.HasTypeInfo(El: TPasType): boolean;
 begin
 begin
   Result:=inherited HasTypeInfo(El);
   Result:=inherited HasTypeInfo(El);
   if not Result then exit;
   if not Result then exit;
-  if (El.ClassType=TPasClassType) and TPasClassType(El).IsExternal then
-    exit(false);
   if El.Parent is TProcedureBody then
   if El.Parent is TProcedureBody then
     Result:=false;
     Result:=false;
 end;
 end;
@@ -6191,7 +6226,11 @@ begin
   if El=nil then exit('');
   if El=nil then exit('');
   V:=FindLocalIdentifier(El);
   V:=FindLocalIdentifier(El);
   if V<>nil then
   if V<>nil then
-    Result:=V.Name
+    begin
+    Result:=V.Name;
+    if Result=LocalVarHide then
+      Result:='';
+    end
   else if ThisPas=El then
   else if ThisPas=El then
     Result:='this'
     Result:='this'
   else
   else
@@ -6315,12 +6354,17 @@ end;
 function TConvertContext.GetSelfContext: TFunctionContext;
 function TConvertContext.GetSelfContext: TFunctionContext;
 var
 var
   Ctx: TConvertContext;
   Ctx: TConvertContext;
+  FuncContext: TFunctionContext;
 begin
 begin
   Ctx:=Self;
   Ctx:=Self;
   while Ctx<>nil do
   while Ctx<>nil do
     begin
     begin
-    if (Ctx is TFunctionContext) and (TFunctionContext(Ctx).ThisPas is TPasMembersType) then
-      exit(TFunctionContext(Ctx));
+    if (Ctx is TFunctionContext) then
+      begin
+      FuncContext:=TFunctionContext(Ctx);
+      if FuncContext.ThisPas is TPasMembersType then
+        exit(FuncContext);
+      end;
     Ctx:=Ctx.Parent;
     Ctx:=Ctx.Parent;
     end;
     end;
   Result:=nil;
   Result:=nil;
@@ -9951,6 +9995,13 @@ begin
     DotBin:=TBinaryExpr(Value);
     DotBin:=TBinaryExpr(Value);
     Value:=DotBin.right;
     Value:=DotBin.right;
     end;
     end;
+  if (not (Value.CustomData is TResolvedReference))
+      and (aResolver<>nil)
+      and (Value is TInlineSpecializeExpr) then
+    begin
+    //  Value<>()
+    Value:=TInlineSpecializeExpr(Value).NameExpr;
+    end;
 
 
   if Value.CustomData is TResolvedReference then
   if Value.CustomData is TResolvedReference then
     begin
     begin
@@ -10376,6 +10427,7 @@ begin
   Result:=nil;
   Result:=nil;
   aResolver:=AContext.Resolver;
   aResolver:=AContext.Resolver;
   NewExpr:=nil;
   NewExpr:=nil;
+  ExtName:='';
   ExtNameEl:=nil;
   ExtNameEl:=nil;
   try
   try
     Proc:=Ref.Declaration as TPasConstructor;
     Proc:=Ref.Declaration as TPasConstructor;
@@ -10383,7 +10435,13 @@ begin
 
 
     if CompareText(Proc.Name,'new')=0 then
     if CompareText(Proc.Name,'new')=0 then
       begin
       begin
-      if Left<>nil then
+      if Proc.LibrarySymbolName<>nil then
+        begin
+        ExtName:=ComputeConstString(Proc.LibrarySymbolName,AContext,true);
+        if not SameText(ExtName,'new') then
+          ExtNameEl:=CreatePrimitiveDotExpr(ExtName,PosEl);
+        end;
+      if (ExtNameEl=nil) and (Left<>nil) then
         begin
         begin
         if aResolver<>nil then
         if aResolver<>nil then
           begin
           begin
@@ -13398,7 +13456,7 @@ begin
       begin
       begin
       P:=TPasElement(El.Declarations[i]);
       P:=TPasElement(El.Declarations[i]);
       {$IFDEF VerbosePas2JS}
       {$IFDEF VerbosePas2JS}
-      //writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P));
+      writeln('TPasToJSConverter.ConvertDeclarations El[',i,']=',GetObjName(P));
       {$ENDIF}
       {$ENDIF}
       if not IsElementUsed(P) then continue;
       if not IsElementUsed(P) then continue;
 
 
@@ -13552,12 +13610,9 @@ begin
   if El.Parent is TProcedureBody then
   if El.Parent is TProcedureBody then
     RaiseNotSupported(El,AContext,20181231004355);
     RaiseNotSupported(El,AContext,20181231004355);
   if El.IsForward then
   if El.IsForward then
-    begin
-    Result:=ConvertClassForwardType(El,AContext);
-    exit;
-    end;
-
-  if El.IsExternal then exit;
+    exit(ConvertClassForwardType(El,AContext))
+  else if El.IsExternal then
+    exit(ConvertExtClassType(El,AContext));
 
 
   if El.CustomData is TPas2JSClassScope then
   if El.CustomData is TPas2JSClassScope then
     begin
     begin
@@ -13716,9 +13771,9 @@ begin
       if El.ObjKind in [okClass] then
       if El.ObjKind in [okClass] then
         begin
         begin
         // instance initialization function
         // instance initialization function
-        AddInstanceMemberFunction(El,Src,FuncContext,IsTObject,Ancestor,mfInit);
+        AddClassConDestructorFunction(El,Src,FuncContext,IsTObject,Ancestor,mfInit);
         // instance finalization function
         // instance finalization function
-        AddInstanceMemberFunction(El,Src,FuncContext,IsTObject,Ancestor,mfFinalize);
+        AddClassConDestructorFunction(El,Src,FuncContext,IsTObject,Ancestor,mfFinalize);
         end;
         end;
 
 
       if El.ObjKind in ([okClass]+okAllHelpers) then
       if El.ObjKind in ([okClass]+okAllHelpers) then
@@ -13805,7 +13860,7 @@ begin
   if IsClassRTTICreatedBefore(aClass,El,AContext) then exit;
   if IsClassRTTICreatedBefore(aClass,El,AContext) then exit;
   // module.$rtti.$Class("classname");
   // module.$rtti.$Class("classname");
   case aClass.ObjKind of
   case aClass.ObjKind of
-  okClass: Creator:=GetBIName(pbifnRTTINewClass);
+  okClass: Creator:=GetClassBIName(aClass);
   okInterface: Creator:=GetBIName(pbifnRTTINewInterface);
   okInterface: Creator:=GetBIName(pbifnRTTINewInterface);
   else
   else
     RaiseNotSupported(El,AContext,20190128102749);
     RaiseNotSupported(El,AContext,20190128102749);
@@ -13828,7 +13883,7 @@ var
   Call: TJSCallExpression;
   Call: TJSCallExpression;
   ok: Boolean;
   ok: Boolean;
   List: TJSStatementList;
   List: TJSStatementList;
-  DestType: TPasType;
+  DestType: TPasClassType;
 begin
 begin
   Result:=nil;
   Result:=nil;
   if not HasTypeInfo(El,AContext) then exit;
   if not HasTypeInfo(El,AContext) then exit;
@@ -13841,16 +13896,16 @@ begin
   try
   try
     Prop:=ObjLit.Elements.AddElement;
     Prop:=ObjLit.Elements.AddElement;
     Prop.Name:=TJSString(GetBIName(pbivnRTTIClassRef_InstanceType));
     Prop.Name:=TJSString(GetBIName(pbivnRTTIClassRef_InstanceType));
-    DestType:=AContext.Resolver.ResolveAliasType(El.DestType);
+    DestType:=AContext.Resolver.ResolveAliasType(El.DestType) as TPasClassType;
     Prop.Expr:=CreateTypeInfoRef(DestType,AContext,El);
     Prop.Expr:=CreateTypeInfoRef(DestType,AContext,El);
 
 
-    if not IsClassRTTICreatedBefore(DestType as TPasClassType,El,AContext) then
+    if not IsClassRTTICreatedBefore(DestType,El,AContext) then
       begin
       begin
       // class rtti must be forward registered
       // class rtti must be forward registered
       if not (AContext is TFunctionContext) then
       if not (AContext is TFunctionContext) then
         RaiseNotSupported(El,AContext,20170412102916);
         RaiseNotSupported(El,AContext,20170412102916);
       // prepend   module.$rtti.$Class("classname");
       // prepend   module.$rtti.$Class("classname");
-      Call:=CreateRTTINewType(DestType,GetBIName(pbifnRTTINewClass),true,AContext,ObjLit);
+      Call:=CreateRTTINewType(DestType,GetClassBIName(DestType),true,AContext,ObjLit);
       if ObjLit<>nil then
       if ObjLit<>nil then
         RaiseInconsistency(20170412102654,El);
         RaiseInconsistency(20170412102654,El);
       List:=TJSStatementList(CreateElement(TJSStatementList,El));
       List:=TJSStatementList(CreateElement(TJSStatementList,El));
@@ -13865,6 +13920,59 @@ begin
   end;
   end;
 end;
 end;
 
 
+function TPasToJSConverter.ConvertExtClassType(El: TPasClassType;
+  AContext: TConvertContext): TJSElement;
+//   module.$rtti.$ExtClass("TJSObject",{
+//     ancestor: ancestortypeinfo,
+//     jsclass: "Object"
+//   });
+var
+  TIObj: TJSObjectLiteral;
+  Call: TJSCallExpression;
+  TIProp: TJSObjectLiteralElement;
+  ClassScope: TPas2JSClassScope;
+  AncestorType: TPasClassType;
+begin
+  Result:=nil;
+  if not El.IsExternal then
+    RaiseNotSupported(El,AContext,20191027183236);
+
+  if not HasTypeInfo(El,AContext) then
+    exit;
+  // create typeinfo
+  if not (AContext is TFunctionContext) then
+    RaiseNotSupported(El,AContext,20191027182023,'typeinfo');
+  if El.Parent is TProcedureBody then
+    RaiseNotSupported(El,AContext,20191027182019);
+
+  ClassScope:=El.CustomData as TPas2JSClassScope;
+  if ClassScope.AncestorScope<>nil then
+    AncestorType:=ClassScope.AncestorScope.Element as TPasClassType
+  else
+    AncestorType:=nil;
+
+  Call:=nil;
+  try
+    // module.$rtti.$ExtClass("TMyClass",{...});
+    Call:=CreateRTTINewType(El,GetBIName(pbifnRTTINewExtClass),false,AContext,TIObj);
+    if AncestorType<>nil then
+      begin
+      // add  ancestor: ancestortypeinfo
+      TIProp:=TIObj.Elements.AddElement;
+      TIProp.Name:=TJSString(GetBIName(pbivnRTTIExtClass_Ancestor));
+      TIProp.Expr:=CreateTypeInfoRef(AncestorType,AContext,El);
+      end;
+    // add  jsclass: "extname"
+    TIProp:=TIObj.Elements.AddElement;
+    TIProp.Name:=TJSString(GetBIName(pbivnRTTIExtClass_JSClass));
+    TIProp.Expr:=CreateLiteralString(El,TPasClassType(El).ExternalName);
+    Result:=Call;
+  finally
+    if Result=nil then
+      Call.Free;
+  end;
+end;
+
 function TPasToJSConverter.ConvertEnumType(El: TPasEnumType;
 function TPasToJSConverter.ConvertEnumType(El: TPasEnumType;
   AContext: TConvertContext): TJSElement;
   AContext: TConvertContext): TJSElement;
 // TMyEnum = (red, green)
 // TMyEnum = (red, green)
@@ -13875,7 +13983,7 @@ function TPasToJSConverter.ConvertEnumType(El: TPasEnumType;
 //     "0":"green",
 //     "0":"green",
 //     "green":0,
 //     "green":0,
 //   };
 //   };
-//   module.$rtti.$TIEnum("TMyEnum",{
+//   module.$rtti.$Enum("TMyEnum",{
 //     enumtype: this.TMyEnum,
 //     enumtype: this.TMyEnum,
 //     minvalue: 0,
 //     minvalue: 0,
 //     maxvalue: 1
 //     maxvalue: 1
@@ -14643,7 +14751,7 @@ Var
   SelfSt: TJSVariableStatement;
   SelfSt: TJSVariableStatement;
   ImplProc: TPasProcedure;
   ImplProc: TPasProcedure;
   BodyPas: TProcedureBody;
   BodyPas: TProcedureBody;
-  PosEl, ThisPas: TPasElement;
+  PosEl, ThisPas, ClassOrRec: TPasElement;
   Call: TJSCallExpression;
   Call: TJSCallExpression;
   ClassPath: String;
   ClassPath: String;
   ArgResolved: TPasResolverResult;
   ArgResolved: TPasResolverResult;
@@ -14652,6 +14760,7 @@ Var
   ArgTypeEl, HelperForType: TPasType;
   ArgTypeEl, HelperForType: TPasType;
   aResolver: TPas2JSResolver;
   aResolver: TPas2JSResolver;
   IsClassConDestructor: Boolean;
   IsClassConDestructor: Boolean;
+  LocalVar: TFCLocalIdentifier;
 begin
 begin
   Result:=nil;
   Result:=nil;
 
 
@@ -14663,11 +14772,12 @@ begin
     exit;
     exit;
   IsClassConDestructor:=(El.ClassType=TPasClassConstructor)
   IsClassConDestructor:=(El.ClassType=TPasClassConstructor)
                      or (El.ClassType=TPasClassDestructor);
                      or (El.ClassType=TPasClassDestructor);
+  aResolver:=AContext.Resolver;
+  if not aResolver.IsFullySpecialized(El) then exit;
 
 
   {$IFDEF VerbosePas2JS}
   {$IFDEF VerbosePas2JS}
   writeln('TPasToJSConverter.ConvertProcedure "',El.Name,'" Overload="',ProcScope.OverloadName,'" ',El.Parent.ClassName);
   writeln('TPasToJSConverter.ConvertProcedure "',El.Name,'" Overload="',ProcScope.OverloadName,'" ',El.Parent.ClassName);
   {$ENDIF}
   {$ENDIF}
-  aResolver:=AContext.Resolver;
 
 
   ImplProc:=El;
   ImplProc:=El;
   if ProcScope.ImplProc<>nil then
   if ProcScope.ImplProc<>nil then
@@ -14780,8 +14890,10 @@ begin
         if not AContext.IsGlobal then
         if not AContext.IsGlobal then
           begin
           begin
           // nested sub procedure  ->  no 'this'
           // nested sub procedure  ->  no 'this'
-          FuncContext.ThisPas:=nil;
+          ThisPas:=nil;
           end
           end
+        else if El.IsStatic then
+          ThisPas:=nil
         else
         else
           begin
           begin
           ThisPas:=ProcScope.ClassRecScope.Element;
           ThisPas:=ProcScope.ClassRecScope.Element;
@@ -14796,7 +14908,11 @@ begin
               // 'this' in a type helper is a temporary getter/setter JS object
               // 'this' in a type helper is a temporary getter/setter JS object
               ThisPas:=nil;
               ThisPas:=nil;
             end;
             end;
-          FuncContext.ThisPas:=ThisPas;
+          end;
+        FuncContext.ThisPas:=ThisPas;
+
+        if ThisPas<>nil then
+          begin
           if (bsObjectChecks in FuncContext.ScannerBoolSwitches)
           if (bsObjectChecks in FuncContext.ScannerBoolSwitches)
               and (ThisPas is TPasMembersType) then
               and (ThisPas is TPasMembersType) then
             begin
             begin
@@ -14809,14 +14925,13 @@ begin
             ClassPath:=CreateReferencePath(ProcScope.ClassRecScope.Element,AContext,rpkPathAndName);
             ClassPath:=CreateReferencePath(ProcScope.ClassRecScope.Element,AContext,rpkPathAndName);
             Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
             Call.AddArg(CreatePrimitiveDotExpr(ClassPath,PosEl));
             end;
             end;
-
           if (ImplProc.Body.Functions.Count>0)
           if (ImplProc.Body.Functions.Count>0)
               or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
               or aResolver.HasAnonymousFunctions(ImplProc.Body.Body) then
             begin
             begin
             // has nested procs -> add "var self = this;"
             // has nested procs -> add "var self = this;"
-            FuncContext.AddLocalVar(GetBIName(pbivnSelf),FuncContext.ThisPas);
+            FuncContext.AddLocalVar(GetBIName(pbivnSelf),ThisPas);
             SelfSt:=CreateVarStatement(GetBIName(pbivnSelf),
             SelfSt:=CreateVarStatement(GetBIName(pbivnSelf),
-                                CreatePrimitiveDotExpr('this',ImplProc),ImplProc);
+                              CreatePrimitiveDotExpr('this',ImplProc),ImplProc);
             AddBodyStatement(SelfSt,PosEl);
             AddBodyStatement(SelfSt,PosEl);
             if ImplProcScope.SelfArg<>nil then
             if ImplProcScope.SelfArg<>nil then
               begin
               begin
@@ -14829,6 +14944,23 @@ begin
             // no nested procs ->  redirect Pascal-Self to JS-this
             // no nested procs ->  redirect Pascal-Self to JS-this
             FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
             FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
             end;
             end;
+          end
+        else
+          begin
+          // no "this"
+          if ProcScope.ClassRecScope<>nil then
+            begin
+            // static method -> hide local
+            ClassOrRec:=ProcScope.ClassRecScope.Element;
+            LocalVar:=FuncContext.FindLocalIdentifier(ClassOrRec);
+            if (LocalVar<>nil) and (LocalVar.Name='this') then
+              FuncContext.AddLocalVar(LocalVarHide,ClassOrRec);
+            end;
+          if ImplProcScope.SelfArg<>nil then
+            begin
+            // no nested procs ->  redirect Pascal-Self to JS-this
+            FuncContext.AddLocalVar('this',ImplProcScope.SelfArg);
+            end;
           end;
           end;
         end;
         end;
       {$IFDEF VerbosePas2JS}
       {$IFDEF VerbosePas2JS}
@@ -16306,7 +16438,7 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TPasToJSConverter.AddInstanceMemberFunction(El: TPasClassType;
+procedure TPasToJSConverter.AddClassConDestructorFunction(El: TPasClassType;
   Src: TJSSourceElements; ClassContext: TConvertContext; IsTObject: boolean;
   Src: TJSSourceElements; ClassContext: TConvertContext; IsTObject: boolean;
   Ancestor: TPasType; Kind: TMemberFunc);
   Ancestor: TPasType; Kind: TMemberFunc);
 const
 const
@@ -17226,6 +17358,14 @@ begin
     Param.Elements.AddElement.Expr:=CreateLiteralNumber(Arg,Flags);
     Param.Elements.AddElement.Expr:=CreateLiteralNumber(Arg,Flags);
 end;
 end;
 
 
+function TPasToJSConverter.GetClassBIName(El: TPasClassType): string;
+begin
+  if El.IsExternal then
+    Result:=GetBIName(pbifnRTTINewExtClass)
+  else
+    Result:=GetBIName(pbifnRTTINewClass);
+end;
+
 function TPasToJSConverter.CreateRTTINewType(El: TPasType;
 function TPasToJSConverter.CreateRTTINewType(El: TPasType;
   const CallFuncName: string; IsForward: boolean; AContext: TConvertContext;
   const CallFuncName: string; IsForward: boolean; AContext: TConvertContext;
   out ObjLit: TJSObjectLiteral): TJSCallExpression;
   out ObjLit: TJSObjectLiteral): TJSCallExpression;
@@ -21752,17 +21892,22 @@ var
   end;
   end;
 
 
   procedure Append_GetClass(Member: TPasElement);
   procedure Append_GetClass(Member: TPasElement);
+  var
+    P: TPasElement;
   begin
   begin
-    if Member.Parent is TPasClassType then
+    P:=Member.Parent;
+    if P=nil then
+      RaiseNotSupported(Member,AContext,20191018125004);
+    if P.ClassType=TPasClassType then
       begin
       begin
-      if TPasClassType(Member.Parent).IsExternal then
+      if TPasClassType(P).IsExternal then
         exit;
         exit;
       if Result<>'' then
       if Result<>'' then
         Result:=Result+'.'+GetBIName(pbivnPtrClass)
         Result:=Result+'.'+GetBIName(pbivnPtrClass)
       else
       else
         Result:=GetBIName(pbivnPtrClass);
         Result:=GetBIName(pbivnPtrClass);
       end
       end
-    else if Member.Parent is TPasRecordType then
+    else if P.ClassType=TPasRecordType then
       begin
       begin
       if Result<>'' then
       if Result<>'' then
         Result:=Result+'.'+GetBIName(pbivnPtrRecord)
         Result:=Result+'.'+GetBIName(pbivnPtrRecord)
@@ -21796,15 +21941,25 @@ var
   end;
   end;
 
 
   function IsA(SrcType, DstType: TPasType): boolean;
   function IsA(SrcType, DstType: TPasType): boolean;
+  var
+    C: TClass;
   begin
   begin
     while SrcType<>nil do
     while SrcType<>nil do
       begin
       begin
       if SrcType=DstType then exit(true);
       if SrcType=DstType then exit(true);
-      if SrcType.ClassType=TPasClassType then
+      C:=SrcType.ClassType;
+      if C=TPasClassType then
         SrcType:=TPas2JSClassScope(SrcType.CustomData).DirectAncestor
         SrcType:=TPas2JSClassScope(SrcType.CustomData).DirectAncestor
-      else if (SrcType.ClassType=TPasAliasType)
-          or (SrcType.ClassType=TPasTypeAliasType) then
+      else if (C=TPasAliasType)
+          or (C=TPasTypeAliasType) then
         SrcType:=TPasAliasType(SrcType).DestType
         SrcType:=TPasAliasType(SrcType).DestType
+      else if C=TPasSpecializeType then
+        begin
+        if SrcType.CustomData is TPasSpecializeTypeData then
+          SrcType:=TPasSpecializeTypeData(SrcType.CustomData).SpecializedType
+        else
+          RaiseInconsistency(20191027172642,SrcType);
+        end
       else
       else
         exit(false);
         exit(false);
       end;
       end;
@@ -21861,7 +22016,8 @@ begin
     begin
     begin
     // El is local var -> does not need path
     // El is local var -> does not need path
     end
     end
-  else if ElClass.InheritsFrom(TPasProcedure) and (TPasProcedure(El).LibrarySymbolName<>nil)
+  else if ElClass.InheritsFrom(TPasProcedure)
+      and (TPasProcedure(El).LibrarySymbolName<>nil)
       and not (El.Parent is TPasMembersType) then
       and not (El.Parent is TPasMembersType) then
     begin
     begin
     // an external global function -> use the literal
     // an external global function -> use the literal
@@ -21965,8 +22121,13 @@ begin
           else if (SelfContext<>nil)
           else if (SelfContext<>nil)
               and IsA(TPasType(SelfContext.ThisPas),TPasMembersType(ParentEl)) then
               and IsA(TPasType(SelfContext.ThisPas),TPasMembersType(ParentEl)) then
             begin
             begin
-            ShortName:=SelfContext.GetLocalName(SelfContext.ThisPas);
-            Prepend(Result,ShortName);
+            ShortName:=AContext.GetLocalName(SelfContext.ThisPas);
+            if ShortName='' then
+              begin
+              if PrependClassName(Result,TPasMembersType(ParentEl)) then break;
+              end
+            else
+              Prepend(Result,ShortName);
             end
             end
           else
           else
             begin
             begin
@@ -21983,6 +22144,7 @@ begin
             //RaiseNotSupported(El,AContext,20180125004049);
             //RaiseNotSupported(El,AContext,20180125004049);
             end;
             end;
           if (El.Parent=ParentEl) and (SelfContext<>nil)
           if (El.Parent=ParentEl) and (SelfContext<>nil)
+              and (SelfContext.PasElement is TPasProcedure)
               and not IsClassProc(SelfContext.PasElement) then
               and not IsClassProc(SelfContext.PasElement) then
             begin
             begin
             // inside a method -> Self is a class instance
             // inside a method -> Self is a class instance
@@ -22317,7 +22479,8 @@ begin
                 Result:=Call;
                 Result:=Call;
                 Call.AddArg(CreateReferencePathExpr(ArgTypeEl,AContext));
                 Call.AddArg(CreateReferencePathExpr(ArgTypeEl,AContext));
                 end;
                 end;
-              else RaiseNotSupported(El,AContext,20180401230251,InterfaceTypeNames[TPasClassType(ArgTypeEl).InterfaceType]);
+              else
+                RaiseNotSupported(El,AContext,20180401230251,InterfaceTypeNames[TPasClassType(ArgTypeEl).InterfaceType]);
               end;
               end;
               end
               end
             else
             else

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

@@ -38,7 +38,7 @@ uses
   Classes, SysUtils, contnrs,
   Classes, SysUtils, contnrs,
   jsbase, jstree, jswriter, JSSrcMap, fpjson,
   jsbase, jstree, jswriter, JSSrcMap, fpjson,
   PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
   PScanner, PParser, PasTree, PasResolver, PasResolveEval, PasUseAnalyzer,
-  pas2jsresstrfile,
+  pas2jsresstrfile, pas2jsresources, pas2jshtmlresources, pas2jsjsresources,
   FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
   FPPas2Js, FPPJsSrcMap, Pas2jsLogger, Pas2jsFS, Pas2jsPParser, Pas2jsUseAnalyzer;
 
 
 const
 const
@@ -150,11 +150,14 @@ type
     rvcUnit
     rvcUnit
     );
     );
   TP2JSResourceStringFile = (rsfNone,rsfUnit,rsfProgram);
   TP2JSResourceStringFile = (rsfNone,rsfUnit,rsfProgram);
+  TResourceMode = (rmNone,rmHTML,rmJS);
 
 
 const
 const
   DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict];
   DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict];
   DefaultP2JSResourceStringFile = rsfProgram;
   DefaultP2JSResourceStringFile = rsfProgram;
   DefaultP2jsRTLVersionCheck = rvcNone;
   DefaultP2jsRTLVersionCheck = rvcNone;
+  DefaultResourceMode = rmHTML;
+
   coShowAll = [coShowErrors..coShowDebug];
   coShowAll = [coShowErrors..coShowDebug];
   coO1Enable = [coEnumValuesAsNumbers];
   coO1Enable = [coEnumValuesAsNumbers];
   coO1Disable = [coKeepNotUsedPrivates,coKeepNotUsedDeclarationsWPO];
   coO1Disable = [coKeepNotUsedPrivates,coKeepNotUsedDeclarationsWPO];
@@ -350,6 +353,7 @@ type
     FPCUFilename: string;
     FPCUFilename: string;
     FPCUSupport: TPCUSupport;
     FPCUSupport: TPCUSupport;
     FReaderState: TPas2jsReaderState;
     FReaderState: TPas2jsReaderState;
+    FResourceHandler: TPas2jsResourceHandler;
     FScanner: TPas2jsPasScanner;
     FScanner: TPas2jsPasScanner;
     FShowDebug: boolean;
     FShowDebug: boolean;
     FUnitFilename: string;
     FUnitFilename: string;
@@ -357,6 +361,7 @@ type
     FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
     FUsedBy: array[TUsedBySection] of TFPList; // list of TPas2jsCompilerFile
     function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
     function GetUsedBy(Section: TUsedBySection; Index: integer): TPas2jsCompilerFile;
     function GetUsedByCount(Section: TUsedBySection): integer;
     function GetUsedByCount(Section: TUsedBySection): integer;
+    procedure HandleResources(Sender: TObject; const aFileName: String; aOptions: TStrings);
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     function OnConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
     function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
     function OnConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
     procedure OnPasResolverLog(Sender: TObject; const Msg: String);
     procedure OnPasResolverLog(Sender: TObject; const Msg: String);
@@ -403,6 +408,7 @@ type
     function GetModuleName: string;
     function GetModuleName: string;
     class function GetFile(aModule: TPasModule): TPas2jsCompilerFile;
     class function GetFile(aModule: TPasModule): TPas2jsCompilerFile;
   public
   public
+    Property ResourceHandler : TPas2jsResourceHandler Read FResourceHandler Write FResourceHandler;
     property PasFileName: String Read FPasFileName;
     property PasFileName: String Read FPasFileName;
     property PasUnitName: string read FPasUnitName write FPasUnitName;// unit name in source, initialized from UnitFilename
     property PasUnitName: string read FPasUnitName write FPasUnitName;// unit name in source, initialized from UnitFilename
     property Converter: TPasToJSConverter read FConverter;
     property Converter: TPasToJSConverter read FConverter;
@@ -497,6 +503,8 @@ type
     FSrcMapSourceRoot: string;
     FSrcMapSourceRoot: string;
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
     FUnits: TPasAnalyzerKeySet; // set of TPas2jsCompilerFile, key is PasUnitName
     FWPOAnalyzer: TPas2JSAnalyzer;
     FWPOAnalyzer: TPas2JSAnalyzer;
+    FResourceMode : TResourceMode;
+    FResources : TPas2JSResourceHandler;
     FResourceStrings : TResourceStringsFile;
     FResourceStrings : TResourceStringsFile;
     FResourceStringFile :  TP2JSResourceStringFile;
     FResourceStringFile :  TP2JSResourceStringFile;
     procedure AddInsertJSFilename(const aFilename: string);
     procedure AddInsertJSFilename(const aFilename: string);
@@ -551,6 +559,7 @@ type
     procedure SetWriteMsgToStdErr(const AValue: boolean);
     procedure SetWriteMsgToStdErr(const AValue: boolean);
     procedure WriteJSToFile(const MapFileName: string; aFileWriter: TPas2JSMapper);
     procedure WriteJSToFile(const MapFileName: string; aFileWriter: TPas2JSMapper);
     procedure WriteResourceStrings(aFileName: String);
     procedure WriteResourceStrings(aFileName: String);
+    procedure WriteResources(aFileName: String);
     procedure WriteSrcMap(const MapFileName: string; aFileWriter: TPas2JSMapper);
     procedure WriteSrcMap(const MapFileName: string; aFileWriter: TPas2JSMapper);
   private
   private
     procedure AddDefinesForTargetPlatform;
     procedure AddDefinesForTargetPlatform;
@@ -561,6 +570,7 @@ type
   private
   private
     // params, cfg files
     // params, cfg files
     FCurParam: string;
     FCurParam: string;
+    FResourceOutputFile: String;
     procedure LoadConfig(CfgFilename: string);
     procedure LoadConfig(CfgFilename: string);
     procedure ReadEnvironment;
     procedure ReadEnvironment;
     procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
     procedure ReadParam(Param: string; Quick, FromCmdLine: boolean);
@@ -603,7 +613,7 @@ type
     procedure CreateJavaScript(aFile: TPas2jsCompilerFile;
     procedure CreateJavaScript(aFile: TPas2jsCompilerFile;
       Checked: TPasAnalyzerKeySet { set of TPas2jsCompilerFile, key is UnitFilename });
       Checked: TPasAnalyzerKeySet { set of TPas2jsCompilerFile, key is UnitFilename });
     procedure FinishSrcMap(SrcMap: TPas2JSSrcMap); virtual;
     procedure FinishSrcMap(SrcMap: TPas2JSSrcMap); virtual;
-    // WriteSingleJSFile does not
+    // WriteSingleJSFile does not recurse
     procedure WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
     procedure WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
     // WriteJSFiles recurses uses clause
     // WriteJSFiles recurses uses clause
     procedure WriteJSFiles(aFile: TPas2jsCompilerFile;
     procedure WriteJSFiles(aFile: TPas2jsCompilerFile;
@@ -618,6 +628,8 @@ type
     function GetExitCode: Longint; virtual;
     function GetExitCode: Longint; virtual;
     procedure SetExitCode(Value: Longint); virtual;
     procedure SetExitCode(Value: Longint); virtual;
     Procedure SetWorkingDir(const aDir: String); virtual;
     Procedure SetWorkingDir(const aDir: String); virtual;
+    Procedure CreateResourceSupport; virtual;
+
   public
   public
     constructor Create; virtual;
     constructor Create; virtual;
     destructor Destroy; override;
     destructor Destroy; override;
@@ -698,6 +710,8 @@ type
     property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim
     property SrcMapBaseDir: string read FSrcMapBaseDir write SetSrcMapBaseDir; // includes trailing pathdelim
     property Namespaces: TStringList read FNamespaces;
     property Namespaces: TStringList read FNamespaces;
     property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
     property NamespacesFromCmdLine: integer read FNamespacesFromCmdLine;
+    Property ResourceMode : TResourceMode Read FResourceMode Write FResourceMode;
+    Property ResourceOutputFile : String Read FResourceOutputFile Write FResourceOutputFile;
     // can be set optionally, will be freed by compiler
     // can be set optionally, will be freed by compiler
     property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport;
     property ConfigSupport: TPas2JSConfigSupport Read FConfigSupport Write FConfigSupport;
     property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
     property PostProcessorSupport: TPas2JSPostProcessorSupport Read FPostProcessorSupport Write FPostProcessorSupport;
@@ -1052,6 +1066,7 @@ begin
   Scanner.LogEvents:=PascalResolver.ScannerLogEvents;
   Scanner.LogEvents:=PascalResolver.ScannerLogEvents;
   Scanner.OnLog:=@OnScannerLog;
   Scanner.OnLog:=@OnScannerLog;
   Scanner.OnFormatPath:[email protected];
   Scanner.OnFormatPath:[email protected];
+  Scanner.RegisterResourceHandler('*',@HandleResources);
 
 
   // create parser (Note: this sets some scanner options to defaults)
   // create parser (Note: this sets some scanner options to defaults)
   FParser := TPas2jsPasParser.Create(Scanner, FileResolver, PascalResolver);
   FParser := TPas2jsPasParser.Create(Scanner, FileResolver, PascalResolver);
@@ -1147,6 +1162,13 @@ begin
   Result:=FUsedBy[Section].Count;
   Result:=FUsedBy[Section].Count;
 end;
 end;
 
 
+procedure TPas2jsCompilerFile.HandleResources(Sender: TObject; const aFileName: String; aOptions: TStrings);
+begin
+  // maybe emit message ?
+  FResourceHandler.StartUnit(PasModule.Name);
+  FResourceHandler.HandleResource(aFileName,aOptions);
+end;
+
 function TPas2jsCompilerFile.OnConverterIsElementUsed(Sender: TObject;
 function TPas2jsCompilerFile.OnConverterIsElementUsed(Sender: TObject;
   El: TPasElement): boolean;
   El: TPasElement): boolean;
 begin
 begin
@@ -1506,6 +1528,8 @@ begin
     Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
     Converter.OnIsElementUsed:=@OnConverterIsElementUsed;
     Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed;
     Converter.OnIsTypeInfoUsed:=@OnConverterIsTypeInfoUsed;
     FJSModule:=Converter.ConvertPasElement(PasModule,PascalResolver);
     FJSModule:=Converter.ConvertPasElement(PasModule,PascalResolver);
+    if FResourceHandler.Outputmode=romJS then
+      FJSModule:=FResourceHandler.WriteJS(PasUnitName,FJSModule);
   except
   except
     on E: ECompilerTerminate do
     on E: ECompilerTerminate do
       raise;
       raise;
@@ -2633,6 +2657,55 @@ begin
 
 
 end;
 end;
 
 
+procedure TPas2jsCompiler.WriteResources(aFileName: String);
+
+Var
+  {$IFDEF Pas2js}
+  buf: TJSArray;
+  {$ELSE}
+  buf: TMemoryStream;
+  {$ENDIF}
+  S : TJSONStringType;
+begin
+    Log.LogMsg(nWritingFile,[FullFormatPath(aFilename)],'',0,0,False);
+    try
+      {$IFDEF Pas2js}
+      buf:=TJSArray.new;
+      {$ELSE}
+      buf:=TMemoryStream.Create;
+      {$ENDIF}
+      try
+        S:=FResources.AsString;
+        {$ifdef pas2js}
+        buf.push(S);
+        {$else}
+        buf.Write(S[1],length(S));
+        {$endif}
+        FS.SaveToFile(buf,aFilename);
+      finally
+        {$IFDEF Pas2js}
+        buf:=nil;
+        {$ELSE}
+        buf.Free;
+        {$ENDIF}
+      end;
+    except
+      on E: Exception do begin
+        if ShowDebug then
+          Log.LogExceptionBackTrace(E);
+        {$IFDEF FPC}
+        if E.Message<>SafeFormat(SFCreateError,[aFileName]) then
+        {$ENDIF}
+          Log.LogPlain('Error: '+E.Message);
+        Log.LogMsg(nUnableToWriteFile,[FullFormatPath(aFilename)]);
+        Terminate(ExitCodeWriteError);
+      end
+      {$IFDEF Pas2js}
+      else HandleJSException('[20181031190737] TPas2jsCompiler.WriteJSFiles',JSExceptValue);
+      {$ENDIF}
+    end;
+end;
+
 procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
 procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; CombinedFileWriter: TPas2JSMapper);
 
 
   Procedure WriteToStandardOutput(aFileWriter : TPas2JSMapper);
   Procedure WriteToStandardOutput(aFileWriter : TPas2JSMapper);
@@ -2674,7 +2747,7 @@ procedure TPas2jsCompiler.WriteSingleJSFile(aFile: TPas2jsCompilerFile; Combined
 Var
 Var
   aFileWriter : TPas2JSMapper;
   aFileWriter : TPas2JSMapper;
   isSingleFile : Boolean;
   isSingleFile : Boolean;
-  MapFilename : String;
+  ResFileName,MapFilename : String;
 
 
 begin
 begin
   aFileWriter:=CombinedFileWriter;
   aFileWriter:=CombinedFileWriter;
@@ -2685,11 +2758,16 @@ begin
       begin
       begin
       aFileWriter:=CreateFileWriter(aFile,'');
       aFileWriter:=CreateFileWriter(aFile,'');
       if aFile.IsMainFile and Not AllJSIntoMainJS then
       if aFile.IsMainFile and Not AllJSIntoMainJS then
+        begin
         InsertCustomJSFiles(aFileWriter);
         InsertCustomJSFiles(aFileWriter);
+        if FResources.OutputMode=romExtraJS then
+          aFileWriter.WriteFile(FResources.AsString,GetResolvedMainJSFile);
+        end;
       end;
       end;
 
 
     if FResourceStringFile<>rsfNone then
     if FResourceStringFile<>rsfNone then
       AddUnitResourceStrings(aFile);
       AddUnitResourceStrings(aFile);
+    FResources.DoneUnit(aFile.isMainFile);
     EmitJavaScript(aFile,aFileWriter);
     EmitJavaScript(aFile,aFileWriter);
 
 
 
 
@@ -2719,6 +2797,16 @@ begin
       if (FResourceStringFile=rsfUnit) or (aFile.IsMainFile and (FResourceStringFile<>rsfNone)) then
       if (FResourceStringFile=rsfUnit) or (aFile.IsMainFile and (FResourceStringFile<>rsfNone)) then
         if FResourceStrings.StringsCount>0 then
         if FResourceStrings.StringsCount>0 then
           WriteResourceStrings(ChangeFileExt(aFileWriter.DestFileName,'.jrs'));
           WriteResourceStrings(ChangeFileExt(aFileWriter.DestFileName,'.jrs'));
+//      Writeln('IsSingleFile ',isSingleFile,' mainfile: ',aFile.IsMainFile,' filename: ', aFileWriter.DestFileName);
+      if aFile.isMainFile and (FResources.OutputMode=romFile) and (FResources.ResourceCount>0) then
+        begin
+        ResFileName:=FResourceOutputFile;
+        if ResFileName='' then
+          // default is projectname-res.ext, to avoid projectname.html, used in web projects in Lazarus IDE
+          ResFileName:=ChangeFileExt(aFileWriter.DestFileName,'-res'+FResources.OutputFileExtension);
+        WriteResources(ResFileName);
+        end;
+
       // write source map
       // write source map
       if aFileWriter.SrcMap<>nil then
       if aFileWriter.SrcMap<>nil then
         WriteSrcMap(MapFileName,aFileWriter);
         WriteSrcMap(MapFileName,aFileWriter);
@@ -2759,17 +2847,21 @@ begin
   if Checked.ContainsItem(aFile) then exit;
   if Checked.ContainsItem(aFile) then exit;
   Checked.Add(aFile);
   Checked.Add(aFile);
 
 
+
   aFileWriter:=CombinedFileWriter;
   aFileWriter:=CombinedFileWriter;
   if AllJSIntoMainJS and (aFileWriter=nil) then
   if AllJSIntoMainJS and (aFileWriter=nil) then
     begin
     begin
     // create CombinedFileWriter
     // create CombinedFileWriter
     aFileWriter:=CreateFileWriter(aFile,GetResolvedMainJSFile);
     aFileWriter:=CreateFileWriter(aFile,GetResolvedMainJSFile);
     InsertCustomJSFiles(aFileWriter);
     InsertCustomJSFiles(aFileWriter);
+    if FResources.OutputMode=romExtraJS then
+      aFileWriter.WriteFile(FResources.AsString,GetResolvedMainJSFile);
     end;
     end;
   Try
   Try
     // convert dependencies
     // convert dependencies
     CheckUsesClause(aFileWriter,aFile.GetPasMainUsesClause);
     CheckUsesClause(aFileWriter,aFile.GetPasMainUsesClause);
     CheckUsesClause(aFileWriter,aFile.GetPasImplUsesClause);
     CheckUsesClause(aFileWriter,aFile.GetPasImplUsesClause);
+
     // Write me...
     // Write me...
     WriteSingleJSFile(aFile,aFileWriter);
     WriteSingleJSFile(aFile,aFileWriter);
   finally
   finally
@@ -2879,6 +2971,15 @@ begin
   if aDir='' then ;
   if aDir='' then ;
 end;
 end;
 
 
+procedure TPas2jsCompiler.CreateResourceSupport;
+begin
+  Case FResourceMode of
+    rmNone : FResources:=TNoResources.Create(FS);
+    rmHTML : FResources:=THTMLResourceLinkHandler.Create(FS);
+    rmJS : FResources:=TJSResourceHandler.Create(FS);
+  end;
+end;
+
 procedure TPas2jsCompiler.Terminate(TheExitCode: integer);
 procedure TPas2jsCompiler.Terminate(TheExitCode: integer);
 begin
 begin
   ExitCode:=TheExitCode;
   ExitCode:=TheExitCode;
@@ -3442,6 +3543,27 @@ begin
     else
     else
       ParamFatal('invalid resource string file format (-Jr) "'+aValue+'"');
       ParamFatal('invalid resource string file format (-Jr) "'+aValue+'"');
     end;
     end;
+  'R': // -JR<...>
+    begin
+    I:=Pos('=',aValue);
+    if I=0 then
+      I:=Length(aValue)+1;
+    S:=Copy(aValue,1,I-1);
+    if S='' then
+      ParamFatal('missing value for -JR option')
+    else if (S='none') then
+      FResourceMode:=rmNone
+    else if (S='js') then
+      FResourceMode:= rmJS
+    else if (S='html') then
+      begin
+      FResourceMode:=rmHTML;
+      S:=Copy(aValue,I+1,Length(aValue)-I);
+      FResourceOutputFile:=S;
+      if (FResourceOutputFile<>'') and (ExtractFileExt(FResourceOutputFile)='') then
+        FResourceOutputFile:=FResourceOutputFile+'.html';
+      end;
+    end;
   'u': // -Ju<foreign path>
   'u': // -Ju<foreign path>
     if not Quick then
     if not Quick then
       begin
       begin
@@ -4028,6 +4150,7 @@ begin
 
 
   FFiles:=CreateSetOfCompilerFiles(kcFilename);
   FFiles:=CreateSetOfCompilerFiles(kcFilename);
   FUnits:=CreateSetOfCompilerFiles(kcUnitName);
   FUnits:=CreateSetOfCompilerFiles(kcUnitName);
+  FResourceMode:=DefaultResourceMode;
   FResourceStrings:=TResourceStringsFile.Create;
   FResourceStrings:=TResourceStringsFile.Create;
   FReadingModules:=TFPList.Create;
   FReadingModules:=TFPList.Create;
   InitParamMacros;
   InitParamMacros;
@@ -4323,6 +4446,9 @@ begin
     for i:=0 to ParamList.Count-1 do
     for i:=0 to ParamList.Count-1 do
       ReadParam(ParamList[i],false,true);
       ReadParam(ParamList[i],false,true);
 
 
+    // At this point we know what kind of resources we must use
+    CreateResourceSupport;
+
     // now we know, if the logo can be displayed
     // now we know, if the logo can be displayed
     if ShowLogo then
     if ShowLogo then
       WriteLogo;
       WriteLogo;
@@ -4514,6 +4640,10 @@ begin
   w('     -Jrnone: Do not write resource string file');
   w('     -Jrnone: Do not write resource string file');
   w('     -Jrunit: Write resource string file per unit with all resource strings');
   w('     -Jrunit: Write resource string file per unit with all resource strings');
   w('     -Jrprogram: Write resource string file per program with all used resource strings in program');
   w('     -Jrprogram: Write resource string file per program with all used resource strings in program');
+  w('   -Jr<x> Control writing of linked resources');
+  w('     -JRnone: Do not write resources');
+  w('     -JRjs: Write resources in Javascript structure');
+  w('     -JRhtml[=filename] : Write resources as preload links in HTML file (default is projectfile-res.html)');
   w('   -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.');
   w('   -Jpcmd<command>: Run postprocessor. For each generated js execute command passing the js as stdin and read the new js from stdout. This option can be added multiple times to call several postprocessors in succession.');
   w('   -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
   w('   -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
   WritePrecompiledFormats;
   WritePrecompiledFormats;
@@ -4809,6 +4939,7 @@ begin
     aPasTree.ParserLogEvents:=aPasTree.ParserLogEvents+[pleInterface,pleImplementation];
     aPasTree.ParserLogEvents:=aPasTree.ParserLogEvents+[pleInterface,pleImplementation];
 
 
   // scanner
   // scanner
+  aFile.ResourceHandler:=FResources;;
   aFile.CreateScannerAndParser(FS.CreateResolver);
   aFile.CreateScannerAndParser(FS.CreateResolver);
 
 
   if ShowDebug then
   if ShowDebug then

+ 48 - 0
packages/pastojs/src/pas2jsfilecache.pp

@@ -228,6 +228,7 @@ type
     FOnReadFile: TPas2jsReadFileEvent;
     FOnReadFile: TPas2jsReadFileEvent;
     FOnWriteFile: TPas2jsWriteFileEvent;
     FOnWriteFile: TPas2jsWriteFileEvent;
     FResetStamp: TChangeStamp;
     FResetStamp: TChangeStamp;
+    FResourcePaths: TStringList;
     FUnitPaths: TStringList;
     FUnitPaths: TStringList;
     FUnitPathsFromCmdLine: integer;
     FUnitPathsFromCmdLine: integer;
     FPCUPaths: TStringList;
     FPCUPaths: TStringList;
@@ -257,6 +258,7 @@ type
     function FindCustomJSFileName(const aFilename: string): String; override;
     function FindCustomJSFileName(const aFilename: string): String; override;
     function FindUnitJSFileName(const aUnitFilename: string): String; override;
     function FindUnitJSFileName(const aUnitFilename: string): String; override;
     function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
     function FindUnitFileName(const aUnitname, InFilename, ModuleDir: string; out IsForeign: boolean): String; override;
+    function FindResourceFileName(const aFilename, ModuleDir: string): String; override;
     function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
     function FindIncludeFileName(const aFilename, ModuleDir: string): String; override;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddIncludePaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
     function AddUnitPaths(const Paths: string; FromCmdLine: boolean; out ErrorMsg: string): boolean;
@@ -286,6 +288,7 @@ type
   public
   public
     property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
     property BaseDirectory: string read FBaseDirectory write SetBaseDirectory; // includes trailing pathdelim
     property ForeignUnitPaths: TStringList read FForeignUnitPaths;
     property ForeignUnitPaths: TStringList read FForeignUnitPaths;
+    property ResourcePaths : TStringList read FResourcePaths;
     property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
     property ForeignUnitPathsFromCmdLine: integer read FForeignUnitPathsFromCmdLine;
     property IncludePaths: TStringList read FIncludePaths;
     property IncludePaths: TStringList read FIncludePaths;
     property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine;
     property IncludePathsFromCmdLine: integer read FIncludePathsFromCmdLine;
@@ -1453,6 +1456,7 @@ begin
   FIncludePaths:=TStringList.Create;
   FIncludePaths:=TStringList.Create;
   FForeignUnitPaths:=TStringList.Create;
   FForeignUnitPaths:=TStringList.Create;
   FUnitPaths:=TStringList.Create;
   FUnitPaths:=TStringList.Create;
+  FResourcePaths:=TStringList.Create;
   FFiles:=TPasAnalyzerKeySet.Create(
   FFiles:=TPasAnalyzerKeySet.Create(
     {$IFDEF Pas2js}
     {$IFDEF Pas2js}
     @Pas2jsCachedFileToKeyName,@PtrFilenameToKeyName
     @Pas2jsCachedFileToKeyName,@PtrFilenameToKeyName
@@ -1977,6 +1981,50 @@ begin
   Result:='';
   Result:='';
 end;
 end;
 
 
+function TPas2jsFilesCache.FindResourceFileName(const aFilename, ModuleDir: string): String;
+
+var
+  SearchedDirs: TStringList;
+
+  function SearchInDir(Dir: string; var Filename: string): boolean;
+  // search in Dir for pp, pas, p times given case, lower case, upper case
+  begin
+    Dir:=IncludeTrailingPathDelimiter(Dir);
+    if IndexOfFile(SearchedDirs,Dir)>=0 then exit(false);
+    SearchedDirs.Add(Dir);
+    if SearchLowUpCase(Filename) then exit(true);
+    Result:=false;
+  end;
+
+var
+  i: Integer;
+
+begin
+  //writeln('TPas2jsFilesCache.FindUnitFileName "',aUnitname,'" ModuleDir="',ModuleDir,'"');
+  Result:='';
+  SearchedDirs:=TStringList.Create;
+  try
+    Result:=SetDirSeparators(aFilename);
+
+    // First search in ModuleDir
+    if SearchInDir(ModuleDir,Result) then
+      exit;
+
+    // Then in resource paths
+    for i:=0 to ResourcePaths.Count-1 do
+      if SearchInDir(ResourcePaths[i],Result) then
+        exit;
+    // Not sure
+    // finally search in unit paths
+    // for i:=0 to UnitPaths.Count-1 do
+    //  if SearchInDir(UnitPaths[i],Result) then exit;
+  finally
+    SearchedDirs.Free;
+  end;
+
+  Result:='';
+end;
+
 function TPas2jsFilesCache.FindUnitJSFileName(const aUnitFilename: string): String;
 function TPas2jsFilesCache.FindUnitJSFileName(const aUnitFilename: string): String;
 
 
 begin
 begin

+ 16 - 2
packages/pastojs/src/pas2jsfiler.pp

@@ -694,6 +694,7 @@ type
     procedure AddReferenceToArray(Arr: TJSONArray; El: TPasElement; WriteNull: boolean = true); virtual;
     procedure AddReferenceToArray(Arr: TJSONArray; El: TPasElement; WriteNull: boolean = true); virtual;
     procedure AddReferenceToObj(Obj: TJSONObject; const PropName: string;
     procedure AddReferenceToObj(Obj: TJSONObject; const PropName: string;
       El: TPasElement; WriteNil: boolean = false); virtual;
       El: TPasElement; WriteNil: boolean = false); virtual;
+    procedure CreateAutoElReferenceId(Ref: TPCUFilerElementRef); virtual;
     procedure CreateElReferenceId(Ref: TPCUFilerElementRef); virtual;
     procedure CreateElReferenceId(Ref: TPCUFilerElementRef); virtual;
     function CreateElementRef(El: TPasElement): TPCUFilerElementRef; override;
     function CreateElementRef(El: TPasElement): TPCUFilerElementRef; override;
     procedure AddedBuiltInRef(Ref: TPCUFilerElementRef); override;
     procedure AddedBuiltInRef(Ref: TPCUFilerElementRef); override;
@@ -2086,12 +2087,17 @@ begin
     end;
     end;
 end;
 end;
 
 
-procedure TPCUWriter.CreateElReferenceId(Ref: TPCUFilerElementRef);
+procedure TPCUWriter.CreateAutoElReferenceId(Ref: TPCUFilerElementRef);
 begin
 begin
   if Ref.Id<>0 then
   if Ref.Id<>0 then
     RaiseMsg(20180207114300,Ref.Element,IntToStr(Ref.Id));
     RaiseMsg(20180207114300,Ref.Element,IntToStr(Ref.Id));
   inc(FElementIdCounter);
   inc(FElementIdCounter);
   Ref.Id:=FElementIdCounter;
   Ref.Id:=FElementIdCounter;
+end;
+
+procedure TPCUWriter.CreateElReferenceId(Ref: TPCUFilerElementRef);
+begin
+  CreateAutoElReferenceId(Ref);
   Ref.Obj.Add('Id',Ref.Id);
   Ref.Obj.Add('Id',Ref.Id);
 end;
 end;
 
 
@@ -3528,6 +3534,7 @@ var
   ScopeIntf: TFPList;
   ScopeIntf: TFPList;
   o: TObject;
   o: TObject;
   SubObj: TJSONObject;
   SubObj: TJSONObject;
+  Ref: TPCUFilerElementRef;
 begin
 begin
   WriteIdentifierScope(Obj,Scope,aContext);
   WriteIdentifierScope(Obj,Scope,aContext);
   aClass:=Scope.Element as TPasClassType;
   aClass:=Scope.Element as TPasClassType;
@@ -3549,6 +3556,10 @@ begin
       RaiseMsg(20180217143857,aClass);
       RaiseMsg(20180217143857,aClass);
     if CanonicalClassOf.SourceLinenumber<>aClass.SourceLinenumber then
     if CanonicalClassOf.SourceLinenumber<>aClass.SourceLinenumber then
       RaiseMsg(20180217143905,aClass);
       RaiseMsg(20180217143905,aClass);
+    Ref:=GetElementReference(CanonicalClassOf);
+    CreateAutoElReferenceId(Ref);
+    Obj.Add('ClassOf',Ref.Id);
+    ResolvePendingElRefs(Ref);
     end
     end
   else if CanonicalClassOf<>nil then
   else if CanonicalClassOf<>nil then
     RaiseMsg(20180329110817,aClass,GetObjName(CanonicalClassOf));
     RaiseMsg(20180329110817,aClass,GetObjName(CanonicalClassOf));
@@ -7213,10 +7224,11 @@ procedure TPCUReader.ReadClassScope(Obj: TJSONObject; Scope: TPas2JSClassScope;
 var
 var
   aClass: TPasClassType;
   aClass: TPasClassType;
   CanonicalClassOf: TPasClassOfType;
   CanonicalClassOf: TPasClassOfType;
+  CanonicalClassOfId: integer;
 begin
 begin
   aClass:=Scope.Element as TPasClassType;
   aClass:=Scope.Element as TPasClassType;
 
 
-  if aClass.ObjKind=okClass then
+  if aClass.ObjKind in ([okClass]+okAllHelpers) then
     begin
     begin
     CanonicalClassOf:=TPasClassOfType(CreateElement(TPasClassOfType,'Self',aClass));
     CanonicalClassOf:=TPasClassOfType(CreateElement(TPasClassOfType,'Self',aClass));
     Scope.CanonicalClassOf:=CanonicalClassOf;
     Scope.CanonicalClassOf:=CanonicalClassOf;
@@ -7225,6 +7237,8 @@ begin
     CanonicalClassOf.SourceLinenumber:=aClass.SourceLinenumber;
     CanonicalClassOf.SourceLinenumber:=aClass.SourceLinenumber;
     CanonicalClassOf.DestType:=aClass;
     CanonicalClassOf.DestType:=aClass;
     aClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasClassScope.CanonicalClassOf'){$ENDIF};
     aClass.AddRef{$IFDEF CheckPasTreeRefCount}('TPasClassScope.CanonicalClassOf'){$ENDIF};
+    if ReadInteger(Obj,'ClassOf',CanonicalClassOfId,CanonicalClassOf) then
+      AddElReference(CanonicalClassOfId,CanonicalClassOf,CanonicalClassOf);
     end;
     end;
 
 
   ReadElementReference(Obj,Scope,'NewInstanceFunction',@Set_ClassScope_NewInstanceFunction);
   ReadElementReference(Obj,Scope,'NewInstanceFunction',@Set_ClassScope_NewInstanceFunction);

+ 8 - 0
packages/pastojs/src/pas2jsfs.pp

@@ -97,6 +97,7 @@ Type
     function FindSourceFileName(const aFilename: string): String; virtual; abstract;
     function FindSourceFileName(const aFilename: string): String; virtual; abstract;
   Public
   Public
     // Public Abstract. Must be overridden
     // Public Abstract. Must be overridden
+    function FindResourceFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
     function FindIncludeFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
     function FindIncludeFileName(const aFilename, ModuleDir: string): String; virtual; abstract;
     function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
     function LoadFile(Filename: string; Binary: boolean = false): TPas2jsFile; virtual; abstract;
     Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
     Function FileExists(Const aFileName: String): Boolean; virtual; abstract;
@@ -164,6 +165,7 @@ Type
   public
   public
     constructor Create(aFS: TPas2jsFS); reintroduce;
     constructor Create(aFS: TPas2jsFS); reintroduce;
     // Redirect all calls to FS.
     // Redirect all calls to FS.
+    function FindResourceFileName(const aFilename: string): String; override;
     function FindIncludeFileName(const aFilename: string): String; override;
     function FindIncludeFileName(const aFilename: string): String; override;
     function FindIncludeFile(const aFilename: string): TLineReader; override;
     function FindIncludeFile(const aFilename: string): TLineReader; override;
     function FindSourceFile(const aFilename: string): TLineReader; override;
     function FindSourceFile(const aFilename: string): TLineReader; override;
@@ -430,9 +432,15 @@ end;
 
 
 constructor TPas2jsFSResolver.Create(aFS: TPas2jsFS);
 constructor TPas2jsFSResolver.Create(aFS: TPas2jsFS);
 begin
 begin
+  Inherited Create;
   FFS:=aFS;
   FFS:=aFS;
 end;
 end;
 
 
+function TPas2jsFSResolver.FindResourceFileName(const aFilename: string): String;
+begin
+  Result:=FS.FindResourceFileName(aFilename,BaseDirectory);
+end;
+
 function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String;
 function TPas2jsFSResolver.FindIncludeFileName(const aFilename: string): String;
 
 
 begin
 begin

+ 111 - 0
packages/pastojs/src/pas2jshtmlresources.pp

@@ -0,0 +1,111 @@
+unit pas2jshtmlresources;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pas2jsResources, pas2jsFS;
+
+Type
+
+  { THTMLResourceLinkHandler }
+
+  THTMLResourceLinkHandler = Class(TPas2jsResourceHandler)
+  Private
+    FLinkType: string;
+    FPrefix: String;
+    FResources : tstrings;
+  Protected
+    function GetResourceCount: Integer; override;
+    function GetAsString: String; override;
+    Function CreateDataLink(Const aResourceName,aFormat,aData : String) : String;
+  Public
+    Constructor Create(aFS : TPas2JSFS); override;
+    Class Function OutputMode : TResourceOUtputMode; override;
+    Class Function OutputFileExtension : String; override;
+    Procedure HandleResource (aFileName : string; Options : TStrings); override;
+    Procedure ClearUnit; override;
+    Procedure DoneUnit(IsMainFile : Boolean); override;
+    destructor Destroy; override;
+    // ID is IDPrefix-resourcename. The default Prefix is 'resource'
+    Property IDPrefix : String Read FPrefix Write FPrefix;
+    Property LinkType : string Read FLinkType Write FLinkType;
+    Property Resources : TStrings Read FResources;
+  end;
+
+implementation
+
+{ THTMLResourceLinkHandler }
+
+function THTMLResourceLinkHandler.GetResourceCount: Integer;
+begin
+  Result:=FResources.Count;
+end;
+
+function THTMLResourceLinkHandler.GetAsString: String;
+begin
+  Result:=FResources.Text;
+end;
+
+function THTMLResourceLinkHandler.CreateDataLink(const aResourceName, aFormat, aData: String): String;
+begin
+  Result:=Format('<link rel="%s" as="script" id="%s-%s" data-unit="%s" href="data:%s;base64,%s" />',[linkType,IDPrefix,aResourceName,CurrentUnitName,aFormat,aData]);
+end;
+
+procedure THTMLResourceLinkHandler.HandleResource(aFileName: string; Options: TStrings);
+
+Var
+  S : String;
+  aFormat,ResourceName : String;
+
+
+begin
+  S:=GetFileAsBase64(aFileName);
+  aFormat:=GetFormat(aFileName,Options);
+  ResourceName:=Options.Values['name'];
+  if ResourceName='' then
+    ResourceName:=ChangeFileExt(ExtractFileName(aFileName),'');
+  Resources.Add(CreateDataLink(ResourceName,aFormat,S))
+end;
+
+constructor THTMLResourceLinkHandler.Create(aFS: TPas2JSFS);
+begin
+  inherited Create(aFS);
+  FResources:=TStringList.Create;
+  IDPrefix:='resource';
+  LinkType:='preload';
+end;
+
+class function THTMLResourceLinkHandler.OutputMode: TResourceOutputMode;
+begin
+  Result:=romFile;
+end;
+
+
+class function THTMLResourceLinkHandler.OutputFileExtension: String;
+begin
+  Result:='.html';
+end;
+
+procedure THTMLResourceLinkHandler.ClearUnit;
+begin
+  inherited ClearUnit;
+  FResources.Clear;
+end;
+
+procedure THTMLResourceLinkHandler.DoneUnit(IsMainFile : Boolean);
+begin
+  // Do no call inherited, it will clear the list
+  if IsMainFile then ;
+end;
+
+
+destructor THTMLResourceLinkHandler.Destroy;
+begin
+  FreeAndNil(FResources);
+  inherited Destroy;
+end;
+
+end.
+

+ 103 - 0
packages/pastojs/src/pas2jsjsresources.pp

@@ -0,0 +1,103 @@
+unit pas2jsjsresources;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pas2jsResources, pas2jsFS;
+
+Type
+
+  { TJSResourceLinkHandler }
+
+  { TJSResourceHandler }
+
+  TJSResourceHandler = Class(TPas2jsResourceHandler)
+  Private
+    FResources : TStrings;
+    function GetResourceJSStatement(aFileName: String; Options: TStrings): String;
+  Protected
+    function GetResourceCount: Integer; override;
+    function GetAsString: String; override;
+  Public
+    Constructor Create(aFS : TPas2JSFS); override;
+    Class Function OutputMode : TResourceOutputMode; override;
+    Class Function OutputFileExtension : String; override;
+    Procedure HandleResource (aFileName : string; Options : TStrings); override;
+    destructor Destroy; override;
+    Property Resources : TStrings Read FResources;
+  end;
+
+implementation
+
+{ TJSResourceHandler }
+
+function TJSResourceHandler.GetResourceCount: Integer;
+begin
+  Result:=FResources.Count;
+end;
+
+function TJSResourceHandler.GetAsString: String;
+
+Var
+  I : Integer;
+  N,V : String;
+
+begin
+  Result:='';
+  For I:=0 to FResources.Count-1 do
+    begin
+    FResources.GetNameValue(I,N,V);
+    Result:=Result+V+#10;
+    end;
+end;
+
+constructor TJSResourceHandler.Create(aFS: TPas2JSFS);
+begin
+  inherited Create(aFS);
+  FResources:=TStringList.Create;
+end;
+
+class function TJSResourceHandler.OutputMode: TResourceOutputMode;
+begin
+  Result:=romExtraJS;
+end;
+
+class function TJSResourceHandler.OutputFileExtension: String;
+begin
+  Result:='.js';
+end;
+
+Function TJSResourceHandler.GetResourceJSStatement(aFileName : String; Options: TStrings) : String;
+
+Const
+  SAddResource = 'rtl.addResource({name: "%s", unit: "%s", format: "%s", encoding: "base64", data: "%s"});';
+
+Var
+  aFormat,aName,aData : String;
+
+begin
+  aData:=GetFileAsBase64(aFileName);
+  aFormat:=GetFormat(aFileName,Options);
+  aName:=Options.Values['name'];
+  if aName='' then
+    aName:=ChangeFileExt(ExtractFileName(aFileName),'');
+  Result:=Format(SAddResource,[aName,CurrentUnitName,aFormat,aData]);
+end;
+
+procedure TJSResourceHandler.HandleResource(aFileName: string; Options: TStrings);
+begin
+  // PRepending unit name allows to extract easier all resources for a single unit
+  FResources.Add(CurrentUnitName+'='+GetResourceJSStatement(aFileName,Options));
+end;
+
+
+destructor TJSResourceHandler.Destroy;
+begin
+  FreeAndNil(FResources);
+  inherited Destroy;
+end;
+
+end.
+

+ 179 - 0
packages/pastojs/src/pas2jsresources.pp

@@ -0,0 +1,179 @@
+unit pas2jsresources;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, pas2jsfs, jsTree;
+
+Type
+  TResourceScopeMode = (rmProgram,rmUnit);
+
+  { TPas2jsResourceHandler }
+  TResourceOutputMode = (romNone,romJS,romFile,romExtraJS);
+  TPas2jsResourceHandler = class(TObject)
+  private
+    FCurrentUnitName: String;
+    FFS: TPas2JSFS;
+  Protected
+    // Must be overridden
+    function GetResourceCount: Integer; virtual; abstract;
+    // Content of file, if file based.
+    function GetAsString: String; virtual; abstract;
+    // Detect some common formats
+    Function GetFormat(const aFileName : string; aOptions : TStrings) : string; virtual;
+  Public
+    Constructor Create(aFS : TPas2JSFS); virtual;
+    // Called for every found resource
+    Procedure HandleResource (aFileName : string; Options : TStrings); virtual; abstract;
+    // Extension of output file, if file based
+    Class Function OutputFileExtension : String; virtual;
+    // True if output is file based (i.e. written to separate file)
+    Class Function OutputMode : TResourceOutputMode; virtual; abstract;
+    // Load resource file. Can be used in descendents
+    Function LoadFile(aFileName : string) : TPas2jsFile;
+    // Load resource file and encode as base64 string. Can be used in descendents
+    Function GetFileAsBase64(aFileName : string)  : string;
+    // This is called for every unit.
+    Procedure StartUnit(Const aUnitName : String); virtual;
+    // This is called at the start of every unit if OutputIsUnitBased is true.
+    Procedure ClearUnit; virtual;
+    // This is called at the end of every unit if OutputIsUnitBased is true. Only once if not.
+    Procedure DoneUnit(isMainFile : Boolean); virtual;
+    // This is called when Javascript is written for a unit
+    Function WriteJS(const aUnitName : String; aModule : TJSElement) : TJSElement; virtual;
+    // Current unit.
+    Property CurrentUnitName : String Read FCurrentUnitName;
+    // Passed at create
+    property FS : TPas2JSFS Read FFS;
+    // Return file content for writing to file if IsFileBased
+    Property AsString : String Read GetAsString;
+    // Number of resources
+    Property ResourceCount : Integer Read GetResourceCount;
+  end;
+
+  { TNoResources }
+
+  TNoResources = Class(TPas2jsResourceHandler)
+  Public
+    Procedure HandleResource (aFileName : string; Options : TStrings); override;
+    Class Function OutputMode : TResourceOutputMode; override;
+    function GetResourceCount: Integer; override;
+    function GetAsString: String; override;
+  end;
+implementation
+
+{$IFNDEF PAS2JS}
+uses base64;
+
+{ TNoResources }
+
+procedure TNoResources.HandleResource(aFileName: string; Options: TStrings);
+begin
+  // Do nothing
+  if aFileName='' then ;
+  if Options=nil then ;
+end;
+
+
+class function TNoResources.OutputMode: TResourceOutputMode;
+begin
+  result:=romNone;
+end;
+
+function TNoResources.GetResourceCount: Integer;
+begin
+  Result:=0;
+end;
+
+function TNoResources.GetAsString: String;
+begin
+  Result:='';
+end;
+
+{$ENDIF}
+
+{ TPas2jsResourceHandler }
+
+
+function TPas2jsResourceHandler.GetFormat(const aFileName: string; aOptions: TStrings): string;
+
+Var
+  E : String;
+
+begin
+  Result:=aOptions.Values['format'];
+  if Result='' then
+    begin
+    E:=ExtractFileExt(aFileName);
+    if (E<>'') and (E[1]='.') then
+      E:=Copy(E,2,Length(E)-1);
+    if Pos(LowerCase(E),';png;jpg;jpeg;bmp;ico;')>0 then
+      Result:='image/'+E
+    else if Pos(LowerCase(E),';htm;html;')>0 then
+      Result:='text/html'
+    else if Pos(LowerCase(E),';txt;lpr;pas;pp;')>0 then
+      Result:='text/text'
+    else if Pos(LowerCase(E),';js;')>0 then
+      Result:='application/javascript'
+    else if Pos(LowerCase(E),';json;')>0 then
+      Result:='application/javascript'
+    else
+      Result:='application/octet-stream';
+    end;
+end;
+
+constructor TPas2jsResourceHandler.Create(aFS: TPas2JSFS);
+begin
+  FFS:=aFS;
+end;
+
+
+class function TPas2jsResourceHandler.OutputFileExtension: String;
+begin
+  Result:='';
+end;
+
+
+function TPas2jsResourceHandler.LoadFile(aFileName: string): TPas2jsFile;
+begin
+  Result:=FS.LoadFile(aFileName,True);
+end;
+
+function TPas2jsResourceHandler.GetFileAsBase64(aFileName: string): string;
+
+Var
+  F : TPas2JSFile;
+
+begin
+  F:=LoadFile(aFileName);
+  Result:=EncodeStringBase64(F.Source);
+  // Do not release, FS will release all files
+end;
+
+procedure TPas2jsResourceHandler.ClearUnit;
+begin
+  FCurrentUnitName:='';
+end;
+
+procedure TPas2jsResourceHandler.StartUnit(const aUnitName: String);
+begin
+  FCurrentUnitName:=aUnitName;
+end;
+
+procedure TPas2jsResourceHandler.DoneUnit(isMainFile: Boolean);
+begin
+  if not isMainFile then
+    ClearUnit;
+end;
+
+function TPas2jsResourceHandler.WriteJS(const aUnitName: String; aModule: TJSElement): TJSElement;
+begin
+  Result:=aModule;
+  if aUnitName='' then ;
+end;
+
+
+end.
+

+ 763 - 8
packages/pastojs/tests/tcgenerics.pas

@@ -16,14 +16,23 @@ type
   Published
   Published
     // generic record
     // generic record
     Procedure TestGen_RecordEmpty;
     Procedure TestGen_RecordEmpty;
+    Procedure TestGen_Record_ClassProc_ObjFPC;
+    //Procedure TestGen_Record_ClassProc_Delphi;
+    //Procedure TestGen_Record_ReferGenClass_DelphiFail;
 
 
     // generic class
     // generic class
     Procedure TestGen_ClassEmpty;
     Procedure TestGen_ClassEmpty;
     Procedure TestGen_Class_EmptyMethod;
     Procedure TestGen_Class_EmptyMethod;
     Procedure TestGen_Class_TList;
     Procedure TestGen_Class_TList;
+    Procedure TestGen_Class_TCustomList;
     Procedure TestGen_ClassAncestor;
     Procedure TestGen_ClassAncestor;
-    Procedure TestGen_TypeInfo;
-    // ToDo: TBird, TBird<T>, TBird<S,T>
+    Procedure TestGen_Class_TypeInfo;
+    Procedure TestGen_Class_TypeOverload; // ToDo TBird, TBird<T>, TBird<S,T>
+    Procedure TestGen_Class_ClassProperty;
+    Procedure TestGen_Class_ClassProc_ObjFPC;
+    //Procedure TestGen_Class_ClassProc_Delphi;
+    //Procedure TestGen_Class_ReferGenClass_DelphiFail;
+    Procedure TestGen_Class_ClassConstructor;
     // ToDo: rename local const T
     // ToDo: rename local const T
 
 
     // generic external class
     // generic external class
@@ -33,15 +42,24 @@ type
     Procedure TestGen_InlineSpec_Constructor;
     Procedure TestGen_InlineSpec_Constructor;
     Procedure TestGen_CallUnitImplProc;
     Procedure TestGen_CallUnitImplProc;
     Procedure TestGen_IntAssignTemplVar;
     Procedure TestGen_IntAssignTemplVar;
-    // ToDo: TBird<word>(o).field:=3;
+    Procedure TestGen_TypeCastDotField;
 
 
     // generic helper
     // generic helper
-    // ToDo: helper for gen array: TArray<word>.Fly(aword);
+    procedure TestGen_HelperForArray;
 
 
     // generic functions
     // generic functions
-    // ToDo: Fly<word>(3);
-    // ToDo: TestGenProc_ProcT
-    // ToDo: inference Fly(3);
+    procedure TestGenProc_Function_ObjFPC;
+    procedure TestGenProc_Function_Delphi;
+    procedure TestGenProc_Overload;
+    procedure TestGenProc_Forward;
+    procedure TestGenProc_Infer_OverloadForward;
+    procedure TestGenProc_TypeInfo;
+    procedure TestGenProc_Infer_Widen;
+    procedure TestGenProc_Infer_PassAsArg;
+    // ToDo: FuncName:=
+
+    // generic methods
+    procedure TestGenMethod_ObjFPC;
   end;
   end;
 
 
 implementation
 implementation
@@ -77,6 +95,56 @@ begin
     ]));
     ]));
 end;
 end;
 
 
+procedure TTestGenerics.TestGen_Record_ClassProc_ObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch AdvancedRecords}',
+  'type',
+  '  generic TPoint<T> = record',
+  '    class var x: T;',
+  '    class procedure Fly; static;',
+  '  end;',
+  'class procedure Tpoint.Fly;',
+  'begin',
+  '  x:=x+3;',
+  '  tpoint.x:=tpoint.x+4;',
+  '  Fly;',
+  '  tpoint.Fly;',
+  'end;',
+  'var p: specialize TPoint<word>;',
+  'begin',
+  '  p.x:=p.x+10;',
+  '  p.Fly;',
+  '  p.Fly();',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Record_ClassProc',
+    LinesToStr([ // statements
+    'rtl.recNewT($mod, "TPoint$G1", function () {',
+    '  this.x = 0;',
+    '  this.$eq = function (b) {',
+    '    return true;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    return this;',
+    '  };',
+    '  this.Fly = function () {',
+    '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 3;',
+    '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 4;',
+    '    $mod.TPoint$G1.Fly();',
+    '    $mod.TPoint$G1.Fly();',
+    '  };',
+    '}, true);',
+    'this.p = $mod.TPoint$G1.$new();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.TPoint$G1.x = $mod.p.x + 10;',
+    '$mod.p.Fly();',
+    '$mod.p.Fly();',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ClassEmpty;
 procedure TTestGenerics.TestGen_ClassEmpty;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -222,6 +290,62 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestGenerics.TestGen_Class_TCustomList;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TCustomList<T> = class',
+  '  public',
+  '    function PrepareAddingItem: word; virtual;',
+  '  end;',
+  '  TList<T> = class(TCustomList<T>)',
+  '  public',
+  '    function Add: word;',
+  '  end;',
+  '  TWordList = TList<word>;',
+  'function TCustomList<T>.PrepareAddingItem: word;',
+  'begin',
+  'end;',
+  'function TList<T>.Add: word;',
+  'begin',
+  '  Result:=PrepareAddingItem;',
+  //'  Result:=Self.PrepareAddingItem;',
+  //'  with Self do Result:=PrepareAddingItem;',
+  'end;',
+  'var l: TWordList;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_TCustomList',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TCustomList$G2", $mod.TObject, function () {',
+    '  this.PrepareAddingItem = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TList$G1", $mod.TCustomList$G2, function () {',
+    '  this.Add = function () {',
+    '    var Result = 0;',
+    '    Result = this.PrepareAddingItem();',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.l = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ClassAncestor;
 procedure TTestGenerics.TestGen_ClassAncestor;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -254,7 +378,7 @@ begin
     '']));
     '']));
 end;
 end;
 
 
-procedure TTestGenerics.TestGen_TypeInfo;
+procedure TTestGenerics.TestGen_Class_TypeInfo;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   StartProgram(false);
   StartProgram(false);
@@ -299,6 +423,211 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestGenerics.TestGen_Class_TypeOverload;
+begin
+  exit;// ToDo
+
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird = word;',
+  '  TBird<T> = class',
+  '    m: T;',
+  '  end;',
+  '  TEagle = TBird<word>;',
+  'var',
+  '  b: TBird<word>;',
+  '  e: TEagle;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_TypeOverload',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_Class_ClassProperty;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class',
+  '  private',
+  '    class var fSize: T;',
+  '  public',
+  '    class property Size: T read fSize write fSize;',
+  '  end;',
+  '  TEagle = TBird<word>;',
+  'begin',
+  '  TBird<word>.Size:=3+TBird<word>.Size;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_ClassProperty',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.fSize = 0;',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.TBird$G1.fSize = 3 + $mod.TBird$G1.fSize;',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_Class_ClassProc_ObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TPoint<T> = class',
+  '    class var x: T;',
+  '    class procedure Fly; static;',
+  '    class procedure Run;',
+  '  end;',
+  'class procedure Tpoint.Fly;',
+  'begin',
+  '  x:=x+3;',
+  '  tpoint.x:=tpoint.x+4;',
+  '  Fly;',
+  '  tpoint.Fly;',
+  '  Run;',
+  '  tpoint.Run;',
+  'end;',
+  'class procedure TPoint.Run;',
+  'begin',
+  '  x:=x+5;',
+  '  tpoint.x:=tpoint.x+6;',
+  '  Fly;',
+  '  tpoint.Fly;',
+  '  Run;',
+  '  tpoint.Run;',
+  'end;',
+  'var p: specialize TPoint<word>;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_ClassProc',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TPoint$G1", $mod.TObject, function () {',
+    '  this.x = 0;',
+    '  this.Fly = function () {',
+    '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 3;',
+    '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 4;',
+    '    $mod.TPoint$G1.Fly();',
+    '    $mod.TPoint$G1.Fly();',
+    '    $mod.TPoint$G1.Run();',
+    '    $mod.TPoint$G1.Run();',
+    '  };',
+    '  this.Run = function () {',
+    '    $mod.TPoint$G1.x = this.x + 5;',
+    '    $mod.TPoint$G1.x = $mod.TPoint$G1.x + 6;',
+    '    this.Fly();',
+    '    $mod.TPoint$G1.Fly();',
+    '    this.Run();',
+    '    $mod.TPoint$G1.Run();',
+    '  };',
+    '});',
+    'this.p = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_Class_ClassConstructor;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TPoint<T> = class',
+  '    class var x: T;',
+  '    class procedure Fly; static;',
+  '    class constructor Init;',
+  '  end;',
+  'var count: word;',
+  'class procedure Tpoint.Fly;',
+  'begin',
+  'end;',
+  'class constructor tpoint.init;',
+  'begin',
+  '  count:=count+1;',
+  '  x:=3;',
+  '  tpoint.x:=4;',
+  '  fly;',
+  '  tpoint.fly;',
+  'end;',
+  'var',
+  '  r: specialize TPoint<word>;',
+  '  s: specialize TPoint<smallint>;',
+  'begin',
+  '  r.x:=10;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_ClassConstructor',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TPoint$G1", $mod.TObject, function () {',
+    '  this.x = 0;',
+    '  this.Fly = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TPoint$G2", $mod.TObject, function () {',
+    '  this.x = 0;',
+    '  this.Fly = function () {',
+    '  };',
+    '});',
+    'this.count = 0;',
+    'this.r = null;',
+    'this.s = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '(function () {',
+    '  $mod.count = $mod.count + 1;',
+    '  $mod.TPoint$G1.x = 3;',
+    '  $mod.TPoint$G1.x = 4;',
+    '  $mod.TPoint$G1.Fly();',
+    '  $mod.TPoint$G1.Fly();',
+    '})();',
+    '(function () {',
+    '  $mod.count = $mod.count + 1;',
+    '  $mod.TPoint$G2.x = 3;',
+    '  $mod.TPoint$G2.x = 4;',
+    '  $mod.TPoint$G2.Fly();',
+    '  $mod.TPoint$G2.Fly();',
+    '})();',
+    '$mod.TPoint$G1.x = 10;',
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -493,6 +822,432 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestGenerics.TestGen_TypeCastDotField;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  generic TBird<T> = class',
+  '    Field: T;',
+  '    procedure Fly;',
+  '  end;',
+  'var',
+  '  o: TObject;',
+  '  b: specialize TBird<word>;',
+  'procedure TBird.Fly;',
+  'begin',
+  '  specialize TBird<word>(o).Field:=3;',
+  '  if 4=specialize TBird<word>(o).Field then ;',
+  'end;',
+  'begin',
+  '  specialize TBird<word>(o).Field:=5;',
+  '  if 6=specialize TBird<word>(o).Field then ;',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_TypeCastDotField',
+    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.Field = 0;',
+    '  };',
+    '  this.Fly = function () {',
+    '    $mod.o.Field = 3;',
+    '    if (4 === $mod.o.Field) ;',
+    '  };',
+    '});',
+    'this.o = null;',
+    'this.b = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.o.Field = 5;',
+    'if (6 === $mod.o.Field) ;',
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_HelperForArray;
+begin
+  StartProgram(false);
+  Add([
+  '{$ModeSwitch typehelpers}',
+  'type',
+  '  generic TArr<T> = array[1..2] of T;',
+  '  TWordArrHelper = type helper for specialize TArr<word>',
+  '    procedure Fly(w: word);',
+  '  end;',
+  'procedure TWordArrHelper.Fly(w: word);',
+  'begin',
+  'end;',
+  'var',
+  '  a: specialize TArr<word>;',
+  'begin',
+  '  a.Fly(3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_HelperForArray',
+    LinesToStr([ // statements
+    'rtl.createHelper($mod, "TWordArrHelper", null, function () {',
+    '  this.Fly = function (w) {',
+    '  };',
+    '});',
+    'this.a = rtl.arraySetLength(null, 0, 2);',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.TWordArrHelper.Fly.call({',
+    '  p: $mod,',
+    '  get: function () {',
+    '      return this.p.a;',
+    '    },',
+    '  set: function (v) {',
+    '      this.p.a = v;',
+    '    }',
+    '}, 3);',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_Function_ObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  'generic function Run<T>(a: T): T;',
+  'var i: T;',
+  'begin',
+  '  a:=i;',
+  '  Result:=a;',
+  'end;',
+  'var w: word;',
+  'begin',
+  '  w:=specialize Run<word>(3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_Function_ObjFPC',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a) {',
+    '  var Result = 0;',
+    '  var i = 0;',
+    '  a = i;',
+    '  Result = a;',
+    '  return Result;',
+    '};',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.w = $mod.Run$s0(3);',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_Function_Delphi;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'function Run<T>(a: T): T;',
+  'var i: T;',
+  'begin',
+  '  a:=i;',
+  '  Result:=a;',
+  'end;',
+  'var w: word;',
+  'begin',
+  '  w:=Run<word>(3);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_Function_Delphi',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a) {',
+    '  var Result = 0;',
+    '  var i = 0;',
+    '  a = i;',
+    '  Result = a;',
+    '  return Result;',
+    '};',
+    'this.w = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.w = $mod.Run$s0(3);',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_Overload;
+begin
+  StartProgram(false);
+  Add([
+  'generic procedure DoIt<T>(a: T; w: word); overload;',
+  'begin',
+  'end;',
+  'generic procedure DoIt<T>(a: T; b: boolean); overload;',
+  'begin',
+  'end;',
+  'begin',
+  '  specialize DoIt<word>(3,4);',
+  '  specialize DoIt<boolean>(false,5);',
+  '  specialize DoIt<word>(6,true);',
+  '  specialize DoIt<double>(7.3,true);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_Overload',
+    LinesToStr([ // statements
+    'this.DoIt$s0 = function (a, w) {',
+    '};',
+    'this.DoIt$s1 = function (a, w) {',
+    '};',
+    'this.DoIt$1s0 = function (a, b) {',
+    '};',
+    'this.DoIt$1s1 = function (a, b) {',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.DoIt$s0(3, 4);',
+    '$mod.DoIt$s1(false, 5);',
+    '$mod.DoIt$1s0(6, true);',
+    '$mod.DoIt$1s1(7.3, true);',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_Forward;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<S>(a: S; b: boolean); forward;',
+  'procedure Run<S>(a: S; b: boolean);',
+  'begin',
+  '  Run<word>(1,true);',
+  'end;',
+  'begin',
+  '  Run(1.3,true);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_infer_OverloadForward',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a, b) {',
+    '  $mod.Run$s0(1, true);',
+    '};',
+    'this.Run$s1 = function (a, b) {',
+    '  $mod.Run$s0(1, true);',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Run$s1(1.3, true);',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_Infer_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'');',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_infer_OverloadForward',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a, b) {',
+    '  $mod.Run$s0(1, true);',
+    '  $mod.Run$1s0(2, 3);',
+    '  $mod.Run$2s0("foo", "bar");',
+    '};',
+    'this.Run$1s0 = function (a, w) {',
+    '};',
+    'this.Run$2s0 = function (a, b) {',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Run$s0(1, true);',
+    '$mod.Run$1s0(2, 3);',
+    '$mod.Run$2s0("foo", "bar");',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_TypeInfo;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(true,[supTypeInfo]);
+  Add([
+  '{$modeswitch implicitfunctionspecialization}',
+  'generic procedure Run<S>(a: S);',
+  'var',
+  '  p: TTypeInfo;',
+  'begin',
+  '  p:=TypeInfo(S);',
+  '  p:=TypeInfo(a);',
+  'end;',
+  'begin',
+  '  Run(word(3));',
+  '  Run(''foo'');',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_TypeInfo',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a) {',
+    '  var p = null;',
+    '  p = rtl.word;',
+    '  p = rtl.word;',
+    '};',
+    'this.Run$s1 = function (a) {',
+    '  var p = null;',
+    '  p = rtl.string;',
+    '  p = rtl.string;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Run$s0(3);',
+    '$mod.Run$s1("foo");',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_Infer_Widen;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<S>(a: S; b: S);',
+  'begin',
+  'end;',
+  'begin',
+  '  Run(word(1),longint(2));',
+  '  Run(byte(2),smallint(2));',
+  '  Run(longword(3),longint(2));',
+  '  Run(nativeint(4),longint(2));',
+  '  Run(nativeint(5),nativeuint(2));',
+  '  Run(''a'',''foo'');',
+  '  Run(''bar'',''c'');',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_Infer_Widen',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a, b) {',
+    '};',
+    'this.Run$s1 = function (a, b) {',
+    '};',
+    'this.Run$s2 = function (a, b) {',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Run$s0(1, 2);',
+    '$mod.Run$s0(2, 2);',
+    '$mod.Run$s1(3, 2);',
+    '$mod.Run$s1(4, 2);',
+    '$mod.Run$s1(5, 2);',
+    '$mod.Run$s2("a", "foo");',
+    '$mod.Run$s2("bar", "c");',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenProc_Infer_PassAsArg;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'function Run<T>(a: T): T;',
+  'var b: T;',
+  'begin',
+  '  Run(Run<word>(3));',
+  '  Run(Run(word(4)));',
+  'end;',
+  'begin',
+  '  Run(Run<word>(5));',
+  '  Run(Run(word(6)));',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenProc_Infer_PassAsArg',
+    LinesToStr([ // statements
+    'this.Run$s0 = function (a) {',
+    '  var Result = 0;',
+    '  var b = 0;',
+    '  $mod.Run$s0($mod.Run$s0(3));',
+    '  $mod.Run$s0($mod.Run$s0(4));',
+    '  return Result;',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.Run$s0($mod.Run$s0(5));',
+    '$mod.Run$s0($mod.Run$s0(6));',
+    '']));
+end;
+
+procedure TTestGenerics.TestGenMethod_ObjFPC;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode objfpc}',
+  '{$ModeSwitch implicitfunctionspecialization}',
+  'type',
+  '  TObject = class',
+  '    generic procedure {#A}Run<S>(a: S; b: boolean); overload;',
+  '    generic procedure {#B}Run<T>(a: T; w: word); overload;',
+  '    generic procedure {#C}Run<U>(a: U; b: U); overload;',
+  '  end; ',
+  'generic procedure {#A2}TObject.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;',
+  'generic procedure {#B2}TObject.Run<T>(a: T; w: word); overload;',
+  'begin',
+  'end;',
+  'generic procedure {#C2}TObject.Run<U>(a: U; b: U); overload;',
+  'begin',
+  'end;',
+  'var o: TObject;',
+  'begin',
+  '  o.{@A}Run(1,true);', // non generic take precedence
+  '  o.{@B}Run(2,word(3));', // non generic take precedence
+  '  o.{@C}Run(''foo'',''bar'');',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGenMethod_ObjFPC',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.Run$s0 = function (a, b) {',
+    '    this.Run$s0(1, true);',
+    '    this.Run$1s0(2, 3);',
+    '    this.Run$2s0("foo", "bar");',
+    '  };',
+    '  this.Run$1s0 = function (a, w) {',
+    '  };',
+    '  this.Run$2s0 = function (a, b) {',
+    '  };',
+    '});',
+    'this.o = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.o.Run$s0(1, true);',
+    '$mod.o.Run$1s0(2, 3);',
+    '$mod.o.Run$2s0("foo", "bar");',
+    '']));
+end;
+
 Initialization
 Initialization
   RegisterTests([TTestGenerics]);
   RegisterTests([TTestGenerics]);
 end.
 end.

+ 136 - 56
packages/pastojs/tests/tcmodules.pas

@@ -51,7 +51,8 @@ type
 
 
   TSystemUnitPart = (
   TSystemUnitPart = (
     supTObject,
     supTObject,
-    supTVarRec
+    supTVarRec,
+    supTypeInfo
     );
     );
   TSystemUnitParts = set of TSystemUnitPart;
   TSystemUnitParts = set of TSystemUnitPart;
 
 
@@ -588,6 +589,7 @@ type
     Procedure TestExternalClass_FuncClassOf_New;
     Procedure TestExternalClass_FuncClassOf_New;
     Procedure TestExternalClass_New_PasClassFail;
     Procedure TestExternalClass_New_PasClassFail;
     Procedure TestExternalClass_New_PasClassBracketsFail;
     Procedure TestExternalClass_New_PasClassBracketsFail;
+    Procedure TestExternalClass_NewExtName;
     Procedure TestExternalClass_Constructor;
     Procedure TestExternalClass_Constructor;
     Procedure TestExternalClass_ConstructorBrackets;
     Procedure TestExternalClass_ConstructorBrackets;
     Procedure TestExternalClass_LocalConstSameName;
     Procedure TestExternalClass_LocalConstSameName;
@@ -815,6 +817,7 @@ type
     Procedure TestRTTI_Interface_Corba;
     Procedure TestRTTI_Interface_Corba;
     Procedure TestRTTI_Interface_COM;
     Procedure TestRTTI_Interface_COM;
     Procedure TestRTTI_ClassHelper;
     Procedure TestRTTI_ClassHelper;
+    Procedure TestRTTI_ExternalClass;
 
 
     // Resourcestring
     // Resourcestring
     Procedure TestResourcestringProgram;
     Procedure TestResourcestringProgram;
@@ -1556,7 +1559,7 @@ var
 begin
 begin
   Intf:=TStringList.Create;
   Intf:=TStringList.Create;
   // interface
   // interface
-  if supTVarRec in Parts then
+  if [supTVarRec,supTypeInfo]*Parts<>[] then
     Intf.Add('{$modeswitch externalclass}');
     Intf.Add('{$modeswitch externalclass}');
   Intf.Add('type');
   Intf.Add('type');
   Intf.Add('  integer=longint;');
   Intf.Add('  integer=longint;');
@@ -1602,6 +1605,28 @@ begin
     '  TVarRecArray = array of TVarRec;',
     '  TVarRecArray = array of TVarRec;',
     'function VarRecs: TVarRecArray; varargs;',
     'function VarRecs: TVarRecArray; varargs;',
     '']);
     '']);
+  if supTypeInfo in Parts then
+    begin
+    Intf.AddStrings([
+    'type',
+    '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
+    '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
+    '  end;',
+    '  TTypeInfoEnum = class external name ''rtl.tTypeInfoEnum''(TTypeInfoInteger) end;',
+    '  TTypeInfoSet = class external name ''rtl.tTypeInfoSet''(TTypeInfo) end;',
+    '  TTypeInfoStaticArray = class external name ''rtl.tTypeInfoStaticArray''(TTypeInfo) end;',
+    '  TTypeInfoDynArray = class external name ''rtl.tTypeInfoDynArray''(TTypeInfo) end;',
+    '  TTypeInfoProcVar = class external name ''rtl.tTypeInfoProcVar''(TTypeInfo) end;',
+    '  TTypeInfoMethodVar = class external name ''rtl.tTypeInfoMethodVar''(TTypeInfoProcVar) end;',
+    '  TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;',
+    '  TTypeInfoClassRef = class external name ''rtl.tTypeInfoClassRef''(TTypeInfo) end;',
+    '  TTypeInfoExtClass = class external name ''rtl.tTypeInfoExtClass''(TTypeInfo) end;',
+    '  TTypeInfoRecord = class external name ''rtl.tTypeInfoRecord''(TTypeInfo) end;',
+    '  TTypeInfoPointer = class external name ''rtl.tTypeInfoPointer''(TTypeInfo) end;',
+    '  TTypeInfoHelper = class external name ''rtl.tTypeInfoHelper''(TTypeInfo) end;',
+    '  TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
+    '']);
+    end;
   Intf.Add('var');
   Intf.Add('var');
   Intf.Add('  ExitCode: Longint = 0;');
   Intf.Add('  ExitCode: Longint = 0;');
 
 
@@ -2442,8 +2467,9 @@ begin
   StartProgram(false);
   StartProgram(false);
   Add('{$modeswitch cblocks-}');
   Add('{$modeswitch cblocks-}');
   Add('begin');
   Add('begin');
-  SetExpectedScannerError('Invalid mode switch: "cblocks-"',nErrInvalidModeSwitch);
   ConvertProgram;
   ConvertProgram;
+  CheckHint(mtWarning,nErrInvalidModeSwitch,'Warning: test1.pp(3,23) : Invalid mode switch: "cblocks"');
+  CheckResolverUnexpectedHints();
 end;
 end;
 
 
 procedure TTestModule.TestUnit_UseSystem;
 procedure TTestModule.TestUnit_UseSystem;
@@ -11081,14 +11107,14 @@ begin
     '  };',
     '  };',
     '  this.GetInt = function () {',
     '  this.GetInt = function () {',
     '    var Result = 0;',
     '    var Result = 0;',
-    '    Result = this.Fx;',
+    '    Result = $mod.TRec.Fx;',
     '    return Result;',
     '    return Result;',
     '  };',
     '  };',
     '  this.SetInt = function (Value) {',
     '  this.SetInt = function (Value) {',
     '  };',
     '  };',
     '  this.DoIt = function () {',
     '  this.DoIt = function () {',
-    '    $mod.TRec.Fy = this.Fx + 1;',
-    '    this.SetInt(this.GetInt() + 1);',
+    '    $mod.TRec.Fy = $mod.TRec.Fx + 1;',
+    '    $mod.TRec.SetInt($mod.TRec.GetInt() + 1);',
     '  };',
     '  };',
     '}, true);',
     '}, true);',
     'this.r = $mod.TRec.$new();',
     'this.r = $mod.TRec.$new();',
@@ -11318,7 +11344,7 @@ begin
     '      $mod.TRec.TPoint.Count = this.Count + 3;',
     '      $mod.TRec.TPoint.Count = this.Count + 3;',
     '    };',
     '    };',
     '    this.DoThat = function () {',
     '    this.DoThat = function () {',
-    '      $mod.TRec.TPoint.Count = this.Count + 4;',
+    '      $mod.TRec.TPoint.Count = $mod.TRec.TPoint.Count + 4;',
     '    };',
     '    };',
     '  }, true);',
     '  }, true);',
     '  this.i = 0;',
     '  this.i = 0;',
@@ -11514,14 +11540,16 @@ begin
   'class constructor tpoint.init;',
   'class constructor tpoint.init;',
   'begin',
   'begin',
   '  count:=count+1;',
   '  count:=count+1;',
-  '  x:=3;',
-  '  tpoint.x:=4;',
+  '  x:=x+3;',
+  '  tpoint.x:=tpoint.x+4;',
   '  fly;',
   '  fly;',
   '  tpoint.fly;',
   '  tpoint.fly;',
   'end;',
   'end;',
   'var r: TPoint;',
   'var r: TPoint;',
   'begin',
   'begin',
-  '  r.x:=10;',
+  '  r.x:=r.x+10;',
+  '  r.Fly;',
+  '  r.Fly();',
   '']);
   '']);
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestAdvRecord_ClassConstructor_Program',
   CheckSource('TestAdvRecord_ClassConstructor_Program',
@@ -11543,12 +11571,14 @@ begin
     LinesToStr([ // $mod.$main
     LinesToStr([ // $mod.$main
     '(function () {',
     '(function () {',
     '  $mod.count = $mod.count + 1;',
     '  $mod.count = $mod.count + 1;',
-    '  $mod.TPoint.x = 3;',
-    '  $mod.TPoint.x = 4;',
+    '  $mod.TPoint.x = $mod.TPoint.x + 3;',
+    '  $mod.TPoint.x = $mod.TPoint.x + 4;',
     '  $mod.TPoint.Fly();',
     '  $mod.TPoint.Fly();',
     '  $mod.TPoint.Fly();',
     '  $mod.TPoint.Fly();',
     '})();',
     '})();',
-    '$mod.TPoint.x = 10;',
+    '$mod.TPoint.x = $mod.r.x + 10;',
+    '$mod.r.Fly();',
+    '$mod.r.Fly();',
     '']));
     '']));
 end;
 end;
 
 
@@ -16536,6 +16566,51 @@ begin
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 
+procedure TTestModule.TestExternalClass_NewExtName;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TExtA = class external name ''ExtA''',
+  '    constructor New; external name ''Other'';',
+  '    constructor New(i: longint; j: longint = 2); external name ''A.B'';',
+  '  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_NewExtName',
+    LinesToStr([ // statements
+    'this.A = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.A = new Other();',
+    '$mod.A = new Other();',
+    '$mod.A = new Other();',
+    '$mod.A = new A.B(1,2);',
+    '$mod.A = new Other();',
+    '$mod.A = new Other();',
+    '$mod.A = new A.B(2,2);',
+    '$mod.A = new Other();',
+    '$mod.A = new Other();',
+    '$mod.A = new A.B(3,2);',
+    '']));
+end;
+
 procedure TTestModule.TestExternalClass_Constructor;
 procedure TTestModule.TestExternalClass_Constructor;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -18192,13 +18267,13 @@ begin
     '        return this.FBirdIntf;',
     '        return this.FBirdIntf;',
     '      },',
     '      },',
     '    "{489289DE-FDE2-34A6-8288-39119022B1B4}": function () {',
     '    "{489289DE-FDE2-34A6-8288-39119022B1B4}": function () {',
-    '        return this.$class.GetEagleIntf();',
+    '        return this.GetEagleIntf();',
     '      },',
     '      },',
     '    "{489289DE-FDE2-34A6-8288-39118EF16074}": function () {',
     '    "{489289DE-FDE2-34A6-8288-39118EF16074}": function () {',
     '        return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
     '        return rtl.getIntfT(this.FDoveObj, $mod.IDove);',
     '      },',
     '      },',
     '    "{B89289DE-FDE2-34A6-8288-3911CBDCB359}": function () {',
     '    "{B89289DE-FDE2-34A6-8288-3911CBDCB359}": function () {',
-    '        return rtl.getIntfT(this.$class.GetSwallowObj(), $mod.ISwallow);',
+    '        return rtl.getIntfT(this.GetSwallowObj(), $mod.ISwallow);',
     '      }',
     '      }',
     '  };',
     '  };',
     '});',
     '});',
@@ -21178,7 +21253,7 @@ begin
     '  };',
     '  };',
     '  this.GetSpeed = function () {',
     '  this.GetSpeed = function () {',
     '    var Result = 0;',
     '    var Result = 0;',
-    '    this.SetSpeed(this.GetSpeed() + 12);',
+    '    $mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '    return Result;',
     '    return Result;',
     '  };',
     '  };',
@@ -21188,7 +21263,7 @@ begin
     'rtl.createHelper($mod, "TObjHelper", null, function () {',
     'rtl.createHelper($mod, "TObjHelper", null, function () {',
     '  this.GetLeft = function () {',
     '  this.GetLeft = function () {',
     '    var Result = 0;',
     '    var Result = 0;',
-    '    this.SetSpeed(this.GetSpeed() + 12);',
+    '    $mod.TObject.SetSpeed($mod.TObject.GetSpeed() + 12);',
     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '    $mod.TObjHelper.SetLeft($mod.TObjHelper.GetLeft() + 13);',
     '    return Result;',
     '    return Result;',
     '  };',
     '  };',
@@ -22968,7 +23043,7 @@ begin
     '  this.GetField = function () {',
     '  this.GetField = function () {',
     '    var Result = 0;',
     '    var Result = 0;',
     '    $mod.THelper.Fly.call({',
     '    $mod.THelper.Fly.call({',
-    '      p: this.GetField(),',
+    '      p: $mod.TObject.GetField(),',
     '      get: function () {',
     '      get: function () {',
     '          return this.p;',
     '          return this.p;',
     '        },',
     '        },',
@@ -27235,14 +27310,10 @@ end;
 procedure TTestModule.TestRTTI_IntRange;
 procedure TTestModule.TestRTTI_IntRange;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add([
   Add([
   '{$modeswitch externalclass}',
   '{$modeswitch externalclass}',
   'type',
   'type',
-  '  TTypeInfo = class external name ''rtl.tTypeInfo''',
-  '  end;',
-  '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
-  '  end;',
   '  TGraphicsColor = -$7FFFFFFF-1..$7FFFFFFF;',
   '  TGraphicsColor = -$7FFFFFFF-1..$7FFFFFFF;',
   '  TColor = type TGraphicsColor;',
   '  TColor = type TGraphicsColor;',
   'var',
   'var',
@@ -27271,12 +27342,10 @@ end;
 procedure TTestModule.TestRTTI_Double;
 procedure TTestModule.TestRTTI_Double;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add([
   Add([
   '{$modeswitch externalclass}',
   '{$modeswitch externalclass}',
   'type',
   'type',
-  '  TTypeInfo = class external name ''rtl.tTypeInfo''',
-  '  end;',
   '  TFloat = type double;',
   '  TFloat = type double;',
   'var',
   'var',
   '  p: TTypeInfo;',
   '  p: TTypeInfo;',
@@ -28981,16 +29050,12 @@ end;
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses1;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add([
   Add([
   '{$modeswitch externalclass}',
   '{$modeswitch externalclass}',
   'type',
   'type',
-  '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
-  '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo) end;',
   '  TFlag = (up,down);',
   '  TFlag = (up,down);',
-  '  TTypeInfoEnum = class external name ''rtl.tTypeInfoEnum''(TTypeInfoInteger) end;',
   '  TFlags = set of TFlag;',
   '  TFlags = set of TFlag;',
-  '  TTypeInfoSet = class external name ''rtl.tTypeInfoSet''(TTypeInfo) end;',
   'var',
   'var',
   '  ti: TTypeInfo;',
   '  ti: TTypeInfo;',
   '  tiInt: TTypeInfoInteger;',
   '  tiInt: TTypeInfoInteger;',
@@ -29053,18 +29118,13 @@ end;
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses2;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add('{$modeswitch externalclass}');
   Add('{$modeswitch externalclass}');
   Add('type');
   Add('type');
-  Add('  TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
   Add('  TStaticArr = array[boolean] of string;');
   Add('  TStaticArr = array[boolean] of string;');
-  Add('  TTypeInfoStaticArray = class external name ''rtl.tTypeInfoStaticArray''(TTypeInfo) end;');
   Add('  TDynArr = array of string;');
   Add('  TDynArr = array of string;');
-  Add('  TTypeInfoDynArray = class external name ''rtl.tTypeInfoDynArray''(TTypeInfo) end;');
   Add('  TProc = procedure;');
   Add('  TProc = procedure;');
-  Add('  TTypeInfoProcVar = class external name ''rtl.tTypeInfoProcVar''(TTypeInfo) end;');
   Add('  TMethod = procedure of object;');
   Add('  TMethod = procedure of object;');
-  Add('  TTypeInfoMethodVar = class external name ''rtl.tTypeInfoMethodVar''(TTypeInfoProcVar) end;');
   Add('var');
   Add('var');
   Add('  StaticArray: TStaticArr;');
   Add('  StaticArray: TStaticArr;');
   Add('  tiStaticArray: TTypeInfoStaticArray;');
   Add('  tiStaticArray: TTypeInfoStaticArray;');
@@ -29124,18 +29184,13 @@ end;
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
 procedure TTestModule.TestRTTI_TypeInfo_ExtTypeInfoClasses3;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add('{$modeswitch externalclass}');
   Add('{$modeswitch externalclass}');
   Add('type');
   Add('type');
-  Add('  TTypeInfo = class external name ''rtl.tTypeInfo'' end;');
   Add('  TRec = record end;');
   Add('  TRec = record end;');
-  Add('  TTypeInfoRecord = class external name ''rtl.tTypeInfoRecord''(TTypeInfo) end;');
   // ToDo: ^PRec
   // ToDo: ^PRec
   Add('  TObject = class end;');
   Add('  TObject = class end;');
-  Add('  TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;');
   Add('  TClass = class of tobject;');
   Add('  TClass = class of tobject;');
-  Add('  TTypeInfoClassRef = class external name ''rtl.tTypeInfoClassRef''(TTypeInfo) end;');
-  Add('  TTypeInfoPointer = class external name ''rtl.tTypeInfoPointer''(TTypeInfo) end;');
   Add('var');
   Add('var');
   Add('  Rec: trec;');
   Add('  Rec: trec;');
   Add('  tiRecord: ttypeinforecord;');
   Add('  tiRecord: ttypeinforecord;');
@@ -29194,7 +29249,7 @@ end;
 procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
 procedure TTestModule.TestRTTI_TypeInfo_FunctionClassType;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add([
   Add([
   '{$modeswitch externalclass}',
   '{$modeswitch externalclass}',
   'type',
   'type',
@@ -29203,8 +29258,6 @@ begin
   '    function MyClass: TClass;',
   '    function MyClass: TClass;',
   '    class function ClassType: TClass;',
   '    class function ClassType: TClass;',
   '  end;',
   '  end;',
-  '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
-  '  TTypeInfoClass = class external name ''rtl.tTypeInfoClass''(TTypeInfo) end;',
   'function TObject.MyClass: TClass;',
   'function TObject.MyClass: TClass;',
   'var t: TTypeInfoClass;',
   'var t: TTypeInfoClass;',
   'begin',
   'begin',
@@ -29347,7 +29400,7 @@ end;
 procedure TTestModule.TestRTTI_Interface_Corba;
 procedure TTestModule.TestRTTI_Interface_Corba;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add([
   Add([
   '{$interfaces corba}',
   '{$interfaces corba}',
   '{$modeswitch externalclass}',
   '{$modeswitch externalclass}',
@@ -29359,8 +29412,6 @@ begin
   '    procedure SetItem(Value: longint);',
   '    procedure SetItem(Value: longint);',
   '    property Item: longint read GetItem write SetItem;',
   '    property Item: longint read GetItem write SetItem;',
   '  end;',
   '  end;',
-  '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
-  '  TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
   'procedure DoIt(t: TTypeInfoInterface); begin end;',
   'procedure DoIt(t: TTypeInfoInterface); begin end;',
   'var',
   'var',
   '  i: IBird;',
   '  i: IBird;',
@@ -29412,7 +29463,7 @@ end;
 procedure TTestModule.TestRTTI_Interface_COM;
 procedure TTestModule.TestRTTI_Interface_COM;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add([
   Add([
   '{$interfaces com}',
   '{$interfaces com}',
   '{$modeswitch externalclass}',
   '{$modeswitch externalclass}',
@@ -29429,8 +29480,6 @@ begin
   '    procedure SetItem(Value: longint);',
   '    procedure SetItem(Value: longint);',
   '    property Item: longint read GetItem write SetItem;',
   '    property Item: longint read GetItem write SetItem;',
   '  end;',
   '  end;',
-  '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
-  '  TTypeInfoInterface = class external name ''rtl.tTypeInfoInterface''(TTypeInfo) end;',
   'var',
   'var',
   '  i: IBird;',
   '  i: IBird;',
   '  t: TTypeInfoInterface;',
   '  t: TTypeInfoInterface;',
@@ -29489,7 +29538,7 @@ end;
 procedure TTestModule.TestRTTI_ClassHelper;
 procedure TTestModule.TestRTTI_ClassHelper;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];
-  StartProgram(false);
+  StartProgram(true,[supTypeInfo]);
   Add([
   Add([
   '{$interfaces com}',
   '{$interfaces com}',
   '{$modeswitch externalclass}',
   '{$modeswitch externalclass}',
@@ -29501,8 +29550,6 @@ begin
   '    function GetItem: longint;',
   '    function GetItem: longint;',
   '    property Item: longint read GetItem;',
   '    property Item: longint read GetItem;',
   '  end;',
   '  end;',
-  '  TTypeInfo = class external name ''rtl.tTypeInfo'' end;',
-  '  TTypeInfoHelper = class external name ''rtl.tTypeInfoHelper''(TTypeInfo) end;',
   'function THelper.GetItem: longint;',
   'function THelper.GetItem: longint;',
   'begin',
   'begin',
   'end;',
   'end;',
@@ -29536,6 +29583,40 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestRTTI_ExternalClass;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(true,[supTypeInfo]);
+  Add([
+  '{$modeswitch externalclass}',
+  'type',
+  '  TJSObject = class external name ''Object''',
+  '  end;',
+  '  TJSArray = class external name ''Array'' (TJSObject)',
+  '  end;',
+  'var',
+  '  p: Pointer;',
+  '  tc: TTypeInfoExtClass;',
+  'begin',
+  '  p:=typeinfo(TJSArray);']);
+  ConvertProgram;
+  CheckSource('TestRTTI_ExternalClass',
+    LinesToStr([ // statements
+    '$mod.$rtti.$ExtClass("TJSObject", {',
+    '  jsclass: "Object"',
+    '});',
+    '$mod.$rtti.$ExtClass("TJSArray", {',
+    '  ancestor: $mod.$rtti["TJSObject"],',
+    '  jsclass: "Array"',
+    '});',
+    'this.p = null;',
+    'this.tc = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.p = $mod.$rtti["TJSArray"];',
+    '']));
+end;
+
 procedure TTestModule.TestResourcestringProgram;
 procedure TTestModule.TestResourcestringProgram;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -29829,7 +29910,6 @@ begin
   'constructor THelper.Create(Id: word); begin end;',
   'constructor THelper.Create(Id: word); begin end;',
   'begin',
   'begin',
   '  if typeinfo(TMyInt)=nil then ;']);
   '  if typeinfo(TMyInt)=nil then ;']);
-  //SetExpectedConverterError('aaa',123);
   ConvertProgram;
   ConvertProgram;
 end;
 end;
 
 

+ 23 - 1
utils/pas2js/dist/rtl.js

@@ -8,6 +8,8 @@ var rtl = {
   debug_load_units: false,
   debug_load_units: false,
   debug_rtti: false,
   debug_rtti: false,
 
 
+  $res : {},
+
   debug: function(){
   debug: function(){
     if (rtl.quiet || !console || !console.log) return;
     if (rtl.quiet || !console || !console.log) return;
     console.log(arguments);
     console.log(arguments);
@@ -1314,6 +1316,7 @@ var rtl = {
     newBaseTI("tTypeInfoClassRef",14 /* tkClassRef */);
     newBaseTI("tTypeInfoClassRef",14 /* tkClassRef */);
     newBaseTI("tTypeInfoInterface",18 /* tkInterface */,rtl.tTypeInfoStruct);
     newBaseTI("tTypeInfoInterface",18 /* tkInterface */,rtl.tTypeInfoStruct);
     newBaseTI("tTypeInfoHelper",19 /* tkHelper */,rtl.tTypeInfoStruct);
     newBaseTI("tTypeInfoHelper",19 /* tkHelper */,rtl.tTypeInfoStruct);
+    newBaseTI("tTypeInfoExtClass",20 /* tkExtClass */,rtl.tTypeInfoClass);
   },
   },
 
 
   tSectionRTTI: {
   tSectionRTTI: {
@@ -1364,7 +1367,8 @@ var rtl = {
     $ClassRef: function(name,o){ return this.$inherited(name,rtl.tTypeInfoClassRef,o); },
     $ClassRef: function(name,o){ return this.$inherited(name,rtl.tTypeInfoClassRef,o); },
     $Pointer: function(name,o){ return this.$inherited(name,rtl.tTypeInfoPointer,o); },
     $Pointer: function(name,o){ return this.$inherited(name,rtl.tTypeInfoPointer,o); },
     $Interface: function(name,o){ return this.$Scope(name,rtl.tTypeInfoInterface,o); },
     $Interface: function(name,o){ return this.$Scope(name,rtl.tTypeInfoInterface,o); },
-    $Helper: function(name,o){ return this.$Scope(name,rtl.tTypeInfoHelper,o); }
+    $Helper: function(name,o){ return this.$Scope(name,rtl.tTypeInfoHelper,o); },
+    $ExtClass: function(name,o){ return this.$Scope(name,rtl.tTypeInfoExtClass,o); }
   },
   },
 
 
   newTIParam: function(param){
   newTIParam: function(param){
@@ -1393,5 +1397,23 @@ var rtl = {
       flags: flags
       flags: flags
     };
     };
     return s;
     return s;
+  },
+
+  addResource: function(aRes){
+    rtl.$res[aRes.name]=aRes;
+  },
+
+  getResource: function(aName){
+    var res = rtl.$res[aName];
+    if (res !== undefined) {
+      return res;
+    } else {
+      return null;
+    }
+  },
+
+  getResourceList: function(){
+    return Object.keys(rtl.$res);
   }
   }
 }
 }
+

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

@@ -2506,7 +2506,10 @@ function(){
     <div class="section">
     <div class="section">
     <h2 id="varargs">The procedure modifier varargs</h2>
     <h2 id="varargs">The procedure modifier varargs</h2>
     Appending the <b>varargs</b> modifier to a procedure allows to pass arbitrary
     Appending the <b>varargs</b> modifier to a procedure allows to pass arbitrary
-    more parameters to a function. To access these non typed arguments use
+    more parameters to a function. By default these parameters are untyped, i.e.
+    any type fits. Alternatively you can use <b>varargs of aType</b> to allow
+    only specific types.<br>
+    To access these arguments use
     either <i>JSArguments</i> from unit JS or an <i>asm..end</i> block.
     either <i>JSArguments</i> from unit JS or an <i>asm..end</i> block.
     <table class="sample">
     <table class="sample">
       <tbody>
       <tbody>
@@ -2693,10 +2696,11 @@ function(){
     external name is the member name. Keep in mind that JS is case sensitive.<br>
     external name is the member name. Keep in mind that JS is case sensitive.<br>
     Properties work the same as with Pascal classes, i.e. are replaced by Getter/Setter.<br>
     Properties work the same as with Pascal classes, i.e. are replaced by Getter/Setter.<br>
     Destructors are not allowed.<br>
     Destructors are not allowed.<br>
-    Constructors are supported in three ways:
+    Constructors are supported in four ways:
     <ul>
     <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><i>constructor New</i> is translated to <i>new ExtClass(params)</i>.</li>
+      <li><i>constructor New; external name ''GlobalFunc''</i> is translated to <i>new GlobalFunc(params)</i>.</li>
+      <li><i>constructor SomeName; external name <i>'{}'</i> is translated to <i>{}</i>.</li>
       <li>Otherwise it is translated to <i>new ExtClass.FuncName(params)</i>.</li>
       <li>Otherwise it is translated to <i>new ExtClass.FuncName(params)</i>.</li>
     </ul>
     </ul>
 
 

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