* fixed a bug, which caused a function that returns a method pointer (or nested

procdef) to be called twice, when the result of this function is immediately
  called (i.e. not stored in a temp variable).

git-svn-id: trunk@32495 -
This commit is contained in:
nickysn 2015-11-22 17:21:08 +00:00
parent 7d1889e0ef
commit e6d01eb3b5
3 changed files with 73 additions and 0 deletions

1
.gitattributes vendored
View File

@ -10824,6 +10824,7 @@ tests/tbs/tb0610.pp svneol=native#text/pascal
tests/tbs/tb0611.pp svneol=native#text/pascal
tests/tbs/tb0612.pp svneol=native#text/pascal
tests/tbs/tb0613.pp svneol=native#text/pascal
tests/tbs/tb0614.pp svneol=native#text/pascal
tests/tbs/tb205.pp svneol=native#text/plain
tests/tbs/tb610.pp svneol=native#text/pascal
tests/tbs/tb613.pp svneol=native#text/plain

View File

@ -4168,6 +4168,9 @@ implementation
calln to a loadn (PFV) }
if assigned(methodpointer) then
maybe_load_in_temp(methodpointer);
if assigned(right) and (right.resultdef.typ=procvardef) and
not tabstractprocdef(right.resultdef).is_addressonly then
maybe_load_in_temp(right);
{ Create destination (temp or assignment-variable reuse) for function result if it not yet set }
maybe_create_funcret_node;

69
tests/tbs/tb0614.pp Normal file
View File

@ -0,0 +1,69 @@
program tb0614;
{$mode objfpc}
{$modeswitch nestedprocvars}
type
tobjectmethod = procedure of object;
tnestedprocvar = procedure is nested;
TMyClass = class
procedure Moo;
end;
var
obj: TMyClass;
NumCalls: Integer;
procedure TMyClass.Moo;
begin
Writeln('TMyClass.Moo');
end;
function get_objmethod: tobjectmethod;
begin
Writeln('get_objmethod');
Inc(NumCalls);
Result := @obj.Moo;
end;
function get_nestedprocvar: tnestedprocvar;
procedure nested;
begin
Writeln('nested');
end;
begin
Writeln('get_nestedprocvar');
Inc(NumCalls);
Result := @nested;
end;
var
Errors: Boolean = False;
begin
NumCalls := 0;
obj := TMyClass.Create;
get_objmethod()();
obj.Free;
if NumCalls <> 1 then
begin
Writeln('Error: get_objmethod should have been called once, but instead it was called ', NumCalls, ' times');
Errors := True;
end;
NumCalls := 0;
get_nestedprocvar()();
if NumCalls <> 1 then
begin
Writeln('Error: get_nestedprocvar should have been called once, but instead it was called ', NumCalls, ' times');
Errors := True;
end;
if Errors then
begin
Writeln('Errors found!');
Halt(1);
end
else
Writeln('Ok!');
end.