* synchronized with trunk

git-svn-id: branches/wasm@46771 -

.gitattributes

@@ -13449,6 +13449,7 @@ tests/test/cg/cdecl/taoc3.pp svneol=native#text/plain
 tests/test/cg/cdecl/taoc4.pp svneol=native#text/plain
 tests/test/cg/cdecl/taoc5.pp svneol=native#text/plain
 tests/test/cg/cdecl/taoc6.pp svneol=native#text/plain
+tests/test/cg/cpudefs.inc svneol=native#text/plain
 tests/test/cg/obj/aix/powerpc/cpptcl1.o -text
 tests/test/cg/obj/aix/powerpc/cpptcl2.o -text
 tests/test/cg/obj/aix/powerpc/ctest.o -text
@@ -13821,7 +13822,6 @@ tests/test/cg/tcalcst5.pp svneol=native#text/plain
 tests/test/cg/tcalcst6.pp svneol=native#text/plain
 tests/test/cg/tcalcst7.pp svneol=native#text/plain
 tests/test/cg/tcalcst8.pp svneol=native#text/plain
-tests/test/cg/tcaldefs.inc svneol=native#text/plain
 tests/test/cg/tcalext.pp svneol=native#text/plain
 tests/test/cg/tcalext3.pp svneol=native#text/plain
 tests/test/cg/tcalext4.pp svneol=native#text/plain
@@ -18484,6 +18484,7 @@ tests/webtbs/tw37554.pp svneol=native#text/pascal
 tests/webtbs/tw3758.pp svneol=native#text/plain
 tests/webtbs/tw3764.pp svneol=native#text/plain
 tests/webtbs/tw3765.pp svneol=native#text/plain
+tests/webtbs/tw37650.pp svneol=native#text/pascal
 tests/webtbs/tw3768.pp svneol=native#text/plain
 tests/webtbs/tw3774.pp svneol=native#text/plain
 tests/webtbs/tw3777.pp svneol=native#text/plain

compiler/pexpr.pas

@@ -114,7 +114,12 @@ implementation
                end
              else
                begin
-                if (tordconstnode(p).value<=0) then
+                { the node is a generic param while parsing a generic def
+                  so disable the range checking for the string }
+                if parse_generic and
+                  (nf_generic_para in p.flags) then
+                  tordconstnode(p).value:=255;
+                if tordconstnode(p).value<=0 then
                   begin
                      Message(parser_e_invalid_string_size);
                      tordconstnode(p).value:=255;

compiler/xtensa/cpupara.pas

@@ -49,7 +49,7 @@ unit cpupara;
            paras : tparalist; var curintreg : tsuperregister;
            var cur_stack_offset : aword; varargsparas : boolean) : longint;
          function create_paraloc1_info_intern(p: tabstractprocdef; side: tcallercallee; paradef: tdef; var loc: TCGPara; varspez: tvarspez; varoptions: tvaroptions;
-           var curintreg: tsuperregister; var cur_stack_offset: aword; varargsparas: boolean): longint;
+           var curintreg: tsuperregister; var cur_stack_offset: aword; varargsparas, funcret: boolean): longint;
        end;
 
   implementation
@@ -153,10 +153,7 @@ unit cpupara;
           recorddef :
             result:=(varspez = vs_const);
           arraydef:
-            result:=((varspez = vs_const) and (tarraydef(def).highrange>=tarraydef(def).lowrange)) or
-                             is_open_array(def) or
-                             is_array_of_const(def) or
-                             is_array_constructor(def);
+            result:=true;
           objectdef :
             result:=is_object(def) and (varspez = vs_const);
           variantdef,
@@ -252,7 +249,7 @@ unit cpupara;
         else if (result.def.size>4) and (result.def.size<=16) then
           begin
             init_values(p,side,curintreg,cur_stack_offset);
-            create_paraloc1_info_intern(p,side,result.def,result,vs_value,[],curintreg,cur_stack_offset,false);
+            create_paraloc1_info_intern(p,side,result.def,result,vs_value,[],curintreg,cur_stack_offset,false,true);
 
             { check if everything is ok }
             if result.location^.loc=LOC_INVALID then
@@ -320,7 +317,7 @@ unit cpupara;
 
 
     function tcpuparamanager.create_paraloc1_info_intern(p : tabstractprocdef; side: tcallercallee; paradef:tdef;var loc : TCGPara;varspez : tvarspez;varoptions : tvaroptions;
-      var curintreg: tsuperregister; var cur_stack_offset: aword; varargsparas: boolean):longint;
+      var curintreg: tsuperregister; var cur_stack_offset: aword; varargsparas, funcret: boolean):longint;
       var
         paralen: aint;
         locdef,
@@ -349,19 +346,21 @@ unit cpupara;
             exit;
           end;
 
-        if push_addr_param(varspez,paradef,p.proccalloption) then
+        if not is_special_array(paradef) then
+          paralen:=paradef.size
+        else
+          paralen:=tcgsize2size[def_cgsize(paradef)];
+
+        if (not(funcret) and push_addr_param(varspez,paradef,p.proccalloption)) or
+          (funcret and (paralen>24)) then
           begin
             paradef:=cpointerdef.getreusable_no_free(paradef);
             locpara:=LOC_REGISTER;
