From 07bf44517c81a35479925ff39ecbbcb352981770 Mon Sep 17 00:00:00 2001 From: joost Date: Sun, 17 Oct 2010 20:58:22 +0000 Subject: [PATCH] * 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 - --- .gitattributes | 4 ++ compiler/arm/cpupara.pas | 2 +- compiler/avr/cpupara.pas | 2 +- compiler/browcol.pas | 9 +-- compiler/dbgstabs.pas | 2 + compiler/defcmp.pas | 4 +- compiler/htypechk.pas | 2 +- compiler/i386/cpupara.pas | 4 +- compiler/m68k/cpupara.pas | 4 +- compiler/mips/cpupara.pas | 4 +- compiler/ncal.pas | 10 ++-- compiler/ncgrtti.pas | 9 +-- compiler/objcutil.pas | 2 +- compiler/options.pas | 1 + compiler/opttail.pas | 2 +- compiler/paramgr.pas | 1 + compiler/pdecsub.pas | 5 +- compiler/pdecvar.pas | 2 + compiler/powerpc/cpupara.pas | 4 +- compiler/powerpc64/cpupara.pas | 4 +- compiler/psub.pas | 2 +- compiler/regvars.pas | 2 +- compiler/sparc/cpupara.pas | 4 +- compiler/symconst.pas | 3 +- compiler/symdef.pas | 2 + compiler/symsym.pas | 2 +- compiler/symtable.pas | 2 +- compiler/tokens.pas | 2 + compiler/x86_64/cpupara.pas | 4 +- packages/fcl-fpcunit/src/testutils.pp | 12 ++-- rtl/inc/objpas.inc | 14 ++--- rtl/inc/objpash.inc | 20 +++---- rtl/inc/variants.pp | 12 ++-- rtl/objpas/classes/classesh.inc | 12 ++-- rtl/objpas/classes/compon.inc | 6 +- rtl/objpas/classes/persist.inc | 6 +- tests/tbs/tb0546.pp | 8 +-- tests/test/tconstref1.pp | 53 +++++++++++++++++ tests/test/tconstref2.pp | 12 ++++ tests/test/tconstref3.pp | 82 +++++++++++++++++++++++++++ tests/test/tconstref4.pp | 41 ++++++++++++++ tests/test/tinterface4.pp | 12 ++-- tests/webtbs/tw10897.pp | 8 +-- tests/webtbs/tw15363.pp | 16 +++--- tests/webtbs/tw16592.pp | 12 ++-- tests/webtbs/tw2177.pp | 12 ++-- tests/webtbs/tw4086.pp | 12 ++-- 47 files changed, 330 insertions(+), 120 deletions(-) create mode 100644 tests/test/tconstref1.pp create mode 100644 tests/test/tconstref2.pp create mode 100644 tests/test/tconstref3.pp create mode 100644 tests/test/tconstref4.pp diff --git a/.gitattributes b/.gitattributes index 4830649daf..3cfba149f2 100644 --- a/.gitattributes +++ b/.gitattributes @@ -9167,6 +9167,10 @@ tests/test/tclassinfo1.pp svneol=native#text/pascal tests/test/tclrprop.pp svneol=native#text/plain tests/test/tcmp.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/tcstring2.pp svneol=native#text/pascal tests/test/tdel1.pp svneol=native#text/plain diff --git a/compiler/arm/cpupara.pas b/compiler/arm/cpupara.pas index 443cdaafdd..338e2d5216 100644 --- a/compiler/arm/cpupara.pas +++ b/compiler/arm/cpupara.pas @@ -169,7 +169,7 @@ unit cpupara; function tarmparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin result:=false; - if varspez in [vs_var,vs_out] then + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/compiler/avr/cpupara.pas b/compiler/avr/cpupara.pas index 84983b4efc..0fe2577013 100644 --- a/compiler/avr/cpupara.pas +++ b/compiler/avr/cpupara.pas @@ -155,7 +155,7 @@ unit cpupara; function tavrparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin result:=false; - if varspez in [vs_var,vs_out] then + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/compiler/browcol.pas b/compiler/browcol.pas index f88c928d62..183063be35 100644 --- a/compiler/browcol.pas +++ b/compiler/browcol.pas @@ -1343,10 +1343,11 @@ end; CurName:=': '+GetDefinitionStr(dc.vardef); CurName:=dc.RealName+CurName; case dc.varspez of - vs_Value : ; - vs_Const : CurName:='const '+CurName; - vs_Var : CurName:='var '+CurName; - vs_Out : CurName:='out '+CurName; + vs_Value : ; + vs_Const : CurName:='const '+CurName; + vs_Var : CurName:='var '+CurName; + vs_Out : CurName:='out '+CurName; + vs_Constref : CurName:='constref '+CurName; end; if Count>0 then CurName:='; '+CurName; diff --git a/compiler/dbgstabs.pas b/compiler/dbgstabs.pas index 22429b2901..941ff22f3c 100644 --- a/compiler/dbgstabs.pas +++ b/compiler/dbgstabs.pas @@ -441,6 +441,8 @@ implementation argnames:=argnames+'5const'; vs_out : argnames:=argnames+'3out'; + vs_constref : + argnames:=argnames+'8constref'; end; end else diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index cb3d7ab6ba..99deca5220 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -1669,8 +1669,8 @@ implementation if ( not(cpo_ignorevarspez in cpoptions) and (currpara1.varspez<>currpara2.varspez) and - ((currpara1.varspez in [vs_var,vs_out]) or - (currpara2.varspez in [vs_var,vs_out])) + ((currpara1.varspez in [vs_var,vs_out,vs_constref]) or + (currpara2.varspez in [vs_var,vs_out,vs_constref])) ) then exit; eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn, diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index dfff0dc3b4..17369e8f8c 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -1399,7 +1399,7 @@ implementation else exit; { 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 { allow p^:= constructions with p is const parameter } if gotderef or gotdynarray or (Valid_Const in opts) or diff --git a/compiler/i386/cpupara.pas b/compiler/i386/cpupara.pas index 8c77b80835..01c9fe55bf 100644 --- a/compiler/i386/cpupara.pas +++ b/compiler/i386/cpupara.pas @@ -152,8 +152,8 @@ unit cpupara; function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin result:=false; - { var,out always require address } - if varspez in [vs_var,vs_out] then + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas index f2593510a7..285f621b1b 100644 --- a/compiler/m68k/cpupara.pas +++ b/compiler/m68k/cpupara.pas @@ -149,8 +149,8 @@ unit cpupara; function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin result:=false; - { var,out always require address } - if varspez in [vs_var,vs_out] then + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/compiler/mips/cpupara.pas b/compiler/mips/cpupara.pas index edbf35cfde..c440940943 100644 --- a/compiler/mips/cpupara.pas +++ b/compiler/mips/cpupara.pas @@ -110,8 +110,8 @@ implementation function tMIPSELparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin result:=false; - { var,out always require address } - if varspez in [vs_var,vs_out] then + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 76e8c51641..88eb44e727 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -461,7 +461,7 @@ implementation internalerror(200611041); 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]); { assign the argument/parameter to the temporary location } @@ -836,7 +836,7 @@ implementation if (cs_strict_var_strings in current_settings.localswitches) and is_shortstring(left.resultdef) 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(equal_defs(left.resultdef,parasym.vardef)) then begin @@ -878,6 +878,7 @@ implementation case parasym.varspez of vs_var, + vs_constref, vs_out : begin if not valid_for_formal_var(left,true) then @@ -897,7 +898,7 @@ implementation valid_for_var(left,true); end; - if parasym.varspez in [vs_var,vs_out] then + if parasym.varspez in [vs_var,vs_out,vs_constref] then set_unique(left); { 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_readwritten,[]); end; - vs_var : + vs_var, + vs_constref: set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]); else set_varstate(left,vs_read,[vsf_must_be_valid]); diff --git a/compiler/ncgrtti.pas b/compiler/ncgrtti.pas index a2ef23c504..9505dd20f7 100644 --- a/compiler/ncgrtti.pas +++ b/compiler/ncgrtti.pas @@ -662,10 +662,11 @@ implementation if not(vo_is_hidden_para in parasym.varoptions) then begin case parasym.varspez of - vs_value: paraspec := 0; - vs_const: paraspec := pfConst; - vs_var : paraspec := pfVar; - vs_out : paraspec := pfOut; + vs_value : paraspec := 0; + vs_const : paraspec := pfConst; + vs_var : paraspec := pfVar; + vs_out : paraspec := pfOut; + vs_constref: paraspec := pfConstRef; end; { Kylix also seems to always add both pfArray and pfReference in this case diff --git a/compiler/objcutil.pas b/compiler/objcutil.pas index bea1cb36f2..418da12b2c 100644 --- a/compiler/objcutil.pas +++ b/compiler/objcutil.pas @@ -225,7 +225,7 @@ end; { addencodedtype always assumes a value parameter, so add a pointer indirection for var/out parameters. } 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+'^'; { Add the parameter type. } if not addencodedtype(vs.vardef,ris_initial,false,result,founderror) then diff --git a/compiler/options.pas b/compiler/options.pas index d1a6eaf22a..6239ca7e40 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -2411,6 +2411,7 @@ begin def_system_macro('FPC_STRTOSHORTSTRINGPROC'); def_system_macro('FPC_OBJFPC_EXTENDED_IF'); def_system_macro('FPC_HAS_OPERATOR_ENUMERATOR'); + def_system_macro('FPC_HAS_CONSTREF'); {$if defined(x86) or defined(powerpc) or defined(powerpc64)} def_system_macro('FPC_HAS_INTERNAL_ABS_LONG'); {$endif} diff --git a/compiler/opttail.pas b/compiler/opttail.pas index 0974afc19e..c6659c39a5 100644 --- a/compiler/opttail.pas +++ b/compiler/opttail.pas @@ -185,7 +185,7 @@ unit opttail; { check if the parameters actually would support tail recursion elimination } for i:=0 to p.paras.count-1 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 (paramanager.push_addr_param(varspez,vardef,p.proccalloption)) or { parameters requiring tables are too complicated to handle diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas index 9de9460142..d5c79b5596 100644 --- a/compiler/paramgr.pas +++ b/compiler/paramgr.pas @@ -185,6 +185,7 @@ implementation begin push_size:=-1; case varspez of + vs_constref, vs_out, vs_var : push_size:=sizeof(pint); diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index ef338743df..53787cfb13 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -473,6 +473,9 @@ implementation if (m_out in current_settings.modeswitches) and try_to_consume(_OUT) then varspez:=vs_out + else + if try_to_consume(_CONSTREF) then + varspez:=vs_constref else if (m_mac in current_settings.modeswitches) and try_to_consume(_POINTPOINTPOINT) then @@ -592,7 +595,7 @@ implementation if is_shortstring(hdef) then begin case varspez of - vs_var,vs_out: + vs_var,vs_out,vs_constref: begin { not 100% Delphi-compatible: type xstr=string[255] cannot become an openstring there, while here it can } diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index 1a266f020c..17da0f24e8 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -363,6 +363,8 @@ implementation varspez:=vs_var else if try_to_consume(_CONST) then 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 varspez:=vs_out else diff --git a/compiler/powerpc/cpupara.pas b/compiler/powerpc/cpupara.pas index 114fa92487..1ee35eb781 100644 --- a/compiler/powerpc/cpupara.pas +++ b/compiler/powerpc/cpupara.pas @@ -176,8 +176,8 @@ unit cpupara; function tppcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin result:=false; - { var,out always require address } - if varspez in [vs_var,vs_out] then + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/compiler/powerpc64/cpupara.pas b/compiler/powerpc64/cpupara.pas index e15ec41d13..f856eac6a2 100644 --- a/compiler/powerpc64/cpupara.pas +++ b/compiler/powerpc64/cpupara.pas @@ -159,8 +159,8 @@ function tppcparamanager.push_addr_param(varspez: tvarspez; def: tdef; calloption: tproccalloption): boolean; begin result := false; - { var,out always require address } - if varspez in [vs_var, vs_out] then + { var,out,constref always require address } + if varspez in [vs_var, vs_out, vs_constref] then begin result := true; exit; diff --git a/compiler/psub.pas b/compiler/psub.pas index 102302fec6..889fac0ef8 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -1363,7 +1363,7 @@ implementation case currpara.vardef.typ of formaldef : 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 Message1(parser_w_not_supported_for_inline,'formal parameter'); Message(parser_w_inlining_disabled); diff --git a/compiler/regvars.pas b/compiler/regvars.pas index c5120c7552..4f75c0bd7d 100644 --- a/compiler/regvars.pas +++ b/compiler/regvars.pas @@ -69,7 +69,7 @@ implementation begin parasym:=pboolean(arg)^; 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 not tvarsym(p).vardef.needs_inittable then begin diff --git a/compiler/sparc/cpupara.pas b/compiler/sparc/cpupara.pas index eb06c59261..41de8d71f5 100644 --- a/compiler/sparc/cpupara.pas +++ b/compiler/sparc/cpupara.pas @@ -111,8 +111,8 @@ implementation function tsparcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; begin result:=false; - { var,out always require address } - if varspez in [vs_var,vs_out] then + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 05bd236bb2..122c76cd72 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -101,6 +101,7 @@ const pfAddress = 8; pfReference= 16; pfOut = 32; + pfConstRef = 64; unknown_level = 0; main_program_level = 1; @@ -483,7 +484,7 @@ type 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); diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 1aa629a377..554b1fa27a 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -2948,6 +2948,8 @@ implementation s:=s+'const '; vs_out : s:=s+'out '; + vs_constref : + s:=s+'constref '; end; if hp.univpara then s:=s+'univ '; diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 9fc2d08640..1b1737b208 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -1402,7 +1402,7 @@ implementation constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions); begin 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; paranr:=nr; paraloc[calleeside].init; diff --git a/compiler/symtable.pas b/compiler/symtable.pas index b403e2aaf6..dc0509ba8f 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -608,7 +608,7 @@ implementation begin if (tsym(sym).owner.symtabletype=parasymtable) then 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 MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname) end diff --git a/compiler/tokens.pas b/compiler/tokens.pas index 1074583027..fb54bc8a4c 100644 --- a/compiler/tokens.pas +++ b/compiler/tokens.pas @@ -201,6 +201,7 @@ type _ABSOLUTE, _ABSTRACT, _BASESYSV, + _CONSTREF, _CONTAINS, _CONTINUE, _CPPCLASS, @@ -463,6 +464,7 @@ const (str:'ABSOLUTE' ;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:'CONSTREF' ;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:'CPPCLASS' ;special:false;keyword:m_fpc;op:NOTOKEN), diff --git a/compiler/x86_64/cpupara.pas b/compiler/x86_64/cpupara.pas index c64c6d171b..a529ccbc88 100644 --- a/compiler/x86_64/cpupara.pas +++ b/compiler/x86_64/cpupara.pas @@ -644,8 +644,8 @@ unit cpupara; numclasses: longint; begin result:=false; - { var,out always require address } - if varspez in [vs_var,vs_out] then + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then begin result:=true; exit; diff --git a/packages/fcl-fpcunit/src/testutils.pp b/packages/fcl-fpcunit/src/testutils.pp index f331faa5c1..684b11bc0d 100644 --- a/packages/fcl-fpcunit/src/testutils.pp +++ b/packages/fcl-fpcunit/src/testutils.pp @@ -26,9 +26,9 @@ type TNoRefCountObject = class(TObject, IInterface) protected { IInterface } - function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; + function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; end; {$M-} @@ -38,18 +38,18 @@ procedure GetMethodList( AClass: TClass; AList: TStrings ); overload; 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 if GetInterface(IID, Obj) then Result := 0 else Result := HRESULT($80004002); end; -function TNoRefCountObject._AddRef: Integer;stdcall; +function TNoRefCountObject._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin Result := -1; end; -function TNoRefCountObject._Release: Integer;stdcall; +function TNoRefCountObject._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin Result := -1; end; diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc index ebc4b5f9d1..850bb2ecf6 100644 --- a/rtl/inc/objpas.inc +++ b/rtl/inc/objpas.inc @@ -967,7 +967,7 @@ ****************************************************************************} 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 if getinterface(iid,obj) then @@ -976,13 +976,13 @@ result:=longint(E_NOINTERFACE); end; - function TInterfacedObject._AddRef : longint;stdcall; + function TInterfacedObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin _addref:=interlockedincrement(frefcount); end; - function TInterfacedObject._Release : longint;stdcall; + function TInterfacedObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin _Release:=interlockeddecrement(frefcount); @@ -1026,19 +1026,19 @@ end; 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 Result := IUnknown(fcontroller).QueryInterface(iid, obj); end; - function TAggregatedObject._AddRef : longint;stdcall; + function TAggregatedObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin Result := IUnknown(fcontroller)._AddRef; end; - function TAggregatedObject._Release : longint;stdcall; + function TAggregatedObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin Result := IUnknown(fcontroller)._Release; @@ -1055,7 +1055,7 @@ ****************************************************************************} 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 if getinterface(iid,obj) then diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc index 4062aed1f7..e7661fbd7c 100644 --- a/rtl/inc/objpash.inc +++ b/rtl/inc/objpash.inc @@ -243,9 +243,9 @@ IUnknown = interface ['{00000000-0000-0000-C000-000000000046}'] - function QueryInterface(const iid : tguid;out obj) : longint;stdcall; - function _AddRef : longint;stdcall; - function _Release : 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;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; end; IInterface = IUnknown; @@ -283,9 +283,9 @@ protected frefcount : longint; { implement methods of IUnknown } - function QueryInterface(const iid : tguid;out obj) : longint;stdcall; - function _AddRef : longint;stdcall; - function _Release : 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;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; public procedure AfterConstruction;override; procedure BeforeDestruction;override; @@ -300,9 +300,9 @@ function GetController: IUnknown; protected { implement methods of IUnknown } - function QueryInterface(const iid : tguid;out obj) : longint;stdcall; - function _AddRef : longint;stdcall; - function _Release : 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;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; public constructor Create(const aController: IUnknown); property Controller : IUnknown read GetController; @@ -310,7 +310,7 @@ TContainedObject = class(TAggregatedObject,IInterface) 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; { some pointer definitions } diff --git a/rtl/inc/variants.pp b/rtl/inc/variants.pp index 51e6a23122..f5f80ffa1e 100644 --- a/rtl/inc/variants.pp +++ b/rtl/inc/variants.pp @@ -161,9 +161,9 @@ type private FVarType: TVarType; protected - function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; 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; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; procedure SimplisticClear(var V: TVarData); procedure SimplisticCopy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean = False); procedure RaiseInvalidOp; @@ -3575,19 +3575,19 @@ function Null: Variant; // Null standard constant ---------------------------------------------------------------------} {$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 NotSupported('TCustomVariantType.QueryInterface'); end; -function TCustomVariantType._AddRef: Integer; stdcall; +function TCustomVariantType._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin NotSupported('TCustomVariantType._AddRef'); end; -function TCustomVariantType._Release: Integer; stdcall; +function TCustomVariantType._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin NotSupported('TCustomVariantType._Release'); end; diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc index 24f446c17d..a03f092f7b 100644 --- a/rtl/objpas/classes/classesh.inc +++ b/rtl/objpas/classes/classesh.inc @@ -403,10 +403,10 @@ type FOwnerInterface: IInterface; protected { IInterface } - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; 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; end; @@ -1630,9 +1630,9 @@ type procedure ValidateContainer(AComponent: TComponent); dynamic; procedure ValidateInsert(AComponent: TComponent); dynamic; { IUnknown } - function QueryInterface(const IID: TGUID; out Obj): Hresult; virtual; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; 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; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; function iicrGetComponent: TComponent; { IDispatch } function GetTypeInfoCount(out Count: Integer): HResult; stdcall; diff --git a/rtl/objpas/classes/compon.inc b/rtl/objpas/classes/compon.inc index 6935ee2a18..0ecf1ef1b7 100644 --- a/rtl/objpas/classes/compon.inc +++ b/rtl/objpas/classes/compon.inc @@ -652,7 +652,7 @@ begin Result := False; 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 if Assigned(VCLComObject) then Result := IVCLComObject(VCLComObject).QueryInterface(IID, Obj) @@ -663,7 +663,7 @@ begin Result := E_NOINTERFACE; end; -function TComponent._AddRef: Integer;stdcall; +function TComponent._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin if Assigned(VCLComObject) then Result := IVCLComObject(VCLComObject)._AddRef @@ -671,7 +671,7 @@ begin Result := -1; end; -function TComponent._Release: Integer;stdcall; +function TComponent._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin if Assigned(VCLComObject) then Result := IVCLComObject(VCLComObject)._Release diff --git a/rtl/objpas/classes/persist.inc b/rtl/objpas/classes/persist.inc index e8851a49d8..c970715195 100644 --- a/rtl/objpas/classes/persist.inc +++ b/rtl/objpas/classes/persist.inc @@ -91,7 +91,7 @@ begin end; -function TInterfacedPersistent._AddRef: Integer;stdcall; +function TInterfacedPersistent._AddRef: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin if assigned(FOwnerInterface) then Result:=FOwnerInterface._AddRef @@ -100,7 +100,7 @@ begin end; -function TInterfacedPersistent._Release: Integer;stdcall; +function TInterfacedPersistent._Release: Integer;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin if assigned(FOwnerInterface) then Result:=FOwnerInterface._Release @@ -109,7 +109,7 @@ begin 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 if GetInterface(IID, Obj) then Result:=0 diff --git a/tests/tbs/tb0546.pp b/tests/tbs/tb0546.pp index 98db649871..ea0df986b4 100644 --- a/tests/tbs/tb0546.pp +++ b/tests/tbs/tb0546.pp @@ -41,9 +41,9 @@ type private FInnerX: TInnerObject; protected - function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; + function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; function GetX: TInnerObject; virtual; function GetY: IYInterface; public @@ -96,7 +96,7 @@ begin result := -1; end; -function TFoo.QueryInterface(const IID: TGUID; out Obj): HResult; +function TFoo.QueryInterface(constref IID: TGUID; out Obj): HResult; begin if GetInterface(IID, Obj) then Result := 0 else Result := E_NOINTERFACE; end;function TFoo.GetX: TInnerObject; diff --git a/tests/test/tconstref1.pp b/tests/test/tconstref1.pp new file mode 100644 index 0000000000..491e45351b --- /dev/null +++ b/tests/test/tconstref1.pp @@ -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. + diff --git a/tests/test/tconstref2.pp b/tests/test/tconstref2.pp new file mode 100644 index 0000000000..b0f678c2f9 --- /dev/null +++ b/tests/test/tconstref2.pp @@ -0,0 +1,12 @@ +{ %fail } +program tConstRef2; + +procedure TestConstRef(constref AParam: integer); +begin + AParam := 5; +end; + +begin + TestConstRef(1); +end. + diff --git a/tests/test/tconstref3.pp b/tests/test/tconstref3.pp new file mode 100644 index 0000000000..0ff96f86ba --- /dev/null +++ b/tests/test/tconstref3.pp @@ -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. + diff --git a/tests/test/tconstref4.pp b/tests/test/tconstref4.pp new file mode 100644 index 0000000000..d287907e8e --- /dev/null +++ b/tests/test/tconstref4.pp @@ -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. + diff --git a/tests/test/tinterface4.pp b/tests/test/tinterface4.pp index 6244b02a34..aa0b9ec7c0 100644 --- a/tests/test/tinterface4.pp +++ b/tests/test/tinterface4.pp @@ -13,9 +13,9 @@ type end; TA = class(TObject, IA, IInterface) destructor Destroy; override; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; - function QueryInterface(const iid: TGuid; out obj): HResult; stdcall; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; procedure AfterConstruction; override; class function NewInstance: TObject; override; end; @@ -32,13 +32,13 @@ begin inherited AfterConstruction; end; -function TA._AddRef: Integer; stdcall; +function TA._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin InterlockedIncrement(fRefCount); Result := 0; end; -function TA._Release: Integer; stdcall; +function TA._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin InterlockedDecrement(fRefCount); if fRefCount = 0 then begin @@ -49,7 +49,7 @@ begin Result := 0; 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 Result := E_NOINTERFACE; end; diff --git a/tests/webtbs/tw10897.pp b/tests/webtbs/tw10897.pp index b6aab1b3e8..db7aaa7771 100644 --- a/tests/webtbs/tw10897.pp +++ b/tests/webtbs/tw10897.pp @@ -22,9 +22,9 @@ type fRef: Integer; public function GetOwner: IMyIntf; - function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; + function QueryInterface(constref IID: TGUID; out Obj): HRESULT; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; procedure Poing; end; @@ -52,7 +52,7 @@ begin Writeln('GetOwner2'); end; -function TMYClass.QueryInterface(const IID: TGUID; out Obj): HRESULT; +function TMYClass.QueryInterface(constref IID: TGUID; out Obj): HRESULT; begin if GetInterface(IID, Obj) then result := S_OK else result := -1; diff --git a/tests/webtbs/tw15363.pp b/tests/webtbs/tw15363.pp index 6f47aad5ac..ce2a146ae2 100644 --- a/tests/webtbs/tw15363.pp +++ b/tests/webtbs/tw15363.pp @@ -10,18 +10,18 @@ type TTestBE = class (TObject, ITest) function TestIt: integer; { IInterface } - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; - function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; End; TTest = class (TPersistent, IInterface) BE : TTestBE; protected { IInterface } - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; - function QueryInterface(const IID: TGUID; out Obj): HResult; virtual; stdcall; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function QueryInterface(constref IID: TGUID; out Obj): HResult; virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; End; function TTestBE.TestIt : integer; @@ -39,7 +39,7 @@ begin Result := -1; end; -function TTest.QueryInterface(const IID: TGUID; out Obj): HResult; +function TTest.QueryInterface(constref IID: TGUID; out Obj): HResult; begin Result := BE.QueryInterface(IID, obj); end; @@ -54,7 +54,7 @@ begin Result := -1; end; -function TTestBE.QueryInterface(const IID: TGUID; out Obj): HResult; +function TTestBE.QueryInterface(constref IID: TGUID; out Obj): HResult; begin if GetInterface(IID, Obj) then Result := 0 diff --git a/tests/webtbs/tw16592.pp b/tests/webtbs/tw16592.pp index 79abdd313a..560b1d1856 100644 --- a/tests/webtbs/tw16592.pp +++ b/tests/webtbs/tw16592.pp @@ -24,9 +24,9 @@ type protected FRefCount : longint; public - function QueryInterface(const iid : tguid;out obj) : longint;stdcall; - function _AddRef : longint;stdcall; - function _Release : longint;stdcall; + function QueryInterface(constref iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; constructor Create; @@ -96,7 +96,7 @@ end; WriteLn(Format('%s Obj=$%P class=%s RefCount=%d', [Str, Pointer(Self), ClassName, FRefCount])); 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 Result:=GetInterface(iid, obj); @@ -105,7 +105,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca Result:=FOwner.QueryInterface(iid, obj); 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 if not FDestructorCalled then begin @@ -117,7 +117,7 @@ function TInterfacedObj.QueryInterface(const iid: tguid; out obj): longint;stdca end; end; - function TInterfacedObj._Release : longint;stdcall; + function TInterfacedObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin if FDestructorCalled then Exit; diff --git a/tests/webtbs/tw2177.pp b/tests/webtbs/tw2177.pp index 35e6c832a3..3250616a71 100644 --- a/tests/webtbs/tw2177.pp +++ b/tests/webtbs/tw2177.pp @@ -16,25 +16,25 @@ type Twii= class(TObject, ii) s: string; - function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall; - function _AddRef: Integer; stdcall; - function _Release: Integer; stdcall; + function QueryInterface(constref IID: TGUID; out Obj): Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; procedure Show;stdcall; end; {________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 result:= -1; end; - function Twii._AddRef: Integer; stdcall; + function Twii._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin result:= -1; end; - function Twii._Release: Integer; stdcall; + function Twii._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin result:= -1; end; diff --git a/tests/webtbs/tw4086.pp b/tests/webtbs/tw4086.pp index 712e3a72cc..995f0f776f 100644 --- a/tests/webtbs/tw4086.pp +++ b/tests/webtbs/tw4086.pp @@ -19,9 +19,9 @@ type ttestclass1 = class(tobject,itest) public - function queryinterface(const guid: tguid; out obj): hresult; stdcall; - function _addref: integer; stdcall; - function _release: integer; stdcall; + function queryinterface(constref guid: tguid; out obj): hresult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; procedure testproc; end; @@ -32,19 +32,19 @@ type { 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 result:= integer(e_nointerface); end; -function ttestclass1._addref: integer; stdcall; +function ttestclass1._addref: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin writeln('addref called'); // result:= inherited _addref; result:= -1; end; -function ttestclass1._release: integer; stdcall; +function ttestclass1._release: integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; begin writeln('release called'); // result:= inherited _release;