From f29598384b2fdb4014453ff05b0e16d71b6665de Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 31 Aug 2019 11:43:41 +0000 Subject: [PATCH] * Objective-Pascal inferred result type and improved category method searching --- Merging r42815 through r42817 into '.': U tests/test/tobjc34.pp U tests/test/tobjc36.pp U tests/test/tobjcl2.pp A tests/test/units/cocoaall A tests/test/units/cocoaall/tw35994.pp U compiler/defcmp.pas U compiler/ncal.pas C compiler/pdecl.pas C compiler/symconst.pas C compiler/utils/ppuutils/ppudump.pp U compiler/symtable.pas --- Recording mergeinfo for merge of r42815 through r42817 into '.': U . --- Merging r42857 into '.': G compiler/symtable.pas --- Recording mergeinfo for merge of r42857 into '.': G . git-svn-id: branches/fixes_3_2@42883 - --- .gitattributes | 1 + compiler/defcmp.pas | 7 ++++ compiler/ncal.pas | 14 +++++++ compiler/pdecl.pas | 52 ++++++++++++++++++++++- compiler/symconst.pas | 7 +++- compiler/symtable.pas | 62 +++++++++++++++++----------- compiler/utils/ppuutils/ppudump.pp | 3 +- tests/test/tobjc34.pp | 2 +- tests/test/tobjc36.pp | 4 +- tests/test/tobjcl2.pp | 2 +- tests/test/units/cocoaall/tw35994.pp | 31 ++++++++++++++ 11 files changed, 153 insertions(+), 32 deletions(-) create mode 100644 tests/test/units/cocoaall/tw35994.pp diff --git a/.gitattributes b/.gitattributes index a0c5517f1f..613f31e7c3 100644 --- a/.gitattributes +++ b/.gitattributes @@ -14062,6 +14062,7 @@ tests/test/units/classes/tsetstream.pp svneol=native#text/plain tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal tests/test/units/classes/ttbits.pp svneol=native#text/pascal tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain +tests/test/units/cocoaall/tw35994.pp svneol=native#text/plain tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal tests/test/units/crt/tcrt.pp svneol=native#text/plain tests/test/units/crt/tctrlc.pp svneol=native#text/plain diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index 980290fd0a..37af47c73d 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -2464,6 +2464,13 @@ implementation exit; end; + if (realself.objecttype in [odt_objcclass,odt_objcprotocol]) and + (otherdef=objc_idtype) then + begin + result:=true; + exit; + end; + if (otherdef.typ<>objectdef) then begin result:=false; diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 2670cc2f60..5eb4fd1295 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -3816,6 +3816,20 @@ implementation exit; end; + { in case this is an Objective-C message that returns a related object type by convention, + override the default result type } + if po_objc_related_result_type in procdefinition.procoptions then + begin + { don't crash in case of syntax errors } + if assigned(methodpointer) then + begin + include(callnodeflags,cnf_typedefset); + typedef:=methodpointer.resultdef; + if typedef.typ=classrefdef then + typedef:=tclassrefdef(typedef).pointeddef; + end; + end; + { ensure that the result type is set } if not(cnf_typedefset in callnodeflags) then begin diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index fcb19c2c3d..024ec56ebb 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -56,7 +56,7 @@ implementation globals,tokens,verbose,widestr,constexp, systems,aasmdata,fmodule,compinnr, { symtable } - symconst,symbase,symtype,symcpu,symcreat,defutil, + symconst,symbase,symtype,symcpu,symcreat,defutil,defcmp, { pass 1 } ninl,ncon,nobj,ngenutil, { parser } @@ -386,6 +386,51 @@ implementation consume(_SEMICOLON); end; + { From http://clang.llvm.org/docs/LanguageExtensions.html#objective-c-features : + To determine whether a method has an inferred related result type, the first word in the camel-case selector + (e.g., “init” in “initWithObjects”) is considered, and the method will have a related result type if its return + type is compatible with the type of its class and if: + * the first word is "alloc" or "new", and the method is a class method, or + * the first word is "autorelease", "init", "retain", or "self", and the method is an instance method. + + If a method with a related result type is overridden by a subclass method, the subclass method must also return + a type that is compatible with the subclass type. + } + procedure pd_set_objc_related_result(def: tobject; para: pointer); + var + pd: tprocdef; + i, firstcamelend: longint; + inferresult: boolean; + begin + if tdef(def).typ<>procdef then + exit; + pd:=tprocdef(def); + if not(po_msgstr in pd.procoptions) then + internalerror(2019082401); + firstcamelend:=length(pd.messageinf.str^); + for i:=1 to length(pd.messageinf.str^) do + if pd.messageinf.str^[i] in ['A'..'Z'] then + begin + firstcamelend:=pred(i); + break; + end; + case copy(pd.messageinf.str^,1,firstcamelend) of + 'alloc', + 'new': + inferresult:=po_classmethod in pd.procoptions; + 'autorelease', + 'init', + 'retain', + 'self': + inferresult:=not(po_classmethod in pd.procoptions); + else + inferresult:=false; + end; + if inferresult and + def_is_related(tdef(pd.procsym.owner.defowner),pd.returndef) then + include(pd.procoptions,po_objc_related_result_type); + end; + procedure types_dec(in_structure: boolean;out had_generic:boolean); function determine_generic_def(name:tidstring):tstoreddef; @@ -901,7 +946,10 @@ implementation if is_objc_class_or_protocol(hdef) and (not is_objccategory(hdef) or assigned(tobjectdef(hdef).childof)) then - tobjectdef(hdef).finish_objc_data; + begin + tobjectdef(hdef).finish_objc_data; + tobjectdef(hdef).symtable.DefList.ForEachCall(@pd_set_objc_related_result,nil); + end; if is_cppclass(hdef) then tobjectdef(hdef).finish_cpp_data; diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 1b662a8616..fdc7a2007f 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -413,7 +413,9 @@ type { procedure is an automatically generated property getter } po_is_auto_getter, { procedure is an automatically generated property setter } - po_is_auto_setter + po_is_auto_setter, + { implicitly return same type as the class instance to which the message is sent } + po_objc_related_result_type ); tprocoptions=set of tprocoption; @@ -1020,7 +1022,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has 'po_is_function_ref',{po_is_function_ref} 'C-style blocks',{po_is_block} 'po_is_auto_getter',{po_is_auto_getter} - 'po_is_auto_setter'{po_is_auto_setter} + 'po_is_auto_setter',{po_is_auto_setter} + 'objc-related-result-type' {po_objc_related_result_type} ); implementation diff --git a/compiler/symtable.pas b/compiler/symtable.pas index c7abd7da58..5c38d5ef71 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -4224,25 +4224,32 @@ implementation function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; var + searchst : tsymtable; + searchsym : tsym; hashedid : THashedIDString; stackitem : psymtablestackitem; i : longint; + founddefowner, defowner : tobjectdef; begin hashedid.id:=class_helper_prefix+s; stackitem:=symtablestack.stack; + result:=false; + srsym:=nil; + srsymtable:=nil; + founddefowner:=nil; while assigned(stackitem) do begin - srsymtable:=stackitem^.symtable; - srsym:=tsym(srsymtable.FindWithHash(hashedid)); - if assigned(srsym) then + searchst:=stackitem^.symtable; + searchsym:=tsym(searchst.FindWithHash(hashedid)); + if assigned(searchsym) then begin - if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or - not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or - (srsym.typ<>procsym) then + if not(searchst.symtabletype in [globalsymtable,staticsymtable]) or + not(searchsym.owner.symtabletype in [globalsymtable,staticsymtable]) or + (searchsym.typ<>procsym) then internalerror(2009111505); { check whether this procsym includes a helper for this particular class } - for i:=0 to tprocsym(srsym).procdeflist.count-1 do + for i:=0 to tprocsym(searchsym).procdeflist.count-1 do begin { does pd inherit from (or is the same as) the class that this method's category extended? @@ -4250,7 +4257,7 @@ implementation Warning: this list contains both category and objcclass methods (for id.randommethod), so only check category methods here } - defowner:=tobjectdef(tprocdef(tprocsym(srsym).procdeflist[i]).owner.defowner); + defowner:=tobjectdef(tprocdef(tprocsym(searchsym).procdeflist[i]).owner.defowner); if is_objccategory(defowner) and def_is_related(pd,defowner.childof) then begin @@ -4258,28 +4265,37 @@ implementation in the static symtable, because then it can't be inlined from outside this unit } if assigned(current_procinfo) and - (srsym.owner.symtabletype=staticsymtable) then + (searchsym.owner.symtabletype=staticsymtable) then include(current_procinfo.flags,pi_uses_static_symtable); - { no need to keep looking. There might be other - categories that extend this, a parent or child - class with a method with the same name (either - overriding this one, or overridden by this one), - but that doesn't matter as far as the basic - procsym is concerned. + { Stop looking if this is a category that extends the specified + class itself. There might be other categories that extend this, + but that doesn't matter. If it extens a parent, keep looking + in case we find the symbol in a category that extends this class + (or a closer parent). } - srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym; - srsymtable:=srsym.owner; - addsymref(srsym); - result:=true; - exit; + if not result or + def_is_related(defowner.childof,founddefowner) then + begin + founddefowner:=defowner.childof; + srsym:=tprocdef(tprocsym(searchsym).procdeflist[i]).procsym; + srsymtable:=srsym.owner; + result:=true; + if pd=founddefowner then + begin + addsymref(srsym); + exit; + end; + end; end; end; end; stackitem:=stackitem^.next; end; - srsym:=nil; - srsymtable:=nil; - result:=false; + if result then + begin + addsymref(srsym); + exit; + end; end; diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index 28c5982624..13de5f70a4 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/compiler/utils/ppuutils/ppudump.pp @@ -2011,7 +2011,8 @@ const (mask:po_is_function_ref; str: 'Function reference'), (mask:po_is_block; str: 'C "Block"'), (mask:po_is_auto_getter; str: 'Automatically generated getter'), - (mask:po_is_auto_setter; str: 'Automatically generated setter') + (mask:po_is_auto_setter; str: 'Automatically generated setter'), + (mask:po_objc_related_result_type; str: 'Objective-C related result type') ); var proctypeoption : tproctypeoption; diff --git a/tests/test/tobjc34.pp b/tests/test/tobjc34.pp index cec6638c5e..075f0698a0 100644 --- a/tests/test/tobjc34.pp +++ b/tests/test/tobjc34.pp @@ -15,7 +15,7 @@ type class procedure testClassOverride; override; end; - tmyoverrideclass = class of NSObject; + tmyoverrideclass = class of MyOverride; var selfshouldbe: tmyoverrideclass; diff --git a/tests/test/tobjc36.pp b/tests/test/tobjc36.pp index e771cbe3a6..017ce4394a 100644 --- a/tests/test/tobjc36.pp +++ b/tests/test/tobjc36.pp @@ -57,7 +57,7 @@ begin b:=MyObject.alloc.init; b.extraproc(2); b.release; - c:=MyObject.alloc.init; - c.extraproc(2); + c:=MyObject2.alloc.init; + c.extraproc(3); c.release; end. diff --git a/tests/test/tobjcl2.pp b/tests/test/tobjcl2.pp index 5821a554e6..939c355696 100644 --- a/tests/test/tobjcl2.pp +++ b/tests/test/tobjcl2.pp @@ -43,7 +43,7 @@ function MyDerivedClass.callprotectedfun: byte; var a: MyLibObjCClass; begin - a:=NSObject(MyDerivedClass.alloc).init; + a:=MyDerivedClass.alloc.init; a.fa:=55; a.fb:=66; if a.publicfun<>55 then diff --git a/tests/test/units/cocoaall/tw35994.pp b/tests/test/units/cocoaall/tw35994.pp new file mode 100644 index 0000000000..af16d142e7 --- /dev/null +++ b/tests/test/units/cocoaall/tw35994.pp @@ -0,0 +1,31 @@ + +{$MODE OBJFPC} +{$MODESWITCH OBJECTIVEC1} + +program test; + +uses + CocoaAll; + +var + obj: NSObject; + path: NSString; + dict: NSDictionary; + mDict: NSMutableDictionary; + pool: NSAutoReleasePool; +begin + pool := NSAutoReleasePool.alloc.init; + obj := NSObject.alloc.init; + + path := NSSTR(''); + dict := NSDictionary.dictionaryWithContentsOfFile(path); + dict := NSDictionary.alloc.initWithContentsOfFile(path); // ERROR: got "NSArray" expected "NSDictionary" + dict := NSDictionary(NSDictionary.alloc).initWithContentsOfFile(path); + + dict := NSMutableDictionary.dictionaryWithContentsOfFile(path); + mDict := NSMutableDictionary.dictionaryWithContentsOfFile(path); // ERROR: got "NSDictionary" expected "NSMutableDictionary" + dict := NSMutableDictionary.alloc.initWithContentsOfFile(path); // ERROR: got "NSArray" expected "NSDictionary" + mDict := NSMutableDictionary.alloc.initWithContentsOfFile(path); // ERROR: got "NSArray" expected "NSDictionary" + + pool.release; +end.