-            paracgsize := OS_ADDR;
-            paralen := tcgsize2size[OS_ADDR];
+            paracgsize:=OS_ADDR;
+            paralen:=tcgsize2size[OS_ADDR];
           end
         else
           begin
-            if not is_special_array(paradef) then
-              paralen := paradef.size
-            else
-              paralen := tcgsize2size[def_cgsize(paradef)];
             if (paradef.typ in [objectdef,arraydef,recorddef,setdef,stringdef]) and
                not is_special_array(paradef) and
                (varspez in [vs_value,vs_const]) then
@@ -369,10 +368,10 @@ unit cpupara;
             else
               begin
                 paracgsize:=def_cgsize(paradef);
-                if (paracgsize=OS_NO) then
+                if paracgsize=OS_NO then
                   begin
                     paracgsize:=OS_ADDR;
-                    paralen := tcgsize2size[OS_ADDR];
+                    paralen:=tcgsize2size[OS_ADDR];
                     paradef:=voidpointertype;
                   end;
               end;
@@ -481,7 +480,7 @@ unit cpupara;
         result:=0;
         for i:=0 to paras.count-1 do
           result:=create_paraloc1_info_intern(p,side,tparavarsym(paras[i]).vardef,tparavarsym(paras[i]).paraloc[side],tparavarsym(paras[i]).varspez,
-            tparavarsym(paras[i]).varoptions,curintreg,cur_stack_offset,false);
+            tparavarsym(paras[i]).varoptions,curintreg,cur_stack_offset,false,false);
       end;
 
 

packages/chm/src/chmls.lpr

@@ -482,7 +482,7 @@ begin
    s:=r.readstringsentry(cnt);
 end;
 
-
+var dx : dword;
 begin
   setlength(s,4);
   for i:=1 to 4 do
@@ -529,7 +529,8 @@ begin
   Writeln('Unknown. Often 1. Also 0, 3.                  :',leton(m.readdword));
   cnt2:=m.ReadDWordLE;
   Writeln('Number of files in the [MERGE FILES] list     :',cnt2);
-  Writeln('Unknown. Often 0.                             :',leton(m.readdword),'(Non-zero mostly in files with some files in the merge files list)');
+  dx:=leton(m.readdword);
+  Writeln('Unknown. Often 0.                             :',dx,' =$',inttohex(dx,8),'(Non-zero mostly in files with some files in the merge files list)');
   if cnt2>0 then
     for i:=0 to cnt2-1 do
       begin
@@ -805,7 +806,7 @@ begin
   writeln(' Non zero if there are ALinks      : ',m.readdwordLE );
   ts.dwlowdatetime:=m.readdwordLE;
   ts.dwhighdatetime:=m.readdwordLE;
-  writeln(' Timestamp                         : ',ts.dwhighdatetime,':', ts.dwlowdatetime );
+  writeln(' Timestamp                         : ',ts.dwhighdatetime,':', ts.dwlowdatetime, ' = $',inttohex(ts.dwhighdatetime,8),': $', inttohex(ts.dwlowdatetime,8));
   writeln(' 0/1 except in dsmsdn.chi has 1    : ',m.readdwordLE );
   writeln(' 0 (unknown)                       : ',m.readdwordLE );
 end;
@@ -831,6 +832,7 @@ begin
     writeln('   x size is larger than 16');
   m.position:=m.position+chsz-16;
 end;
+var dx : dword;
 
 begin
   symbolname:='helpid';
@@ -878,7 +880,8 @@ begin
             8 : printentry8(m,chunksize);
             9 : Writeln('(9)  CHM compiler version          :',printnulterminated(chunksize));
             10: begin
-                  writeln('(10) Timestamp (32-bit?)           :',m.readdwordle);
+                  dx:=m.readdwordle;
+                  writeln('(10) Timestamp (32-bit?)           :',dx,' , = $',inttohex(dx,8));
                   m.position:=m.position+chunksize-4;
                 end;
             11: Writeln('(11)  DWord when Binary TOC is on   :',m.readdwordle, '(= entry in #urltbl has same first dword');

packages/fcl-passrc/src/pasresolveeval.pas

@@ -1027,27 +1027,27 @@ var
 begin
   if o=nil then
     Result:='nil'
-  else if o is TPasArrayType then
+  else if (o is TPasArrayType) and (TPasArrayType(o).Name='') then
     begin
-      if TPasArrayType(o).ElType = nil then
-          Result:='array of const'
-      else
-        Result:=Format('TArray<%s>', [TPasArrayType(o).ElType.Name]);
+    if TPasArrayType(o).ElType = nil then
+      Result:='array of const'
+    else
+      Result:=Format('TArray<%s>', [TPasArrayType(o).ElType.Name]);
     end
-    else if o is TPasElement then
+  else if o is TPasElement then
+    begin
+    Result:=TPasElement(o).Name;
+    if o is TPasGenericType then
       begin
