paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-08 10:39:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* pass only a pointer to a result when the result is used when invoking idispatch, resolves #9162

Browse Source 
git-svn-id: trunk@7908 -
This commit is contained in:
florian 2007-07-01 15:37:36 +00:00
parent c6ffa724f3
commit 7cbe76b8dc
4 changed files with 80 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -8332,6 +8332,7 @@ tests/webtbs/tw9113.pp svneol=native#text/plain
tests/webtbs/tw9128.pp svneol=native#text/plain
tests/webtbs/tw9139.pp svneol=native#text/plain
tests/webtbs/tw9139a.pp svneol=native#text/plain
tests/webtbs/tw9162.pp svneol=native#text/plain
tests/webtbs/tw9167.pp svneol=native#text/plain
tests/webtbs/tw9174.pp svneol=native#text/plain
tests/webtbs/tw9179.pp svneol=native#text/plain

42
compiler/ncal.pas
View File

@ -175,7 +175,7 @@ interface
tcallparanodeclass = class of tcallparanode;
function reverseparameters(p: tcallparanode): tcallparanode;
function translate_disp_call(selfnode,parametersnode : tnode;methodname : ansistring = '';dispid : longint = 0) : tnode;
function translate_disp_call(selfnode,parametersnode : tnode;methodname : ansistring = '';dispid : longint = 0;useresult : boolean = false) : tnode;
var
ccallnode : tcallnodeclass;
@ -227,7 +227,7 @@ implementation
end;
function translate_disp_call(selfnode,parametersnode : tnode;methodname : ansistring = '';dispid : longint = 0) : tnode;
function translate_disp_call(selfnode,parametersnode : tnode;methodname : ansistring = '';dispid : longint = 0;useresult : boolean = false) : tnode;
const
DISPATCH_METHOD = $1;
DISPATCH_PROPERTYGET = $2;
@ -240,6 +240,7 @@ implementation
params : ttempcreatenode;
paramssize : cardinal;
calldescnode : tdataconstnode;
resultvalue : tnode;
para : tcallparanode;
currargpos,
namedparacount,
@ -284,10 +285,12 @@ implementation
result:=internalstatements(statements);
fillchar(calldesc,sizeof(calldesc),0);
{ get temp for the result }
result_data:=ctempcreatenode.create(colevarianttype,colevarianttype.size,tt_persistent,true);
addstatement(statements,result_data);
if useresult then
begin
{ get temp for the result }
result_data:=ctempcreatenode.create(colevarianttype,colevarianttype.size,tt_persistent,true);
addstatement(statements,result_data);
end;
{ build parameters }
{ first, count and check parameters }
@ -422,6 +425,12 @@ implementation
calldescnode.append(calldesc,3+calldesc.argcount);
pvardatadef:=tpointerdef(search_system_type('PVARDATA').typedef);
if useresult then
resultvalue:=caddrnode.create(ctemprefnode.create(result_data))
else
resultvalue:=cpointerconstnode.create(0,voidpointertype);
if variantdispatch then
begin
methodname:=methodname+#0;
@ -436,9 +445,7 @@ implementation
ccallparanode.create(caddrnode.create(ctemprefnode.create(params)),
ccallparanode.create(caddrnode.create(calldescnode),
ccallparanode.create(ctypeconvnode.create_internal(selfnode,vardatadef),
ccallparanode.create(ctypeconvnode.create_internal(caddrnode.create(
ctemprefnode.create(result_data)
),pvardatadef),nil)))))
ccallparanode.create(ctypeconvnode.create_internal(resultvalue,pvardatadef),nil)))))
);
end
else
@ -448,14 +455,15 @@ implementation
ccallparanode.create(caddrnode.create(ctemprefnode.create(params)),
ccallparanode.create(caddrnode.create(calldescnode),
ccallparanode.create(ctypeconvnode.create_internal(selfnode,voidpointertype),
ccallparanode.create(ctypeconvnode.create_internal(caddrnode.create(
ctemprefnode.create(result_data)
),pvardatadef),nil)))))
ccallparanode.create(ctypeconvnode.create_internal(resultvalue,pvardatadef),nil)))))
);
end;
{ clean up }
addstatement(statements,ctempdeletenode.create_normal_temp(result_data));
addstatement(statements,ctemprefnode.create(result_data));
if useresult then
begin
{ clean up }
addstatement(statements,ctempdeletenode.create_normal_temp(result_data));
addstatement(statements,ctemprefnode.create(result_data));
end;
end;
@ -2273,13 +2281,13 @@ implementation
converted_result_data:=ctempcreatenode.create(procdefinition.returndef,sizeof(procdefinition.returndef),tt_persistent,true);
addstatement(statements,converted_result_data);
addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data),
ctypeconvnode.create_internal(translate_disp_call(methodpointer,parameters,'',tprocdef(procdefinition).dispid),
ctypeconvnode.create_internal(translate_disp_call(methodpointer,parameters,'',tprocdef(procdefinition).dispid,true),
procdefinition.returndef)));
addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data));
addstatement(statements,ctemprefnode.create(converted_result_data));
end
else
result:=translate_disp_call(methodpointer,parameters,'',tprocdef(procdefinition).dispid);
result:=translate_disp_call(methodpointer,parameters,'',tprocdef(procdefinition).dispid,false);
{ don't free reused nodes }
methodpointer:=nil;

2
compiler/pexpr.pas
View File

@ -2081,7 +2081,7 @@ implementation
end
else
p2:=nil;
p1:=translate_disp_call(p1,p2,dispatchstring);
p1:=translate_disp_call(p1,p2,dispatchstring,0,afterassignment);
end
else { Error }
Consume(_ID);

53
tests/webtbs/tw9162.pp Normal file
View File

@ -0,0 +1,53 @@
program DestBug;
{$APPTYPE CONSOLE}
{$MODE Delphi}
uses
Variants, SysUtils;
type
TSampleVariant = class(TCustomVariantType)
protected
procedure Clear(var V: TVarData); override;
procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean ); override;
procedure DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
end;
procedure TSampleVariant.Clear(var V: TVarData);
begin
V.VType:=varEmpty;
end;
procedure TSampleVariant.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
begin
if Indirect and VarDataIsByRef(Source) then
VarDataCopyNoInd(Dest, Source)
else with Dest do
VType:=Source.VType;
end;
var
p : pointer;
procedure TSampleVariant.DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
begin
Writeln('Dest is 0x', IntToStr(Cardinal(Dest)));
p:=Dest;
end;
var
SampleVariant: TSampleVariant;
v, v1: Variant;
begin
SampleVariant:=TSampleVariant.Create;
TVarData(v).VType:=SampleVariant.VarType;
v.SomeProc;
if assigned(p) then
halt(1);
v1:=v.SomeFunc;
if not(assigned(p)) then
halt(1);
writeln('ok');
end.