mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-10 07:26:18 +02:00
* Merged XPCom branch into trunk, added support for constref and changed
the IInterface implementation to be XPCom-compatible --- Merging r15997 through r16179 into '.': U rtl/inc/variants.pp U rtl/inc/objpash.inc U rtl/inc/objpas.inc U rtl/objpas/classes/persist.inc U rtl/objpas/classes/compon.inc U rtl/objpas/classes/classesh.inc A tests/test/tconstref1.pp A tests/test/tconstref2.pp A tests/test/tconstref3.pp U tests/test/tinterface4.pp A tests/test/tconstref4.pp U tests/webtbs/tw10897.pp U tests/webtbs/tw4086.pp U tests/webtbs/tw15363.pp U tests/webtbs/tw2177.pp U tests/webtbs/tw16592.pp U tests/tbs/tb0546.pp U compiler/sparc/cpupara.pas U compiler/i386/cpupara.pas U compiler/pdecsub.pas U compiler/symdef.pas U compiler/powerpc/cpupara.pas U compiler/avr/cpupara.pas U compiler/browcol.pas U compiler/defcmp.pas U compiler/powerpc64/cpupara.pas U compiler/ncgrtti.pas U compiler/x86_64/cpupara.pas U compiler/opttail.pas U compiler/htypechk.pas U compiler/tokens.pas U compiler/objcutil.pas U compiler/ncal.pas U compiler/symtable.pas U compiler/symsym.pas U compiler/m68k/cpupara.pas U compiler/regvars.pas U compiler/arm/cpupara.pas U compiler/symconst.pas U compiler/mips/cpupara.pas U compiler/paramgr.pas U compiler/psub.pas U compiler/pdecvar.pas U compiler/dbgstabs.pas U compiler/options.pas U packages/fcl-fpcunit/src/testutils.pp git-svn-id: trunk@16180 -
This commit is contained in:
parent
8304d2c1c5
commit
07bf44517c
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -9167,6 +9167,10 @@ tests/test/tclassinfo1.pp svneol=native#text/pascal
|
|||||||
tests/test/tclrprop.pp svneol=native#text/plain
|
tests/test/tclrprop.pp svneol=native#text/plain
|
||||||
tests/test/tcmp.pp svneol=native#text/plain
|
tests/test/tcmp.pp svneol=native#text/plain
|
||||||
tests/test/tcmp0.pp svneol=native#text/plain
|
tests/test/tcmp0.pp svneol=native#text/plain
|
||||||
|
tests/test/tconstref1.pp svneol=native#text/pascal
|
||||||
|
tests/test/tconstref2.pp svneol=native#text/pascal
|
||||||
|
tests/test/tconstref3.pp svneol=native#text/pascal
|
||||||
|
tests/test/tconstref4.pp svneol=native#text/pascal
|
||||||
tests/test/tcstring1.pp svneol=native#text/pascal
|
tests/test/tcstring1.pp svneol=native#text/pascal
|
||||||
tests/test/tcstring2.pp svneol=native#text/pascal
|
tests/test/tcstring2.pp svneol=native#text/pascal
|
||||||
tests/test/tdel1.pp svneol=native#text/plain
|
tests/test/tdel1.pp svneol=native#text/plain
|
||||||
|
@ -169,7 +169,7 @@ unit cpupara;
|
|||||||
function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -155,7 +155,7 @@ unit cpupara;
|
|||||||
function tavrparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function tavrparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -1347,6 +1347,7 @@ end;
|
|||||||
vs_Const : CurName:='const '+CurName;
|
vs_Const : CurName:='const '+CurName;
|
||||||
vs_Var : CurName:='var '+CurName;
|
vs_Var : CurName:='var '+CurName;
|
||||||
vs_Out : CurName:='out '+CurName;
|
vs_Out : CurName:='out '+CurName;
|
||||||
|
vs_Constref : CurName:='constref '+CurName;
|
||||||
end;
|
end;
|
||||||
if Count>0 then
|
if Count>0 then
|
||||||
CurName:='; '+CurName;
|
CurName:='; '+CurName;
|
||||||
|
@ -441,6 +441,8 @@ implementation
|
|||||||
argnames:=argnames+'5const';
|
argnames:=argnames+'5const';
|
||||||
vs_out :
|
vs_out :
|
||||||
argnames:=argnames+'3out';
|
argnames:=argnames+'3out';
|
||||||
|
vs_constref :
|
||||||
|
argnames:=argnames+'8constref';
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
@ -1669,8 +1669,8 @@ implementation
|
|||||||
if (
|
if (
|
||||||
not(cpo_ignorevarspez in cpoptions) and
|
not(cpo_ignorevarspez in cpoptions) and
|
||||||
(currpara1.varspez<>currpara2.varspez) and
|
(currpara1.varspez<>currpara2.varspez) and
|
||||||
((currpara1.varspez in [vs_var,vs_out]) or
|
((currpara1.varspez in [vs_var,vs_out,vs_constref]) or
|
||||||
(currpara2.varspez in [vs_var,vs_out]))
|
(currpara2.varspez in [vs_var,vs_out,vs_constref]))
|
||||||
) then
|
) then
|
||||||
exit;
|
exit;
|
||||||
eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn,
|
eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn,
|
||||||
|
@ -1399,7 +1399,7 @@ implementation
|
|||||||
else
|
else
|
||||||
exit;
|
exit;
|
||||||
{ read-only variable? }
|
{ read-only variable? }
|
||||||
if (tabstractvarsym(tloadnode(hp).symtableentry).varspez=vs_const) then
|
if (tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_const,vs_constref]) then
|
||||||
begin
|
begin
|
||||||
{ allow p^:= constructions with p is const parameter }
|
{ allow p^:= constructions with p is const parameter }
|
||||||
if gotderef or gotdynarray or (Valid_Const in opts) or
|
if gotderef or gotdynarray or (Valid_Const in opts) or
|
||||||
|
@ -152,8 +152,8 @@ unit cpupara;
|
|||||||
function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
{ var,out always require address }
|
{ var,out,constref always require address }
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -149,8 +149,8 @@ unit cpupara;
|
|||||||
function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
{ var,out always require address }
|
{ var,out,constref always require address }
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -110,8 +110,8 @@ implementation
|
|||||||
function tMIPSELparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function tMIPSELparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
{ var,out always require address }
|
{ var,out,constref always require address }
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -461,7 +461,7 @@ implementation
|
|||||||
internalerror(200611041);
|
internalerror(200611041);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
dispatchbyref:=(assigned(para.parasym) and (para.parasym.varspez in [vs_var,vs_out])) or
|
dispatchbyref:=(assigned(para.parasym) and (para.parasym.varspez in [vs_var,vs_out,vs_constref])) or
|
||||||
(para.left.resultdef.typ in [variantdef]);
|
(para.left.resultdef.typ in [variantdef]);
|
||||||
|
|
||||||
{ assign the argument/parameter to the temporary location }
|
{ assign the argument/parameter to the temporary location }
|
||||||
@ -836,7 +836,7 @@ implementation
|
|||||||
if (cs_strict_var_strings in current_settings.localswitches) and
|
if (cs_strict_var_strings in current_settings.localswitches) and
|
||||||
is_shortstring(left.resultdef) and
|
is_shortstring(left.resultdef) and
|
||||||
is_shortstring(parasym.vardef) and
|
is_shortstring(parasym.vardef) and
|
||||||
(parasym.varspez in [vs_out,vs_var]) and
|
(parasym.varspez in [vs_out,vs_var,vs_constref]) and
|
||||||
not(is_open_string(parasym.vardef)) and
|
not(is_open_string(parasym.vardef)) and
|
||||||
not(equal_defs(left.resultdef,parasym.vardef)) then
|
not(equal_defs(left.resultdef,parasym.vardef)) then
|
||||||
begin
|
begin
|
||||||
@ -878,6 +878,7 @@ implementation
|
|||||||
|
|
||||||
case parasym.varspez of
|
case parasym.varspez of
|
||||||
vs_var,
|
vs_var,
|
||||||
|
vs_constref,
|
||||||
vs_out :
|
vs_out :
|
||||||
begin
|
begin
|
||||||
if not valid_for_formal_var(left,true) then
|
if not valid_for_formal_var(left,true) then
|
||||||
@ -897,7 +898,7 @@ implementation
|
|||||||
valid_for_var(left,true);
|
valid_for_var(left,true);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
if parasym.varspez in [vs_var,vs_out] then
|
if parasym.varspez in [vs_var,vs_out,vs_constref] then
|
||||||
set_unique(left);
|
set_unique(left);
|
||||||
|
|
||||||
{ When the address needs to be pushed then the register is
|
{ When the address needs to be pushed then the register is
|
||||||
@ -933,7 +934,8 @@ implementation
|
|||||||
set_varstate(left,vs_written,[]);
|
set_varstate(left,vs_written,[]);
|
||||||
set_varstate(left,vs_readwritten,[]);
|
set_varstate(left,vs_readwritten,[]);
|
||||||
end;
|
end;
|
||||||
vs_var :
|
vs_var,
|
||||||
|
vs_constref:
|
||||||
set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
|
set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]);
|
||||||
else
|
else
|
||||||
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
set_varstate(left,vs_read,[vsf_must_be_valid]);
|
||||||
|
@ -662,10 +662,11 @@ implementation
|
|||||||
if not(vo_is_hidden_para in parasym.varoptions) then
|
if not(vo_is_hidden_para in parasym.varoptions) then
|
||||||
begin
|
begin
|
||||||
case parasym.varspez of
|
case parasym.varspez of
|
||||||
vs_value: paraspec := 0;
|
vs_value : paraspec := 0;
|
||||||
vs_const: paraspec := pfConst;
|
vs_const : paraspec := pfConst;
|
||||||
vs_var : paraspec := pfVar;
|
vs_var : paraspec := pfVar;
|
||||||
vs_out : paraspec := pfOut;
|
vs_out : paraspec := pfOut;
|
||||||
|
vs_constref: paraspec := pfConstRef;
|
||||||
end;
|
end;
|
||||||
{ Kylix also seems to always add both pfArray and pfReference
|
{ Kylix also seems to always add both pfArray and pfReference
|
||||||
in this case
|
in this case
|
||||||
|
@ -225,7 +225,7 @@ end;
|
|||||||
{ addencodedtype always assumes a value parameter, so add
|
{ addencodedtype always assumes a value parameter, so add
|
||||||
a pointer indirection for var/out parameters. }
|
a pointer indirection for var/out parameters. }
|
||||||
if not paramanager.push_addr_param(vs_value,vs.vardef,pocall_cdecl) and
|
if not paramanager.push_addr_param(vs_value,vs.vardef,pocall_cdecl) and
|
||||||
(vs.varspez in [vs_var,vs_out]) then
|
(vs.varspez in [vs_var,vs_out,vs_constref]) then
|
||||||
result:=result+'^';
|
result:=result+'^';
|
||||||
{ Add the parameter type. }
|
{ Add the parameter type. }
|
||||||
if not addencodedtype(vs.vardef,ris_initial,false,result,founderror) then
|
if not addencodedtype(vs.vardef,ris_initial,false,result,founderror) then
|
||||||
|
@ -2411,6 +2411,7 @@ begin
|
|||||||
def_system_macro('FPC_STRTOSHORTSTRINGPROC');
|
def_system_macro('FPC_STRTOSHORTSTRINGPROC');
|
||||||
def_system_macro('FPC_OBJFPC_EXTENDED_IF');
|
def_system_macro('FPC_OBJFPC_EXTENDED_IF');
|
||||||
def_system_macro('FPC_HAS_OPERATOR_ENUMERATOR');
|
def_system_macro('FPC_HAS_OPERATOR_ENUMERATOR');
|
||||||
|
def_system_macro('FPC_HAS_CONSTREF');
|
||||||
{$if defined(x86) or defined(powerpc) or defined(powerpc64)}
|
{$if defined(x86) or defined(powerpc) or defined(powerpc64)}
|
||||||
def_system_macro('FPC_HAS_INTERNAL_ABS_LONG');
|
def_system_macro('FPC_HAS_INTERNAL_ABS_LONG');
|
||||||
{$endif}
|
{$endif}
|
||||||
|
@ -185,7 +185,7 @@ unit opttail;
|
|||||||
{ check if the parameters actually would support tail recursion elimination }
|
{ check if the parameters actually would support tail recursion elimination }
|
||||||
for i:=0 to p.paras.count-1 do
|
for i:=0 to p.paras.count-1 do
|
||||||
with tparavarsym(p.paras[i]) do
|
with tparavarsym(p.paras[i]) do
|
||||||
if (varspez in [vs_out,vs_var]) or
|
if (varspez in [vs_out,vs_var,vs_constref]) or
|
||||||
((varspez=vs_const) and
|
((varspez=vs_const) and
|
||||||
(paramanager.push_addr_param(varspez,vardef,p.proccalloption)) or
|
(paramanager.push_addr_param(varspez,vardef,p.proccalloption)) or
|
||||||
{ parameters requiring tables are too complicated to handle
|
{ parameters requiring tables are too complicated to handle
|
||||||
|
@ -185,6 +185,7 @@ implementation
|
|||||||
begin
|
begin
|
||||||
push_size:=-1;
|
push_size:=-1;
|
||||||
case varspez of
|
case varspez of
|
||||||
|
vs_constref,
|
||||||
vs_out,
|
vs_out,
|
||||||
vs_var :
|
vs_var :
|
||||||
push_size:=sizeof(pint);
|
push_size:=sizeof(pint);
|
||||||
|
@ -473,6 +473,9 @@ implementation
|
|||||||
if (m_out in current_settings.modeswitches) and
|
if (m_out in current_settings.modeswitches) and
|
||||||
try_to_consume(_OUT) then
|
try_to_consume(_OUT) then
|
||||||
varspez:=vs_out
|
varspez:=vs_out
|
||||||
|
else
|
||||||
|
if try_to_consume(_CONSTREF) then
|
||||||
|
varspez:=vs_constref
|
||||||
else
|
else
|
||||||
if (m_mac in current_settings.modeswitches) and
|
if (m_mac in current_settings.modeswitches) and
|
||||||
try_to_consume(_POINTPOINTPOINT) then
|
try_to_consume(_POINTPOINTPOINT) then
|
||||||
@ -592,7 +595,7 @@ implementation
|
|||||||
if is_shortstring(hdef) then
|
if is_shortstring(hdef) then
|
||||||
begin
|
begin
|
||||||
case varspez of
|
case varspez of
|
||||||
vs_var,vs_out:
|
vs_var,vs_out,vs_constref:
|
||||||
begin
|
begin
|
||||||
{ not 100% Delphi-compatible: type xstr=string[255] cannot
|
{ not 100% Delphi-compatible: type xstr=string[255] cannot
|
||||||
become an openstring there, while here it can }
|
become an openstring there, while here it can }
|
||||||
|
@ -363,6 +363,8 @@ implementation
|
|||||||
varspez:=vs_var
|
varspez:=vs_var
|
||||||
else if try_to_consume(_CONST) then
|
else if try_to_consume(_CONST) then
|
||||||
varspez:=vs_const
|
varspez:=vs_const
|
||||||
|
else if try_to_consume(_CONSTREF) then
|
||||||
|
varspez:=vs_constref
|
||||||
else if (m_out in current_settings.modeswitches) and try_to_consume(_OUT) then
|
else if (m_out in current_settings.modeswitches) and try_to_consume(_OUT) then
|
||||||
varspez:=vs_out
|
varspez:=vs_out
|
||||||
else
|
else
|
||||||
|
@ -176,8 +176,8 @@ unit cpupara;
|
|||||||
function tppcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function tppcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
{ var,out always require address }
|
{ var,out,constref always require address }
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -159,8 +159,8 @@ function tppcparamanager.push_addr_param(varspez: tvarspez; def: tdef;
|
|||||||
calloption: tproccalloption): boolean;
|
calloption: tproccalloption): boolean;
|
||||||
begin
|
begin
|
||||||
result := false;
|
result := false;
|
||||||
{ var,out always require address }
|
{ var,out,constref always require address }
|
||||||
if varspez in [vs_var, vs_out] then
|
if varspez in [vs_var, vs_out, vs_constref] then
|
||||||
begin
|
begin
|
||||||
result := true;
|
result := true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -1363,7 +1363,7 @@ implementation
|
|||||||
case currpara.vardef.typ of
|
case currpara.vardef.typ of
|
||||||
formaldef :
|
formaldef :
|
||||||
begin
|
begin
|
||||||
if (currpara.varspez in [vs_out,vs_var,vs_const]) then
|
if (currpara.varspez in [vs_out,vs_var,vs_const,vs_constref]) then
|
||||||
begin
|
begin
|
||||||
Message1(parser_w_not_supported_for_inline,'formal parameter');
|
Message1(parser_w_not_supported_for_inline,'formal parameter');
|
||||||
Message(parser_w_inlining_disabled);
|
Message(parser_w_inlining_disabled);
|
||||||
|
@ -69,7 +69,7 @@ implementation
|
|||||||
begin
|
begin
|
||||||
parasym:=pboolean(arg)^;
|
parasym:=pboolean(arg)^;
|
||||||
if (tsym(p).typ=varsym) and ((tvarsym(p).varregable <> vr_none) or
|
if (tsym(p).typ=varsym) and ((tvarsym(p).varregable <> vr_none) or
|
||||||
((tvarsym(p).varspez in [vs_var,vs_const,vs_out]) and
|
((tvarsym(p).varspez in [vs_var,vs_const,vs_out,vs_constref]) and
|
||||||
paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vardef,current_procinfo.procdef.proccalloption))) and
|
paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vardef,current_procinfo.procdef.proccalloption))) and
|
||||||
not tvarsym(p).vardef.needs_inittable then
|
not tvarsym(p).vardef.needs_inittable then
|
||||||
begin
|
begin
|
||||||
|
@ -111,8 +111,8 @@ implementation
|
|||||||
function tsparcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
function tsparcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
{ var,out always require address }
|
{ var,out,constref always require address }
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -101,6 +101,7 @@ const
|
|||||||
pfAddress = 8;
|
pfAddress = 8;
|
||||||
pfReference= 16;
|
pfReference= 16;
|
||||||
pfOut = 32;
|
pfOut = 32;
|
||||||
|
pfConstRef = 64;
|
||||||
|
|
||||||
unknown_level = 0;
|
unknown_level = 0;
|
||||||
main_program_level = 1;
|
main_program_level = 1;
|
||||||
@ -483,7 +484,7 @@ type
|
|||||||
vs_referred_not_inited,vs_written,vs_readwritten
|
vs_referred_not_inited,vs_written,vs_readwritten
|
||||||
);
|
);
|
||||||
|
|
||||||
tvarspez = (vs_value,vs_const,vs_var,vs_out);
|
tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref);
|
||||||
|
|
||||||
absolutetyp = (tovar,toasm,toaddr);
|
absolutetyp = (tovar,toasm,toaddr);
|
||||||
|
|
||||||
|
@ -2948,6 +2948,8 @@ implementation
|
|||||||
s:=s+'const ';
|
s:=s+'const ';
|
||||||
vs_out :
|
vs_out :
|
||||||
s:=s+'out ';
|
s:=s+'out ';
|
||||||
|
vs_constref :
|
||||||
|
s:=s+'constref ';
|
||||||
end;
|
end;
|
||||||
if hp.univpara then
|
if hp.univpara then
|
||||||
s:=s+'univ ';
|
s:=s+'univ ';
|
||||||
|
@ -1402,7 +1402,7 @@ implementation
|
|||||||
constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
|
constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions);
|
||||||
begin
|
begin
|
||||||
inherited create(paravarsym,n,vsp,def,vopts);
|
inherited create(paravarsym,n,vsp,def,vopts);
|
||||||
if (vsp in [vs_var,vs_value,vs_const]) then
|
if (vsp in [vs_var,vs_value,vs_const,vs_constref]) then
|
||||||
varstate := vs_initialised;
|
varstate := vs_initialised;
|
||||||
paranr:=nr;
|
paranr:=nr;
|
||||||
paraloc[calleeside].init;
|
paraloc[calleeside].init;
|
||||||
|
@ -608,7 +608,7 @@ implementation
|
|||||||
begin
|
begin
|
||||||
if (tsym(sym).owner.symtabletype=parasymtable) then
|
if (tsym(sym).owner.symtabletype=parasymtable) then
|
||||||
begin
|
begin
|
||||||
if not(tabstractvarsym(sym).varspez in [vs_var,vs_out]) and
|
if not(tabstractvarsym(sym).varspez in [vs_var,vs_out,vs_constref]) and
|
||||||
not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
|
not(vo_is_funcret in tabstractvarsym(sym).varoptions) then
|
||||||
MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
|
MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname)
|
||||||
end
|
end
|
||||||
|
@ -201,6 +201,7 @@ type
|
|||||||
_ABSOLUTE,
|
_ABSOLUTE,
|
||||||
_ABSTRACT,
|
_ABSTRACT,
|
||||||
_BASESYSV,
|
_BASESYSV,
|
||||||
|
_CONSTREF,
|
||||||
_CONTAINS,
|
_CONTAINS,
|
||||||
_CONTINUE,
|
_CONTINUE,
|
||||||
_CPPCLASS,
|
_CPPCLASS,
|
||||||
@ -463,6 +464,7 @@ const
|
|||||||
(str:'ABSOLUTE' ;special:false;keyword:m_none;op:NOTOKEN),
|
(str:'ABSOLUTE' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||||
(str:'ABSTRACT' ;special:false;keyword:m_none;op:NOTOKEN),
|
(str:'ABSTRACT' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||||
(str:'BASESYSV' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS }
|
(str:'BASESYSV' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS }
|
||||||
|
(str:'CONSTREF' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||||
(str:'CONTAINS' ;special:false;keyword:m_none;op:NOTOKEN),
|
(str:'CONTAINS' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||||
(str:'CONTINUE' ;special:false;keyword:m_none;op:NOTOKEN),
|
(str:'CONTINUE' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||||
(str:'CPPCLASS' ;special:false;keyword:m_fpc;op:NOTOKEN),
|
(str:'CPPCLASS' ;special:false;keyword:m_fpc;op:NOTOKEN),
|
||||||
|
@ -644,8 +644,8 @@ unit cpupara;
|
|||||||
numclasses: longint;
|
numclasses: longint;
|
||||||
begin
|
begin
|
||||||
result:=false;
|
result:=false;
|
||||||
{ var,out always require address }
|
{ var,out,constref always require address }
|
||||||
if varspez in [vs_var,vs_out] then
|
if varspez in [vs_var,vs_out,vs_constref] then
|
||||||
begin
|
begin
|
||||||
result:=true;
|
result:=true;
|
||||||
exit;
|
exit;
|
||||||
|
@ -26,9 +26,9 @@ type
|
|||||||
TNoRefCountObject = class(TObject, IInterface)
|
TNoRefCountObject = class(TObject, IInterface)
|
||||||
protected
|
protected
|
||||||
{ IInterface }
|
{ IInterface }
|
||||||
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
end;
|
end;
|
||||||
{$M-}
|
{$M-}
|
||||||
|
|
||||||
@ -38,18 +38,18 @@ procedure GetMethodList( AClass: TClass; AList: TStrings ); overload;
|
|||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
function TNoRefCountObject.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
function TNoRefCountObject.QueryInterface(constref IID: TGUID; out Obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if GetInterface(IID, Obj) then Result := 0
|
if GetInterface(IID, Obj) then Result := 0
|
||||||
else Result := HRESULT($80004002);
|
else Result := HRESULT($80004002);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TNoRefCountObject._AddRef: Integer;stdcall;
|
function TNoRefCountObject._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
Result := -1;
|
Result := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TNoRefCountObject._Release: Integer;stdcall;
|
function TNoRefCountObject._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
Result := -1;
|
Result := -1;
|
||||||
end;
|
end;
|
||||||
|
@ -967,7 +967,7 @@
|
|||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
|
||||||
function TInterfacedObject.QueryInterface(
|
function TInterfacedObject.QueryInterface(
|
||||||
const iid : tguid;out obj) : longint;stdcall;
|
{$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if getinterface(iid,obj) then
|
if getinterface(iid,obj) then
|
||||||
@ -976,13 +976,13 @@
|
|||||||
result:=longint(E_NOINTERFACE);
|
result:=longint(E_NOINTERFACE);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TInterfacedObject._AddRef : longint;stdcall;
|
function TInterfacedObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
begin
|
begin
|
||||||
_addref:=interlockedincrement(frefcount);
|
_addref:=interlockedincrement(frefcount);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TInterfacedObject._Release : longint;stdcall;
|
function TInterfacedObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
begin
|
begin
|
||||||
_Release:=interlockeddecrement(frefcount);
|
_Release:=interlockeddecrement(frefcount);
|
||||||
@ -1026,19 +1026,19 @@
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function TAggregatedObject.QueryInterface(
|
function TAggregatedObject.QueryInterface(
|
||||||
const iid : tguid;out obj) : longint;stdcall;
|
{$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := IUnknown(fcontroller).QueryInterface(iid, obj);
|
Result := IUnknown(fcontroller).QueryInterface(iid, obj);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TAggregatedObject._AddRef : longint;stdcall;
|
function TAggregatedObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := IUnknown(fcontroller)._AddRef;
|
Result := IUnknown(fcontroller)._AddRef;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TAggregatedObject._Release : longint;stdcall;
|
function TAggregatedObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := IUnknown(fcontroller)._Release;
|
Result := IUnknown(fcontroller)._Release;
|
||||||
@ -1055,7 +1055,7 @@
|
|||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
|
||||||
function TContainedObject.QueryInterface(
|
function TContainedObject.QueryInterface(
|
||||||
const iid : tguid;out obj) : longint; stdcall;
|
{$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if getinterface(iid,obj) then
|
if getinterface(iid,obj) then
|
||||||
|
@ -243,9 +243,9 @@
|
|||||||
|
|
||||||
IUnknown = interface
|
IUnknown = interface
|
||||||
['{00000000-0000-0000-C000-000000000046}']
|
['{00000000-0000-0000-C000-000000000046}']
|
||||||
function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
|
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef : longint;stdcall;
|
function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release : longint;stdcall;
|
function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
end;
|
end;
|
||||||
IInterface = IUnknown;
|
IInterface = IUnknown;
|
||||||
|
|
||||||
@ -283,9 +283,9 @@
|
|||||||
protected
|
protected
|
||||||
frefcount : longint;
|
frefcount : longint;
|
||||||
{ implement methods of IUnknown }
|
{ implement methods of IUnknown }
|
||||||
function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
|
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef : longint;stdcall;
|
function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release : longint;stdcall;
|
function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
public
|
public
|
||||||
procedure AfterConstruction;override;
|
procedure AfterConstruction;override;
|
||||||
procedure BeforeDestruction;override;
|
procedure BeforeDestruction;override;
|
||||||
@ -300,9 +300,9 @@
|
|||||||
function GetController: IUnknown;
|
function GetController: IUnknown;
|
||||||
protected
|
protected
|
||||||
{ implement methods of IUnknown }
|
{ implement methods of IUnknown }
|
||||||
function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
|
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef : longint;stdcall;
|
function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release : longint;stdcall;
|
function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
public
|
public
|
||||||
constructor Create(const aController: IUnknown);
|
constructor Create(const aController: IUnknown);
|
||||||
property Controller : IUnknown read GetController;
|
property Controller : IUnknown read GetController;
|
||||||
@ -310,7 +310,7 @@
|
|||||||
|
|
||||||
TContainedObject = class(TAggregatedObject,IInterface)
|
TContainedObject = class(TAggregatedObject,IInterface)
|
||||||
protected
|
protected
|
||||||
function QueryInterface(const iid : tguid;out obj) : longint;virtual; stdcall;
|
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ some pointer definitions }
|
{ some pointer definitions }
|
||||||
|
@ -161,9 +161,9 @@ type
|
|||||||
private
|
private
|
||||||
FVarType: TVarType;
|
FVarType: TVarType;
|
||||||
protected
|
protected
|
||||||
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
procedure SimplisticClear(var V: TVarData);
|
procedure SimplisticClear(var V: TVarData);
|
||||||
procedure SimplisticCopy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean = False);
|
procedure SimplisticCopy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean = False);
|
||||||
procedure RaiseInvalidOp;
|
procedure RaiseInvalidOp;
|
||||||
@ -3575,19 +3575,19 @@ function Null: Variant; // Null standard constant
|
|||||||
---------------------------------------------------------------------}
|
---------------------------------------------------------------------}
|
||||||
|
|
||||||
{$warnings off}
|
{$warnings off}
|
||||||
function TCustomVariantType.QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
|
function TCustomVariantType.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
NotSupported('TCustomVariantType.QueryInterface');
|
NotSupported('TCustomVariantType.QueryInterface');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TCustomVariantType._AddRef: Integer; stdcall;
|
function TCustomVariantType._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
NotSupported('TCustomVariantType._AddRef');
|
NotSupported('TCustomVariantType._AddRef');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TCustomVariantType._Release: Integer; stdcall;
|
function TCustomVariantType._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
NotSupported('TCustomVariantType._Release');
|
NotSupported('TCustomVariantType._Release');
|
||||||
end;
|
end;
|
||||||
|
@ -403,10 +403,10 @@ type
|
|||||||
FOwnerInterface: IInterface;
|
FOwnerInterface: IInterface;
|
||||||
protected
|
protected
|
||||||
{ IInterface }
|
{ IInterface }
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
public
|
public
|
||||||
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
procedure AfterConstruction; override;
|
procedure AfterConstruction; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1630,9 +1630,9 @@ type
|
|||||||
procedure ValidateContainer(AComponent: TComponent); dynamic;
|
procedure ValidateContainer(AComponent: TComponent); dynamic;
|
||||||
procedure ValidateInsert(AComponent: TComponent); dynamic;
|
procedure ValidateInsert(AComponent: TComponent); dynamic;
|
||||||
{ IUnknown }
|
{ IUnknown }
|
||||||
function QueryInterface(const IID: TGUID; out Obj): Hresult; virtual; stdcall;
|
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): Hresult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function iicrGetComponent: TComponent;
|
function iicrGetComponent: TComponent;
|
||||||
{ IDispatch }
|
{ IDispatch }
|
||||||
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
|
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
|
||||||
|
@ -652,7 +652,7 @@ begin
|
|||||||
Result := False;
|
Result := False;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TComponent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
|
function TComponent.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if Assigned(VCLComObject) then
|
if Assigned(VCLComObject) then
|
||||||
Result := IVCLComObject(VCLComObject).QueryInterface(IID, Obj)
|
Result := IVCLComObject(VCLComObject).QueryInterface(IID, Obj)
|
||||||
@ -663,7 +663,7 @@ begin
|
|||||||
Result := E_NOINTERFACE;
|
Result := E_NOINTERFACE;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TComponent._AddRef: Integer;stdcall;
|
function TComponent._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if Assigned(VCLComObject) then
|
if Assigned(VCLComObject) then
|
||||||
Result := IVCLComObject(VCLComObject)._AddRef
|
Result := IVCLComObject(VCLComObject)._AddRef
|
||||||
@ -671,7 +671,7 @@ begin
|
|||||||
Result := -1;
|
Result := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TComponent._Release: Integer;stdcall;
|
function TComponent._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if Assigned(VCLComObject) then
|
if Assigned(VCLComObject) then
|
||||||
Result := IVCLComObject(VCLComObject)._Release
|
Result := IVCLComObject(VCLComObject)._Release
|
||||||
|
@ -91,7 +91,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TInterfacedPersistent._AddRef: Integer;stdcall;
|
function TInterfacedPersistent._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if assigned(FOwnerInterface) then
|
if assigned(FOwnerInterface) then
|
||||||
Result:=FOwnerInterface._AddRef
|
Result:=FOwnerInterface._AddRef
|
||||||
@ -100,7 +100,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TInterfacedPersistent._Release: Integer;stdcall;
|
function TInterfacedPersistent._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if assigned(FOwnerInterface) then
|
if assigned(FOwnerInterface) then
|
||||||
Result:=FOwnerInterface._Release
|
Result:=FOwnerInterface._Release
|
||||||
@ -109,7 +109,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function TInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
|
function TInterfacedPersistent.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} IID: TGUID; out Obj): HResult;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if GetInterface(IID, Obj) then
|
if GetInterface(IID, Obj) then
|
||||||
Result:=0
|
Result:=0
|
||||||
|
@ -41,9 +41,9 @@ type
|
|||||||
private
|
private
|
||||||
FInnerX: TInnerObject;
|
FInnerX: TInnerObject;
|
||||||
protected
|
protected
|
||||||
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function GetX: TInnerObject; virtual;
|
function GetX: TInnerObject; virtual;
|
||||||
function GetY: IYInterface;
|
function GetY: IYInterface;
|
||||||
public
|
public
|
||||||
@ -96,7 +96,7 @@ begin
|
|||||||
result := -1;
|
result := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult;
|
function TFoo.QueryInterface(constref IID: TGUID; out Obj): HResult;
|
||||||
begin
|
begin
|
||||||
if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
|
if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE;
|
||||||
end;function TFoo.GetX: TInnerObject;
|
end;function TFoo.GetX: TInnerObject;
|
||||||
|
53
tests/test/tconstref1.pp
Normal file
53
tests/test/tconstref1.pp
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
program tConstRef1;
|
||||||
|
|
||||||
|
{$mode objfpc}{$h+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
TConstRefProc = procedure(constref AParam: integer);
|
||||||
|
|
||||||
|
TAClass = class(tobject)
|
||||||
|
private
|
||||||
|
function GetSomething(constref int:integer): integer;
|
||||||
|
public
|
||||||
|
property Something[constref int:integer] : integer read getSomething;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAClass.GetSomething(constref int: integer): integer;
|
||||||
|
begin
|
||||||
|
if int<>$1234567 then
|
||||||
|
halt(1);
|
||||||
|
result := $54321;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRef(constref AParam: integer); [public, alias: '_TESTCONSTREF'];
|
||||||
|
begin
|
||||||
|
if AParam<>$1234567 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefAlias(AParam: PInteger); [external name '_TESTCONSTREF'];
|
||||||
|
|
||||||
|
const c = $1234567;
|
||||||
|
var a: integer;
|
||||||
|
aclass: TAClass;
|
||||||
|
p: TConstRefProc;
|
||||||
|
|
||||||
|
begin
|
||||||
|
a := $1234567;
|
||||||
|
TestConstRef(a);
|
||||||
|
TestConstRef(c);
|
||||||
|
TestConstRef($1234567);
|
||||||
|
TestConstRefAlias(@a);
|
||||||
|
|
||||||
|
aclass := TAClass.Create;
|
||||||
|
if aclass.Something[a]<>$54321 then
|
||||||
|
halt(1);
|
||||||
|
aclass.Free;
|
||||||
|
|
||||||
|
p := @TestConstRef;
|
||||||
|
p(c);
|
||||||
|
end.
|
||||||
|
|
12
tests/test/tconstref2.pp
Normal file
12
tests/test/tconstref2.pp
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
{ %fail }
|
||||||
|
program tConstRef2;
|
||||||
|
|
||||||
|
procedure TestConstRef(constref AParam: integer);
|
||||||
|
begin
|
||||||
|
AParam := 5;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
TestConstRef(1);
|
||||||
|
end.
|
||||||
|
|
82
tests/test/tconstref3.pp
Normal file
82
tests/test/tconstref3.pp
Normal file
@ -0,0 +1,82 @@
|
|||||||
|
program tconstref3;
|
||||||
|
|
||||||
|
{$mode objfpc}{$h+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
const
|
||||||
|
CGuid: TGuid = '{67BD8D43-8960-491C-AA3A-50EC74A02F36}';
|
||||||
|
|
||||||
|
type
|
||||||
|
PSmallRecord = ^TSmallRecord;
|
||||||
|
TSmallRecord = record
|
||||||
|
p: PtrInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PAclass = ^TAclass;
|
||||||
|
TAclass = class
|
||||||
|
public
|
||||||
|
p: PtrInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefIntegerAlias(AParam: PInteger); [external name '_TESTCONSTREFINTEGER'];
|
||||||
|
procedure TestConstRefInteger(constref AParam: integer); [public, alias: '_TESTCONSTREFINTEGER'];
|
||||||
|
begin
|
||||||
|
if AParam<>$1234567 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefStringAlias(AParam: PString); [external name '_TESTCONSTREFSTRING'];
|
||||||
|
procedure TestConstRefString(constref AParam: String); [public, alias: '_TESTCONSTREFSTRING'];
|
||||||
|
begin
|
||||||
|
if AParam<>'1234567' then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefGUIDAlias(AParam: PGuid); [external name '_TESTCONSTREFGUID'];
|
||||||
|
procedure TestConstRefGUID(constref AParam: TGuid); [public, alias: '_TESTCONSTREFGUID'];
|
||||||
|
begin
|
||||||
|
if GUIDToString(AParam)<>'{67BD8D43-8960-491C-AA3A-50EC74A02F36}' then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefRecordAlias(AParam: PSmallRecord); [external name '_TESTCONSTREFRECORD'];
|
||||||
|
procedure TestConstRefRecord(constref AParam: TSmallRecord); [public, alias: '_TESTCONSTREFRECORD'];
|
||||||
|
begin
|
||||||
|
if AParam.p<>$7654321 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefClassAlias(AParam: PAClass); [external name '_TESTCONSTREFCLASS'];
|
||||||
|
procedure TestConstRefClass(constref AParam: TAClass); [public, alias: '_TESTCONSTREFCLASS'];
|
||||||
|
begin
|
||||||
|
if AParam.p<>$3456789 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var a: integer;
|
||||||
|
s: string;
|
||||||
|
p: tguid;
|
||||||
|
sr: TSmallRecord;
|
||||||
|
ac: TAclass;
|
||||||
|
|
||||||
|
begin
|
||||||
|
a := $1234567;
|
||||||
|
TestConstRefIntegerAlias(@a);
|
||||||
|
|
||||||
|
s := '1234567';
|
||||||
|
TestConstRefStringAlias(@s);
|
||||||
|
|
||||||
|
p := CGuid;
|
||||||
|
TestConstRefGUIDAlias(@p);
|
||||||
|
|
||||||
|
sr.p:=$7654321;
|
||||||
|
TestConstRefRecordAlias(@sr);
|
||||||
|
|
||||||
|
ac := TAclass.Create;
|
||||||
|
ac.p := $3456789;
|
||||||
|
TestConstRefClassAlias(@ac);
|
||||||
|
ac.Free;
|
||||||
|
end.
|
||||||
|
|
41
tests/test/tconstref4.pp
Normal file
41
tests/test/tconstref4.pp
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
program tconstref4;
|
||||||
|
|
||||||
|
{$mode objfpc}{$h+}
|
||||||
|
|
||||||
|
procedure TestConstRefSafecallAlias(AParam: PInteger); safecall; [external name '_TESTCONSTREFSAFECALL'];
|
||||||
|
procedure TestConstRefSafecall(constref AParam: integer); safecall; [public, alias: '_TESTCONSTREFSAFECALL'];
|
||||||
|
begin
|
||||||
|
if AParam<>$1234567 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefCdeclAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFCDECL'];
|
||||||
|
procedure TestConstRefCdecl(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFCDECL'];
|
||||||
|
begin
|
||||||
|
if AParam<>$1234567 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefStdcallAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFSTDCALL'];
|
||||||
|
procedure TestConstRefStdcall(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFSTDCALL'];
|
||||||
|
begin
|
||||||
|
if AParam<>$1234567 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestConstRefRegisterAlias(AParam: PInteger); cdecl; [external name '_TESTCONSTREFREGISTER'];
|
||||||
|
procedure TestConstRefRegister(constref AParam: integer); cdecl; [public, alias: '_TESTCONSTREFREGISTER'];
|
||||||
|
begin
|
||||||
|
if AParam<>$1234567 then
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
var a : integer;
|
||||||
|
begin
|
||||||
|
a := $1234567;
|
||||||
|
TestConstRefSafecallAlias(@a);
|
||||||
|
TestConstRefStdcallAlias(@a);
|
||||||
|
TestConstRefRegisterAlias(@a);
|
||||||
|
TestConstRefCdeclAlias(@a);
|
||||||
|
end.
|
||||||
|
|
@ -13,9 +13,9 @@ type
|
|||||||
end;
|
end;
|
||||||
TA = class(TObject, IA, IInterface)
|
TA = class(TObject, IA, IInterface)
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
|
function QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
procedure AfterConstruction; override;
|
procedure AfterConstruction; override;
|
||||||
class function NewInstance: TObject; override;
|
class function NewInstance: TObject; override;
|
||||||
end;
|
end;
|
||||||
@ -32,13 +32,13 @@ begin
|
|||||||
inherited AfterConstruction;
|
inherited AfterConstruction;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TA._AddRef: Integer; stdcall;
|
function TA._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
InterlockedIncrement(fRefCount);
|
InterlockedIncrement(fRefCount);
|
||||||
Result := 0;
|
Result := 0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TA._Release: Integer; stdcall;
|
function TA._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
InterlockedDecrement(fRefCount);
|
InterlockedDecrement(fRefCount);
|
||||||
if fRefCount = 0 then begin
|
if fRefCount = 0 then begin
|
||||||
@ -49,7 +49,7 @@ begin
|
|||||||
Result := 0;
|
Result := 0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TA.QueryInterface(const iid: TGuid; out obj): HResult; stdcall;
|
function TA.QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
Result := E_NOINTERFACE;
|
Result := E_NOINTERFACE;
|
||||||
end;
|
end;
|
||||||
|
@ -22,9 +22,9 @@ type
|
|||||||
fRef: Integer;
|
fRef: Integer;
|
||||||
public
|
public
|
||||||
function GetOwner: IMyIntf;
|
function GetOwner: IMyIntf;
|
||||||
function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
|
function QueryInterface(constref IID: TGUID; out Obj): HRESULT; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
procedure Poing;
|
procedure Poing;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -52,7 +52,7 @@ begin
|
|||||||
Writeln('GetOwner2');
|
Writeln('GetOwner2');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TMYClass.QueryInterface(const IID: TGUID; out Obj): HRESULT;
|
function TMYClass.QueryInterface(constref IID: TGUID; out Obj): HRESULT;
|
||||||
begin
|
begin
|
||||||
if GetInterface(IID, Obj) then
|
if GetInterface(IID, Obj) then
|
||||||
result := S_OK else result := -1;
|
result := S_OK else result := -1;
|
||||||
|
@ -10,18 +10,18 @@ type
|
|||||||
TTestBE = class (TObject, ITest)
|
TTestBE = class (TObject, ITest)
|
||||||
function TestIt: integer;
|
function TestIt: integer;
|
||||||
{ IInterface }
|
{ IInterface }
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
End;
|
End;
|
||||||
|
|
||||||
TTest = class (TPersistent, IInterface)
|
TTest = class (TPersistent, IInterface)
|
||||||
BE : TTestBE;
|
BE : TTestBE;
|
||||||
protected
|
protected
|
||||||
{ IInterface }
|
{ IInterface }
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall;
|
function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
End;
|
End;
|
||||||
|
|
||||||
function TTestBE.TestIt : integer;
|
function TTestBE.TestIt : integer;
|
||||||
@ -39,7 +39,7 @@ begin
|
|||||||
Result := -1;
|
Result := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TTest.QueryInterface(const IID: TGUID; out Obj): HResult;
|
function TTest.QueryInterface(constref IID: TGUID; out Obj): HResult;
|
||||||
begin
|
begin
|
||||||
Result := BE.QueryInterface(IID, obj);
|
Result := BE.QueryInterface(IID, obj);
|
||||||
end;
|
end;
|
||||||
@ -54,7 +54,7 @@ begin
|
|||||||
Result := -1;
|
Result := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TTestBE.QueryInterface(const IID: TGUID; out Obj): HResult;
|
function TTestBE.QueryInterface(constref IID: TGUID; out Obj): HResult;
|
||||||
begin
|
begin
|
||||||
if GetInterface(IID, Obj)
|
if GetInterface(IID, Obj)
|
||||||
then Result := 0
|
then Result := 0
|
||||||
|
@ -24,9 +24,9 @@ type
|
|||||||
protected
|
protected
|
||||||
FRefCount : longint;
|
FRefCount : longint;
|
||||||
public
|
public
|
||||||
function QueryInterface(const iid : tguid;out obj) : longint;stdcall;
|
function QueryInterface(constref iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef : longint;stdcall;
|
function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release : longint;stdcall;
|
function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
constructor Create;
|
constructor Create;
|
||||||
|
|
||||||
@ -96,7 +96,7 @@ end;
|
|||||||
WriteLn(Format('%s Obj=$%P class=%s RefCount=%d', [Str, Pointer(Self), ClassName, FRefCount]));
|
WriteLn(Format('%s Obj=$%P class=%s RefCount=%d', [Str, Pointer(Self), ClassName, FRefCount]));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdcall;
|
function TInterfacedObj.QueryInterface(constref iid: tguid; out obj): longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
Result:=GetInterface(iid, obj);
|
Result:=GetInterface(iid, obj);
|
||||||
|
|
||||||
@ -105,7 +105,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca
|
|||||||
Result:=FOwner.QueryInterface(iid, obj);
|
Result:=FOwner.QueryInterface(iid, obj);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TInterfacedObj._AddRef : longint;stdcall;[public,alias:'TInterfacedObj_AddRef'];
|
function TInterfacedObj._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};[public,alias:'TInterfacedObj_AddRef'];
|
||||||
begin
|
begin
|
||||||
if not FDestructorCalled then
|
if not FDestructorCalled then
|
||||||
begin
|
begin
|
||||||
@ -117,7 +117,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TInterfacedObj._Release : longint;stdcall;
|
function TInterfacedObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
if FDestructorCalled then Exit;
|
if FDestructorCalled then Exit;
|
||||||
|
|
||||||
|
@ -16,25 +16,25 @@ type
|
|||||||
|
|
||||||
Twii= class(TObject, ii)
|
Twii= class(TObject, ii)
|
||||||
s: string;
|
s: string;
|
||||||
function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
|
function QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _AddRef: Integer; stdcall;
|
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _Release: Integer; stdcall;
|
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
|
|
||||||
procedure Show;stdcall;
|
procedure Show;stdcall;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{________doomy interfaces______}
|
{________doomy interfaces______}
|
||||||
function Twii.QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
|
function Twii.QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
result:= -1;
|
result:= -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function Twii._AddRef: Integer; stdcall;
|
function Twii._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
result:= -1;
|
result:= -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function Twii._Release: Integer; stdcall;
|
function Twii._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
result:= -1;
|
result:= -1;
|
||||||
end;
|
end;
|
||||||
|
@ -19,9 +19,9 @@ type
|
|||||||
|
|
||||||
ttestclass1 = class(tobject,itest)
|
ttestclass1 = class(tobject,itest)
|
||||||
public
|
public
|
||||||
function queryinterface(const guid: tguid; out obj): hresult; stdcall;
|
function queryinterface(constref guid: tguid; out obj): hresult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _addref: integer; stdcall;
|
function _addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
function _release: integer; stdcall;
|
function _release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
procedure testproc;
|
procedure testproc;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -32,19 +32,19 @@ type
|
|||||||
|
|
||||||
{ ttestclass1 }
|
{ ttestclass1 }
|
||||||
|
|
||||||
function ttestclass1.queryinterface(const guid: tguid; out obj): hresult; stdcall;
|
function ttestclass1.queryinterface(constref guid: tguid; out obj): hresult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
result:= integer(e_nointerface);
|
result:= integer(e_nointerface);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function ttestclass1._addref: integer; stdcall;
|
function ttestclass1._addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
writeln('addref called');
|
writeln('addref called');
|
||||||
// result:= inherited _addref;
|
// result:= inherited _addref;
|
||||||
result:= -1;
|
result:= -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function ttestclass1._release: integer; stdcall;
|
function ttestclass1._release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
|
||||||
begin
|
begin
|
||||||
writeln('release called');
|
writeln('release called');
|
||||||
// result:= inherited _release;
|
// result:= inherited _release;
|
||||||
|
Loading…
Reference in New Issue
Block a user