-      Result:=TPasElement(o).Name;
-      if o is TPasGenericType then
-        begin
-        GenType:=TPasGenericType(o);
-        if (GenType.GenericTemplateTypes<>nil)
-            and (GenType.GenericTemplateTypes.Count>0) then
-          Result:=Result+GetGenericParamCommas(GenType.GenericTemplateTypes.Count);
-        end;
-      Result:=Result+':'+o.ClassName;
-      end
-    else
-      Result:=o.ClassName;
+      GenType:=TPasGenericType(o);
+      if (GenType.GenericTemplateTypes<>nil)
+          and (GenType.GenericTemplateTypes.Count>0) then
+        Result:=Result+GetGenericParamCommas(GenType.GenericTemplateTypes.Count);
+      end;
+    Result:=Result+':'+o.ClassName;
+    end
+  else
+    Result:=o.ClassName;
 end;
 
 function GetObjPath(o: TObject): string;

packages/fcl-passrc/src/pasresolver.pp

@@ -986,12 +986,14 @@ type
   TPasArrayScope = Class(TPasGenericScope)
   public
   end;
+  TPasArrayScopeClass = class of TPasArrayScope;
 
   { TPasProcTypeScope }
 
   TPasProcTypeScope = Class(TPasGenericScope)
   public
   end;
+  TPasProcTypeScopeClass = class of TPasProcTypeScope;
 
   { TPasClassOrRecordScope }
 
@@ -1510,10 +1512,12 @@ type
     FOptions: TPasResolverOptions;
     FPendingForwardProcs: TFPList; // list of TPasElement needed to check for forward procs
     FRootElement: TPasModule;
+    FScopeClass_Array: TPasArrayScopeClass;
     FScopeClass_Class: TPasClassScopeClass;
     FScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass;
     FScopeClass_Module: TPasModuleScopeClass;
     FScopeClass_Proc: TPasProcedureScopeClass;
+    FScopeClass_ProcType: TPasProcTypeScopeClass;
     FScopeClass_Record: TPasRecordScopeClass;
     FScopeClass_Section: TPasSectionScopeClass;
     FScopeClass_WithExpr: TPasWithExprScopeClass;
@@ -2424,10 +2428,12 @@ type
     property ScopeCount: integer read FScopeCount;
     property TopScope: TPasScope read FTopScope;
     property DefaultScope: TPasDefaultScope read FDefaultScope write FDefaultScope;
+    property ScopeClass_Array: TPasArrayScopeClass read FScopeClass_Array write FScopeClass_Array;
     property ScopeClass_Class: TPasClassScopeClass read FScopeClass_Class write FScopeClass_Class;
     property ScopeClass_InitialFinalization: TPasInitialFinalizationScopeClass read FScopeClass_InitialFinalization write FScopeClass_InitialFinalization;
     property ScopeClass_Module: TPasModuleScopeClass read FScopeClass_Module write FScopeClass_Module;
     property ScopeClass_Procedure: TPasProcedureScopeClass read FScopeClass_Proc write FScopeClass_Proc;
+    property ScopeClass_ProcType: TPasProcTypeScopeClass read FScopeClass_ProcType write FScopeClass_ProcType;
     property ScopeClass_Record: TPasRecordScopeClass read FScopeClass_Record write FScopeClass_Record;
     property ScopeClass_Section: TPasSectionScopeClass read FScopeClass_Section write FScopeClass_Section;
     property ScopeClass_WithExpr: TPasWithExprScopeClass read FScopeClass_WithExpr write FScopeClass_WithExpr;
@@ -11910,7 +11916,7 @@ begin
 
     if TypeParams<>nil then
       begin
-      Scope:=TPasArrayScope(PushScope(El,TPasArrayScope));
+      Scope:=TPasArrayScope(PushScope(El,ScopeClass_Array));
       AddGenericTemplateIdentifiers(TypeParams,Scope);
       end;
   end else if TypeParams<>nil then
@@ -12239,7 +12245,7 @@ begin
 
     if TypeParams<>nil then
       begin
-      Scope:=TPasProcTypeScope(PushScope(El,TPasProcTypeScope));
+      Scope:=TPasProcTypeScope(PushScope(El,ScopeClass_ProcType));
       AddGenericTemplateIdentifiers(TypeParams,Scope);
       end;
   end else if TypeParams<>nil then
@@ -17664,7 +17670,7 @@ var
 begin
   if GenEl.GenericTemplateTypes<>nil then
     begin
-    GenScope:=TPasGenericScope(PushScope(SpecEl,TPasProcTypeScope));
+    GenScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_ProcType));
     if SpecializedItem<>nil then
       begin
       // specialized procedure type
@@ -18148,7 +18154,7 @@ begin
   SpecEl.PackMode:=GenEl.PackMode;
   if GenEl.GenericTemplateTypes<>nil then
     begin
-    GenScope:=TPasGenericScope(PushScope(SpecEl,TPasArrayScope));
+    GenScope:=TPasGenericScope(PushScope(SpecEl,ScopeClass_Array));
     if SpecializedItem<>nil then
       begin
       // specialized generic array
@@ -20525,10 +20531,12 @@ begin
   cInterfaceToTGUID:=cTypeConversion+1;
   cInterfaceToString:=cTypeConversion+2;
 
+  FScopeClass_Array:=TPasArrayScope;
   FScopeClass_Class:=TPasClassScope;
   FScopeClass_InitialFinalization:=TPasInitialFinalizationScope;
   FScopeClass_Module:=TPasModuleScope;
   FScopeClass_Proc:=TPasProcedureScope;
