From fb2a5239761534f35a8ddf4833650085c91f8775 Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Wed, 16 Sep 2009 13:00:50 +0000 Subject: [PATCH] * fixed handling function results of inherited obj-c calls (test program by Gorazd Krosl) git-svn-id: branches/objc@13720 - --- .gitattributes | 1 + compiler/nobjc.pas | 42 ++++++++-- tests/Makefile | 2 +- tests/Makefile.fpc | 2 +- tests/test/packages/cocoaint/tobjcnh1.pp | 100 +++++++++++++++++++++++ 5 files changed, 138 insertions(+), 9 deletions(-) create mode 100644 tests/test/packages/cocoaint/tobjcnh1.pp diff --git a/.gitattributes b/.gitattributes index 9115cf1e34..02cd081089 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/nobjc.pas b/compiler/nobjc.pas index 25262e198c..ae5fbcedb1 100644 --- a/compiler/nobjc.pas +++ b/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; diff --git a/tests/Makefile b/tests/Makefile index b0a6c49a72..b5021950ef 100644 --- a/tests/Makefile +++ b/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 diff --git a/tests/Makefile.fpc b/tests/Makefile.fpc index 15783fd226..6f1c491e3b 100644 --- a/tests/Makefile.fpc +++ b/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 diff --git a/tests/test/packages/cocoaint/tobjcnh1.pp b/tests/test/packages/cocoaint/tobjcnh1.pp new file mode 100644 index 0000000000..e1b6b63c5f --- /dev/null +++ b/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.