Переглянути джерело

* 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 -

nickysn 9 роки тому
батько
коміт
e6d01eb3b5
3 змінених файлів з 73 додано та 0 видалено
  1. 1 0
      .gitattributes
  2. 3 0
      compiler/ncal.pas
  3. 69 0
      tests/tbs/tb0614.pp

+ 1 - 0
.gitattributes

@@ -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

+ 3 - 0
compiler/ncal.pas

@@ -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 - 0
tests/tbs/tb0614.pp

@@ -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.