+  FScopeClass_ProcType:=TPasProcTypeScope;
   FScopeClass_Record:=TPasRecordScope;
   FScopeClass_Section:=TPasSectionScope;
   FScopeClass_WithExpr:=TPasWithExprScope;

packages/openssl/src/openssl.pas

@@ -1152,7 +1152,7 @@ var
   function EvpPkeyAssign(pkey: PEVP_PKEY; _type: cInt; key: Prsa): cInt;
   function EvpGetDigestByName(Name: String): PEVP_MD;
   procedure EVPcleanup;
-  function SSLeayversion(t: cInt): string;  deprecated 'For 1.1+ use OpenSSL_version';
+  function SSLeayversion(t: cInt): string;  deprecated 'For 1.1+ use OpenSSLGetVersion';
   procedure ErrErrorString(e: cInt; var buf: string; len: cInt);
   function ErrGetError: cInt;
   procedure ErrClearError;
@@ -1243,7 +1243,7 @@ var
 
   // Crypto Functions
 
-  function SSLeay_version(t: cint): PChar;
+  function SSLeay_version(t: cint): PChar; deprecated 'For 1.1+ use OpenSSLGetVersion';
 
   // EVP Functions - evp.h
   function EVP_des_ede3_cbc : PEVP_CIPHER;
@@ -1551,7 +1551,6 @@ end;
 
 type
 // libssl.dll
-  TOpenSSLversion = function (arg : cint) : pchar; cdecl;
   TSslGetError = function(s: PSSL; ret_code: cInt):cInt; cdecl;
   TSslLibraryInit = function:cInt; cdecl;
   TOPENSSL_INIT_new = function : POPENSSL_INIT_SETTINGS; cdecl;
@@ -1631,6 +1630,7 @@ type
   TEvpPkeyAssign = function(pkey: PEVP_PKEY; _type: cInt; key: Prsa): cInt; cdecl;
   TEvpGetDigestByName = function(Name: PChar): PEVP_MD; cdecl;
   TEVPcleanup = procedure; cdecl;
+  TOpenSSLversion = function (arg : cint) : pchar; cdecl;
   TSSLeayversion = function(t: cInt): PChar; cdecl;
   TErrErrorString = procedure(e: cInt; buf: PChar; len: cInt); cdecl;
   TErrGetError = function: cInt; cdecl;
@@ -1716,7 +1716,6 @@ type
 
   // Crypto Functions
 
-  TSSLeay_version = function(t: cint): PChar; cdecl;
   TCRYPTOcleanupAllExData = procedure; cdecl;
   TOPENSSLaddallalgorithms = procedure; cdecl;
 
@@ -1789,7 +1788,6 @@ type
 
 var
 // libssl.dll
-  _OpenSSLVersion : TOpenSSLversion = Nil;
   _SslGetError: TSslGetError = nil;
   _SslLibraryInit: TSslLibraryInit = nil;
   _OPENSSL_init_ssl : TOPENSSL_init_ssl = Nil;
@@ -1868,6 +1866,7 @@ var
   _EvpPkeyAssign: TEvpPkeyAssign = nil;
   _EvpGetDigestByName: TEvpGetDigestByName = nil;
   _EVPcleanup: TEVPcleanup = nil;
+  _OpenSSLVersion : TOpenSSLversion = Nil;
   _SSLeayversion: TSSLeayversion = nil;
   _ErrErrorString: TErrErrorString = nil;
   _ErrGetError: TErrGetError = nil;
@@ -1971,7 +1970,6 @@ var
 
   // Crypto Functions
 
-  _SSLeay_version: TSSLeay_version = nil;
   _CRYPTOcleanupAllExData: TCRYPTOcleanupAllExData = nil;
   _OPENSSLaddallalgorithms: TOPENSSLaddallalgorithms = nil;
 
@@ -3350,8 +3348,8 @@ end;
 
 function SSLeay_version(t: cint): PChar;
 begin
-  if InitSSLInterface and Assigned(_SSLeay_version) then
-    Result := _SSLeay_version(t)
+  if InitSSLInterface and Assigned(_SSLeayversion) then
+    Result := _SSLeayversion(t)
   else
     Result := nil;
 end;
@@ -4858,7 +4856,6 @@ end;
 Procedure LoadSSLEntryPoints;
 
 begin
-  _OpenSSLVersion := GetProcAddr(SSLLibHandle, 'OpenSSL_version');
   _SslGetError := GetProcAddr(SSLLibHandle, 'SSL_get_error');
   _SslLibraryInit := GetProcAddr(SSLLibHandle, 'SSL_library_init');
   _OPENSSL_init_ssl := GetProcAddr(SSLLibHandle, 'OPENSSL_init_ssl');
@@ -4950,9 +4947,10 @@ begin
   _EvpPkeyAssign := GetProcAddr(SSLUtilHandle, 'EVP_PKEY_assign');
   _EVPCleanup := GetProcAddr(SSLUtilHandle, 'EVP_cleanup');
   _EvpGetDigestByName := GetProcAddr(SSLUtilHandle, 'EVP_get_digestbyname');
+  _OpenSSLVersion := GetProcAddr(SSLUtilHandle, 'OpenSSL_version');
   _SSLeayversion := GetProcAddr(SSLUtilHandle, 'SSLeay_version');
   if @_SSLeayversion=Nil then
