* fixed handling function results of inherited obj-c calls

(test program by Gorazd Krosl)

git-svn-id: branches/objc@13720 -

.gitattributes

@@ -8348,6 +8348,7 @@ tests/test/opt/twpo5.pp svneol=native#text/plain
 tests/test/opt/twpo6.pp svneol=native#text/plain
 tests/test/opt/twpo7.pp svneol=native#text/plain
 tests/test/opt/uwpo2.pp svneol=native#text/plain
+tests/test/packages/cocoaint/tobjcnh1.pp svneol=native#text/plain
 tests/test/packages/fcl-base/tascii85.pp svneol=native#text/plain
 tests/test/packages/fcl-base/tgettext1.pp svneol=native#text/plain
 tests/test/packages/fcl-db/assertions.pas svneol=native#text/plain

compiler/nobjc.pas

@@ -175,8 +175,9 @@ constructor tobjcmessagesendnode.create(forcall: tnode);
   begin
     if (forcall.nodetype<>calln) then
       internalerror(2009032502);
-    { typecheck pass (and pass1) must already have run on the call node,
-      because pass1 of the callnode creates this node
+    { typecheck pass must already have run on the call node,
+      because pass1 of the callnode creates this node right
+      at the beginning
     }
     inherited create(objcmessagesendn,forcall);
   end;
@@ -199,7 +200,8 @@ function tobjcmessagesendnode.pass_1: tnode;
     block,
     selftree  : tnode;
     statements: tstatementnode;
-    temp: ttempcreatenode;
+    temp,
+    tempresult: ttempcreatenode;
     objcsupertype: tdef;
     field: tfieldvarsym;
     selfpara,
@@ -209,7 +211,7 @@ function tobjcmessagesendnode.pass_1: tnode;
     prerespara,
     prevpara: tcallparanode;
   begin
-    { pass1 of left has already run, see constructor }
+    { typecheckpass of left has already run, see constructor }
 
     { default behaviour: call objc_msgSend and friends;
       ppc64 and x86_64 for Mac OS X have to override this as they
@@ -220,6 +222,7 @@ function tobjcmessagesendnode.pass_1: tnode;
       result type, and on whether or not it's an inherited call.
     }
 
+    tempresult:=nil;
     newparas:=tcallparanode(tcallnode(left).left);
     { Find the self and msgsel parameters.  }
     para:=newparas;
@@ -367,6 +370,11 @@ function tobjcmessagesendnode.pass_1: tnode;
     tcallnode(left).methodpointer:=nil;
     { and now the call to the Objective-C rtl }
     result:=ccallnode.createinternresfromunit('OBJC1',msgsendname,newparas,left.resultdef);
+    { record whether or not the function result is used (remains
+      the same for the new call).
+    }
+    if not(cnf_return_value_used in tcallnode(left).callnodeflags) then
+      exclude(tcallnode(result).callnodeflags,cnf_return_value_used);
     { in case an explicit function result was specified, keep it }
     tcallnode(result).funcretnode:=tcallnode(left).funcretnode;
     tcallnode(left).funcretnode:=nil;
@@ -376,14 +384,34 @@ function tobjcmessagesendnode.pass_1: tnode;
 
     if (cnf_inherited in tcallnode(left).callnodeflags) then
       begin
-        { free the objc_super temp after the call. We cannout use
+        block:=internalstatements(statements);
+        { temp for the result of the inherited call }
+        if not is_void(left.resultdef) and
+           (cnf_return_value_used in tcallnode(left).callnodeflags) then
+           begin
+             tempresult:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true);
+             addstatement(statements,tempresult);
+           end;
+
+        { make sure we return the result, if any }
+        if not assigned(tempresult) then
+          addstatement(statements,result)
+        else
+          addstatement(statements,
+            cassignmentnode.create(ctemprefnode.create(tempresult),result));
+        { free the objc_super temp after the call. We cannot use
           ctempdeletenode.create_normal_temp before the call, because then
           the temp will be released while evaluating the parameters, and thus
           may be reused while evaluating another parameter
         }
-        block:=internalstatements(statements);
-        addstatement(statements,result);
         addstatement(statements,ctempdeletenode.create(temp));
+        if assigned(tempresult) then
+          begin
+            { mark the result temp as "free after next use" and return it }
+            addstatement(statements,
+              ctempdeletenode.create_normal_temp(tempresult));
+            addstatement(statements,ctemprefnode.create(tempresult));
+          end;
         typecheckpass(block);
         result:=block;
      end;

tests/Makefile

@@ -1460,7 +1460,7 @@ ifndef LOG
 export LOG:=$(TEST_OUTPUTDIR)/log
 endif
 TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
-TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db packages/fcl-base packages/fcl-xml
+TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db packages/fcl-base packages/fcl-xml packages/cocoaint
 ifdef QUICKTEST
 export QUICKTEST
 else

tests/Makefile.fpc

@@ -121,7 +121,7 @@ endif
 
 # Subdirs available in the test subdir
 TESTSUBDIRS=cg cg/variants cg/cdecl opt units/system units/dos units/crt units/objects units/strings units/sysutils units/math units/sharemem
-TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db packages/fcl-base packages/fcl-xml
+TESTPACKAGESUBDIRS=cg packages/win-base packages/webtbs packages/hash packages/fcl-registry packages/fcl-process packages/zlib packages/fcl-db packages/fcl-base packages/fcl-xml packages/cocoaint
 
 ifdef QUICKTEST
 export QUICKTEST

tests/test/packages/cocoaint/tobjcnh1.pp

@@ -0,0 +1,100 @@
+{ %target=darwin }
+{ %cpu=powerpc,i386 }
+
+{$mode objfpc}{$H+}
+{$modeswitch objectivec1}
+program Start;
+uses
+ctypes,
+CFBase, CFString,
+CocoaAll;
+
+type
+MyObject = objcclass(NSObject)
+  function initMyObject : id; message 'initMyObject';
+  function testFunction : cint; message 'testFunction';
+end;
+
+MySubobject = objcclass(MyObject)
+  function initMyObject : id; message 'initMyObject'; override;
+  function testFunction : cint; message 'testFunction'; override;
+end;
+
+procedure NSLog(fmt : CFStringRef); cdecl; varargs; external name 'NSLog';
+
+function MyObject.initMyObject : id;
+  var
+    temp: id;
+  begin
+    Result:=nil;
+    NSLog(CFSTR('MyObject.initMyObject entry, self = %p'), self);
+    Result := inherited init;
+    { default NSObject.init does not return anything different,
+      so should be safe in test program }
+    if result<>self then
+      halt(1);
+    NSLog(CFSTR('Result assigned by inherited init = %p'), Result);
+    NSLog(CFSTR('self after inherited init = %p'), self);
+    Result := self;
+    NSLog(CFSTR('returning result = %p'), Result)
+  end;
+
+function MyObject.testFunction : cint;
+  begin
+    Result := 1;
+    NSLog(CFSTR('MyObject.testFunction returning %d'), Result)
+  end;
+
+function MySubobject.initMyObject : id;
+  begin
+    Result:=nil;
+    NSLog(CFSTR('MySubobject.initMyObject entry, self = %p'), self);
+    Result := inherited initMyObject;
+    if (result<>self) then
+      halt(2);
+    NSLog(CFSTR('Result assigned by inherited initMyObject = %p'), Result);
+    NSLog(CFSTR('self after inherited init = %p'), self);
+    Result := self;
+    NSLog(CFSTR('returning result = %p'), Result)
+  end;
+
+function MySubobject.testFunction : cint;
+  begin
+    Result:=-1;
+    writeln('MySubobject.testFunction calling inherited...');
+    Result := inherited testFunction;
+    if (result<>1) then
+      halt(3);
+    NSLog(CFSTR('Return from inherited = %d'), Result);
+    Result := 2;
+    NSLog(CFSTR('MySubobject.testFunction returning %d'), Result)
+  end;
+
+
+procedure MyTest;
+  var
+    ap: NSAutoreleasePool;
+    o: MyObject;
+    oo: MySubobject;
+    n: cint;
+  begin
+    ap := NSAutoreleasePool.new;
+    writeln('========== Initializing MyObject and MySubobject ==========');
+    o := MyObject(MyObject.alloc).initMyObject;
+    writeln;
+    oo := MySubobject(MySubobject.alloc).initMyObject;
+    writeln; writeln;
+    writeln('========== Testing testFunction ==========');
+    n := o.testFunction;
+    writeln('MyObject.testFunction returned ', n);
+    writeln;
+    n := oo.testFunction;
+    writeln('MySubobject.testFunction returned ', n);
+    o.release;
+    oo.release;
+    ap.drain
+  end;
+
+begin
+  MyTest;
+end.