mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 21:28:21 +02:00
* synchronized with trunk
git-svn-id: branches/wasm@46771 -
This commit is contained in:
nickysn
commit
13386e603d
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
|
||||
@ -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');
|
||||
|
||||
@ -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]);
|
||||
end
|
||||
else if o is TPasElement 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
|
||||
if TPasArrayType(o).ElType = nil then
|
||||
Result:='array of const'
|
||||
else
|
||||
Result:=o.ClassName;
|
||||
Result:=Format('TArray<%s>', [TPasArrayType(o).ElType.Name]);
|
||||
end
|
||||
else if o is TPasElement 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;
|
||||
end;
|
||||
|
||||
function GetObjPath(o: TObject): string;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
22
tests/webtbs/tw37650.pp
Normal file
22
tests/webtbs/tw37650.pp
Normal file
@ -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.
|
||||
Loading…
Reference in New Issue
Block a user