-    _SSLeayversion := GetProcAddr(SSLUtilHandle, 'OpenSSL_version');
+    _SSLeayversion := _OpenSSLVersion;
   _ErrErrorString := GetProcAddr(SSLUtilHandle, 'ERR_error_string_n');
   _ErrGetError := GetProcAddr(SSLUtilHandle, 'ERR_get_error');
   _ErrClearError := GetProcAddr(SSLUtilHandle, 'ERR_clear_error');
@@ -5090,8 +5088,6 @@ begin
   _BIO_s_file := GetProcAddr(SSLUtilHandle, 'BIO_s_file');
   _BIO_new_file := GetProcAddr(SSLUtilHandle, 'BIO_new_file');
   _BIO_new_mem_buf := GetProcAddr(SSLUtilHandle, 'BIO_new_mem_buf');
-  // Crypto Functions
-  _SSLeay_version := GetProcAddr(SSLUtilHandle, 'SSLeay_version');
   // PKCS7
   _PKCS7_ISSUER_AND_SERIAL_new:=GetProcAddr(SSLUtilHandle,'PKCS7_ISSUER_AND_SERIAL_new');
   _PKCS7_ISSUER_AND_SERIAL_free:=GetProcAddr(SSLUtilHandle,'PKCS7_ISSUER_AND_SERIAL_free');
@@ -5217,7 +5213,6 @@ end;
 Procedure ClearSSLEntryPoints;
 
 begin
-  _OpenSSLVersion := Nil;
   _SslGetError := nil;
   _SslLibraryInit := nil;
   _OPENSSL_init_ssl:=Nil;
@@ -5396,6 +5391,7 @@ end;
 Procedure ClearUtilEntryPoints;
 
 begin
+  _OpenSSLVersion := Nil;
   _SSLeayversion := nil;
   _ERR_load_crypto_strings := nil;
   _OPENSSL_init_crypto:=Nil;
@@ -5564,10 +5560,6 @@ begin
   _BIO_s_file := nil;
   _BIO_new_file := nil;
   _BIO_new_mem_buf := nil;
-
-  // Crypto Functions
-
-  _SSLeay_version := nil;
 end;
 
 procedure locking_callback(mode, ltype: integer; lfile: PChar; line: integer); cdecl;

packages/pastojs/src/fppas2js.pp

@@ -1166,6 +1166,7 @@ type
 
   TPas2JSClassScope = class(TPasClassScope)
   public
+    LongName: string;
     NewInstanceFunction: TPasClassFunction;
     GUID: string;
     ElevatedLocals: TPas2jsElevatedLocals;
@@ -1183,6 +1184,7 @@ type
 
   TPas2JSRecordScope = class(TPasRecordScope)
   public
+    LongName: string;
     MemberOverloadsRenamed: boolean;
   end;
 
@@ -1191,6 +1193,7 @@ type
   TPas2JSProcedureScope = class(TPasProcedureScope)
   public
     OverloadName: string;
+    LongName: string;
     ResultVarName: string; // valid in implementation ProcScope, empty means use ResolverResultVar
     BodyOverloadsRenamed: boolean;
     BodyJS: string; // Option coStoreProcJS: stored in ImplScope
@@ -1200,6 +1203,20 @@ type
     destructor Destroy; override;
   end;
 
+  { TPas2JSArrayScope }
+
+  TPas2JSArrayScope = Class(TPasArrayScope)
+  public
+    LongName: string;
+  end;
+
+  { TPas2JSProcTypeScope }
+
+  TPas2JSProcTypeScope = Class(TPasProcTypeScope)
+  public
+    LongName: string;
+  end;
+
   { TPas2JSWithExprScope }
 
   TPas2JSWithExprScope = class(TPasWithExprScope)
@@ -1495,9 +1512,12 @@ type
     function GenerateGUID(El: TPasClassType): string; virtual;
   protected
     // generic/specialize
+    procedure SpecializeGenericIntf(SpecializedItem: TPRSpecializedItem);
+      override;
     procedure SpecializeGenericImpl(SpecializedItem: TPRSpecializedItem);
       override;
     function SpecializeNeedsDelay(SpecializedItem: TPRSpecializedItem): TPasElement; virtual;
+    function CreateLongName(SpecializedItem: TPRSpecializedItem): string; virtual;
   protected
     const
       cJSValueConversion = 2*cTypeConversion;
@@ -4955,6 +4975,49 @@ begin
   Result:=Result+'}';
 end;
 
+procedure TPas2JSResolver.SpecializeGenericIntf(
+  SpecializedItem: TPRSpecializedItem);
+{$IFDEF EnableLongNames}
+var
+  El: TPasElement;
+  C: TClass;
+  RecScope: TPas2JSRecordScope;
+  ClassScope: TPas2JSClassScope;
+  ArrayScope: TPas2JSArrayScope;
+  ProcTypeScope: TPas2JSProcTypeScope;
+  LongName: String;
+{$ENDIF}
+begin
+  {$IFDEF EnableLongNames}
+  El:=SpecializedItem.SpecializedEl;
+  C:=El.ClassType;
+  LongName:=CreateLongName(SpecializedItem);
+  if C=TPasRecordType then
+    begin
+    RecScope:=TPas2JSRecordScope(El.CustomData);
+    RecScope.LongName:=LongName;
+    end
+  else if C=TPasClassType then
+    begin
+    ClassScope:=TPas2JSClassScope(El.CustomData);
+    ClassScope.LongName:=LongName;
+    end
+  else if C=TPasArrayType then
+    begin
+    ArrayScope:=TPas2JSArrayScope(El.CustomData);
+    ArrayScope.LongName:=LongName;
+    end
+  else if (C=TPasProcedureType) or (C=TPasFunctionType) then
+    begin
+    ProcTypeScope:=TPas2JSProcTypeScope(El.CustomData);
+    ProcTypeScope.LongName:=LongName;
+    end
+  else
+    RaiseNotYetImplemented(20200904132908,El);
+  {$ENDIF}
+  inherited SpecializeGenericIntf(SpecializedItem);
+end;
+
 procedure TPas2JSResolver.SpecializeGenericImpl(
   SpecializedItem: TPRSpecializedItem);
 var
@@ -5037,6 +5100,24 @@ begin
     end;
 end;
 
+function TPas2JSResolver.CreateLongName(SpecializedItem: TPRSpecializedItem
+  ): string;
+var
+  GenEl: TPasElement;
+  i: Integer;
+  Param: TPasType;
+begin
+  GenEl:=SpecializedItem.GenericEl;
+  Result:=GenEl.Name+'<';
+  for i:=0 to length(SpecializedItem.Params)-1 do
+    begin
+    Param:=ResolveAliasType(SpecializedItem.Params[i],false);
+    // ToDo  move to resolver
+    if Param=nil then ;
+    end;
+  Result:=Result+'>';
+end;
+
 function TPas2JSResolver.AddJSBaseType(const aName: string; Typ: TPas2jsBaseType
   ): TResElDataPas2JSBaseType;
 var
@@ -5827,6 +5908,8 @@ begin
   ScopeClass_Module:=TPas2JSModuleScope;
   ScopeClass_Procedure:=TPas2JSProcedureScope;
   ScopeClass_Record:=TPas2JSRecordScope;
+  ScopeClass_Array:=TPas2JSArrayScope;
+  ScopeClass_ProcType:=TPas2JSProcTypeScope;
   ScopeClass_Section:=TPas2JSSectionScope;
   ScopeClass_WithExpr:=TPas2JSWithExprScope;
   for bt in [pbtJSValue] do
@@ -14791,6 +14874,8 @@ begin
         end;
 
       // add class members: types and class vars
+      if SpecializeNeedsDelay then
+        DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
       if El.ObjKind in ([okClass]+okAllHelpers) then
         begin
         For i:=0 to El.Members.Count-1 do
@@ -14828,11 +14913,7 @@ begin
           if NewEl<>nil then
             begin
             if SpecializeNeedsDelay and not (P is TPasProcedure) then
-              begin
-              if DelayFuncContext=nil then
-                DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
-              AddToSourceElements(DelaySrc,NewEl);
-              end
+              AddToSourceElements(DelaySrc,NewEl)
             else
               AddToSourceElements(Src,NewEl);
             end;
@@ -14900,11 +14981,7 @@ begin
         AddClassMessageIds(El,Src,FuncContext,pbivnMessageStr);
         // add RTTI init function
         if SpecializeNeedsDelay then
-          begin
-          if DelayFuncContext=nil then
-            DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
-          AddClassRTTI(El,DelaySrc,DelayFuncContext);
-          end
+          AddClassRTTI(El,DelaySrc,DelayFuncContext)
         else
           AddClassRTTI(El,Src,FuncContext);
         end;
@@ -15400,7 +15477,7 @@ var
   Obj: TJSObjectLiteral;
   Prop: TJSObjectLiteralElement;
   aResolver: TPas2JSResolver;
-  Scope: TPasProcTypeScope;
+  Scope: TPas2JSProcTypeScope;
   SpecializeNeedsDelay: Boolean;
   FuncSt: TJSFunctionDeclarationStatement;
   AssignSt: TJSSimpleAssignStatement;
@@ -15420,7 +15497,7 @@ begin
   if El.Parent is TProcedureBody then
     RaiseNotSupported(El,AContext,20181231112029);
 
-  Scope:=El.CustomData as TPasProcTypeScope;
+  Scope:=El.CustomData as TPas2JSProcTypeScope;
   SpecializeNeedsDelay:=(Scope<>nil)
            and (aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil);
 
@@ -15532,7 +15609,7 @@ var
 
 var
   aResolver: TPas2JSResolver;
-  Scope: TPasArrayScope;
+  Scope: TPas2JSArrayScope;
   SpecializeNeedsDelay: Boolean;
   AssignSt: TJSSimpleAssignStatement;
   CallName, ArrName: String;
@@ -15566,7 +15643,7 @@ begin
   writeln('TPasToJSConverter.ConvertArrayType ',GetObjName(El));
   {$ENDIF}
 
-  Scope:=El.CustomData as TPasArrayScope;
+  Scope:=El.CustomData as TPas2JSArrayScope;
   SpecializeNeedsDelay:=(Scope<>nil)
            and (aResolver.SpecializeNeedsDelay(Scope.SpecializedFromItem)<>nil);
 
@@ -16750,6 +16827,7 @@ begin
   if (C=TPasRecordType)
       or (C=TPasClassType) then
     begin
+    if (C=TPasClassType) and TPasClassType(El).IsExternal then exit;
     // pas.unitname.recordtype.$initSpec();
     Path:=CreateReferencePath(El,AContext,rpkPathAndName)+'.'+GetBIName(pbifnClassInitSpecialize);
     Call:=CreateCallExpression(El);
@@ -24998,6 +25076,8 @@ begin
     Vars:=TFPList.Create;
     Methods:=TFPList.Create;
     IsComplex:=false;
+    if SpecializeNeedsDelay then
+      DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
     for i:=0 to El.Members.Count-1 do
       begin
       P:=TPasElement(El.Members[i]);
@@ -25072,11 +25152,7 @@ begin
       if NewEl<>nil then
         begin
         if SpecializeNeedsDelay and not (P is TPasProcedure) then
-          begin
-          if DelayFuncContext=nil then
-            DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
-          AddToSourceElements(DelaySrc,NewEl);
-          end
+          AddToSourceElements(DelaySrc,NewEl)
         else
           AddToSourceElements(Src,NewEl);
         end;
@@ -25103,11 +25179,7 @@ begin
     if (aResolver<>nil) and HasTypeInfo(El,FuncContext) then
       begin
       if SpecializeNeedsDelay then
-        begin
-        if DelayFuncContext=nil then
-          DelayFuncContext:=CreateDelayedInitFunction(El,Src,FuncContext,DelaySrc);
-        CreateRecordRTTI(El,DelaySrc,DelayFuncContext);
-        end
+        CreateRecordRTTI(El,DelaySrc,DelayFuncContext)
       else
         CreateRecordRTTI(El,Src,FuncContext);
       end;

packages/pastojs/tests/tcgenerics.pas

@@ -47,6 +47,7 @@ type
     procedure TestGen_ExtClass_GenJSValueAssign;
     procedure TestGen_ExtClass_AliasMemberType;
     Procedure TestGen_ExtClass_RTTI;
+    procedure TestGen_ExtClass_UnitImplRec;
 
     // class interfaces
     procedure TestGen_ClassInterface_Corba;
@@ -79,6 +80,8 @@ type
     procedure TestGen_ArrayOfUnitImplRec;
 
     // generic procedure type
+    procedure TestGen_ProcType_ProcLocal;
+    procedure TestGen_ProcType_ProcLocal_RTTI;
     procedure TestGen_ProcType_ParamUnitImpl;
   end;
 
@@ -1324,6 +1327,70 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ExtClass_UnitImplRec;
+begin
+  WithTypeInfo:=true;
+  StartProgram(true,[supTObject]);
+  AddModuleWithIntfImplSrc('UnitA.pas',
+  LinesToStr([
+  '{$mode objfpc}',
+  '{$modeswitch externalclass}',
+  'type',
+  '  generic TAnt<T> = class external name ''SET''',
+  '    x: T;',
+  '  end;',
+  '']),
+  LinesToStr([
+  'type',
+  '  TBird = record',
+  '    b: word;',
+  '  end;',
+  'var',
+  '  f: specialize TAnt<TBird>;',
+  'begin',
+  '  f.x.b:=f.x.b+10;',
+  '']));
+  Add([
+  'uses UnitA;',
+  'begin',
+  'end.']);
+  ConvertProgram;
+  CheckUnit('UnitA.pas',
+    LinesToStr([ // statements
+    'rtl.module("UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  $mod.$rtti.$ExtClass("TAnt$G1", {',
+    '    jsclass: "SET"',
+    '  });',
+    '  $mod.$init = function () {',
+    '    $impl.f.x.b = $impl.f.x.b + 10;',
+    '  };',
+    '}, null, function () {',
+    '  var $mod = this;',
+    '  var $impl = $mod.$impl;',
+    '  rtl.recNewT($impl, "TBird", function () {',
+    '    this.b = 0;',
+    '    this.$eq = function (b) {',
+    '      return this.b === b.b;',
+    '    };',
+    '    this.$assign = function (s) {',
+    '      this.b = s.b;',
+    '      return this;',
+    '    };',
+    '    var $r = $mod.$rtti.$Record("TBird", {});',
+    '    $r.addField("b", rtl.word);',
+    '  });',
+    '  $impl.f = null;',
+    '});']));
+  CheckSource('TestGen_Class_ClassVarRecord_UnitImpl',
+    LinesToStr([ // statements
+    //'pas.UnitA.TAnt$G1.$initSpec();',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestGenerics.TestGen_ClassInterface_Corba;
 begin
   StartProgram(false);
@@ -2044,6 +2111,61 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_ProcType_ProcLocal;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Fly(w: word);',
+  'begin',
+  'end;',
+  'procedure Run(w: word);',
+  'type generic TProc<T> = procedure(a: T);',
+  'var p: specialize TProc<word>;',
+  'begin',
+  '  p:=@Fly;',
+  '  p(w);',
+  'end;',
+  'begin',
+  'end.']);
+  ConvertProgram;
+  CheckSource('TestGen_ProcType_ProcLocal',
+    LinesToStr([ // statements
+    'this.Fly = function (w) {',
+    '};',
+    'this.Run = function (w) {',
+    '  var p = null;',
+    '  p = $mod.Fly;',
+    '  p(w);',
+    '};',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
+procedure TTestGenerics.TestGen_ProcType_ProcLocal_RTTI;
+begin
+  WithTypeInfo:=true;
+  StartProgram(false);
+  Add([
+  'procedure Fly(w: word);',
+  'begin',
+  'end;',
+  'procedure Run(w: word);',
+  'type generic TProc<T> = procedure(a: T);',
+  'var',
+  '  p: specialize TProc<word>;',
+  '  t: Pointer;',
+  'begin',
+  '  p:=@Fly;',
+  '  p(w);',
+  '  t:=typeinfo(p);',
+  'end;',
+  'begin',
+  'end.']);
+  SetExpectedPasResolverError(sSymbolCannotBePublished,nSymbolCannotBePublished);
+  ConvertProgram;
+end;
+
 procedure TTestGenerics.TestGen_ProcType_ParamUnitImpl;
 begin
   WithTypeInfo:=true;

packages/winunits-base/src/richedit.pp

@@ -692,7 +692,7 @@ Const
      COMPCOLOR = _compcolor;
      TCOMPCOLOR = _compcolor;
 
-     EDITSTREAMCALLBACK = function (dwCookie:PDWORD; pbBuff:LPBYTE; cb:LONG; var pcb:LONG):DWORD;
+     EDITSTREAMCALLBACK = function (dwCookie:DWORD_PTR; pbBuff:LPBYTE; cb:LONG; var pcb:LONG):DWORD;
 
      _editstream = record
           dwCookie : DWORD_PTR;

rtl/objpas/math.pp

@@ -56,10 +56,6 @@ interface
        sysutils;
 
 {$IFDEF FPDOC_MATH}
-{$DEFINE FPC_HAS_TYPE_SINGLE}
-{$DEFINE FPC_HAS_TYPE_DOUBLE}
-{$DEFINE FPC_HAS_TYPE_EXTENDED}
-{$DEFINE FPC_HAS_TYPE_COMP}
 Type
   Float = MaxFloatType;
 
@@ -158,6 +154,17 @@ Const
        NegInfinity = -1.0/0.0;
 {$pop}
 
+
+{$IFDEF FPDOC_MATH}
+
+// This must be after the above defines.
+
+{$DEFINE FPC_HAS_TYPE_SINGLE}
+{$DEFINE FPC_HAS_TYPE_DOUBLE}
+{$DEFINE FPC_HAS_TYPE_EXTENDED}
+{$DEFINE FPC_HAS_TYPE_COMP}
+{$ENDIF}
+
 { Min/max determination }
 function MinIntValue(const Data: array of Integer): Integer;
 function MaxIntValue(const Data: array of Integer): Integer;

rtl/win/sysutils.pp

@@ -476,16 +476,19 @@ begin
             end;
           end;
 
-          Handle := FindFirstFileExW(PUnicodeChar(SymLinkRec.TargetName), FindExInfoDefaults , @SymLinkRec.FindData,
-                      FindExSearchNameMatch, Nil, 0);
-          if Handle <> INVALID_HANDLE_VALUE then begin
-            Windows.FindClose(Handle);
-            SymLinkRec.Attr := SymLinkRec.FindData.dwFileAttributes;
-            SymLinkRec.Size := QWord(SymLinkRec.FindData.nFileSizeHigh) shl 32 + QWord(SymLinkRec.FindData.nFileSizeLow);
-          end else if RaiseErrorOnMissing then
-            raise EDirectoryNotFoundException.Create(SysErrorMessage(GetLastOSError))
-          else
-            SymLinkRec.TargetName := '';
+          if SymLinkRec.TargetName <> '' then begin
+            Handle := FindFirstFileExW(PUnicodeChar(SymLinkRec.TargetName), FindExInfoDefaults , @SymLinkRec.FindData,
+                        FindExSearchNameMatch, Nil, 0);
+            if Handle <> INVALID_HANDLE_VALUE then begin
+              Windows.FindClose(Handle);
+              SymLinkRec.Attr := SymLinkRec.FindData.dwFileAttributes;
+              SymLinkRec.Size := QWord(SymLinkRec.FindData.nFileSizeHigh) shl 32 + QWord(SymLinkRec.FindData.nFileSizeLow);
+            end else if RaiseErrorOnMissing then
+              raise EDirectoryNotFoundException.Create(SysErrorMessage(GetLastOSError))
+            else
+              SymLinkRec.TargetName := '';
+          end else
+            SetLastError(ERROR_REPARSE_TAG_INVALID);
         end else
           SetLastError(ERROR_REPARSE_TAG_INVALID);
       finally

tests/webtbs/tw37650.pp

@@ -0,0 +1,22 @@
+{ %NORUN }
+
+program tw37650;
+
+{$mode objfpc}
+
+type
+  generic TMyClass<const U: Integer> = class
+    type TKey = String[U];
+  end;
+
+generic procedure Test<const U: Integer>;
+type
+  TKey = String[U];
+begin
+end;
+
+type
+  TMyClass12 = specialize TMyClass<12>;
+begin
+  specialize Test<12>;
+end.