From af85e45b67ee83297e24a8708d2100494687382b Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Sat, 21 Nov 2009 00:14:21 +0000 Subject: [PATCH] + support for id.anyobjcmethodinscope() calls for Objective-Pascal code, using standard FPC overload selection logic * fixed detection of references to static symbol tables for class helpers git-svn-id: trunk@14234 - --- .gitattributes | 5 ++++ compiler/htypechk.pas | 59 +++++++++++++++++++++++------------- compiler/ncal.pas | 5 ++-- compiler/pexpr.pas | 29 ++++++++++++++++-- compiler/symdef.pas | 3 +- compiler/symtable.pas | 68 ++++++++++++++++++++++++++++++++++++++---- tests/test/tobjc30.pp | 17 +++++++++++ tests/test/tobjc30a.pp | 36 ++++++++++++++++++++++ tests/test/tobjc30b.pp | 37 +++++++++++++++++++++++ tests/test/tobjc30c.pp | 31 +++++++++++++++++++ tests/test/uobjc30c.pp | 24 +++++++++++++++ 11 files changed, 282 insertions(+), 32 deletions(-) create mode 100644 tests/test/tobjc30.pp create mode 100644 tests/test/tobjc30a.pp create mode 100644 tests/test/tobjc30b.pp create mode 100644 tests/test/tobjc30c.pp create mode 100644 tests/test/uobjc30c.pp diff --git a/.gitattributes b/.gitattributes index fc320ef95e..78997ab783 100644 --- a/.gitattributes +++ b/.gitattributes @@ -8992,6 +8992,10 @@ tests/test/tobjc29.pp svneol=native#text/plain tests/test/tobjc29a.pp svneol=native#text/plain tests/test/tobjc29b.pp svneol=native#text/plain tests/test/tobjc3.pp svneol=native#text/plain +tests/test/tobjc30.pp svneol=native#text/plain +tests/test/tobjc30a.pp svneol=native#text/plain +tests/test/tobjc30b.pp svneol=native#text/plain +tests/test/tobjc30c.pp svneol=native#text/plain tests/test/tobjc4.pp svneol=native#text/plain tests/test/tobjc4a.pp svneol=native#text/plain tests/test/tobjc5.pp svneol=native#text/plain @@ -9332,6 +9336,7 @@ tests/test/uobjc24.pp svneol=native#text/plain tests/test/uobjc26.pp svneol=native#text/plain tests/test/uobjc27a.pp svneol=native#text/plain tests/test/uobjc27b.pp svneol=native#text/plain +tests/test/uobjc30c.pp svneol=native#text/plain tests/test/uobjc7.pp svneol=native#text/plain tests/test/uobjcl1.pp svneol=native#text/plain tests/test/uprec6.pp svneol=native#text/plain diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 658f196b1c..f9a28adbed 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -67,11 +67,11 @@ interface FParaLength : smallint; FAllowVariant : boolean; procedure collect_overloads_in_class(ProcdefOverloadList:TFPObjectList); - procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList); - procedure create_candidate_list(ignorevisibility,allowdefaultparas:boolean); - function proc_add(ps:tprocsym;pd:tprocdef):pcandidate; + procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall: boolean); + procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall:boolean); + function proc_add(ps:tprocsym;pd:tprocdef;objcidcall: boolean):pcandidate; public - constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas:boolean); + constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall:boolean); constructor create_operator(op:ttoken;ppn:tnode); destructor destroy;override; procedure list(all:boolean); @@ -1610,7 +1610,7 @@ implementation TCallCandidates ****************************************************************************} - constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas:boolean); + constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall:boolean); begin if not assigned(sym) then internalerror(200411015); @@ -1618,7 +1618,7 @@ implementation FProcsym:=sym; FProcsymtable:=st; FParanode:=ppn; - create_candidate_list(ignorevisibility,allowdefaultparas); + create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall); end; @@ -1628,7 +1628,7 @@ implementation FProcsym:=nil; FProcsymtable:=nil; FParanode:=ppn; - create_candidate_list(false,false); + create_candidate_list(false,false,false); end; @@ -1685,7 +1685,7 @@ implementation end; - procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList); + procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall: boolean); var j : integer; pd : tprocdef; @@ -1698,10 +1698,15 @@ implementation { we search all overloaded operator definitions in the symtablestack. The found entries are only added to the procs list and not the procsym, because the list can change in every situation } - if FOperator<>NOTOKEN then - hashedid.id:=overloaded_names[FOperator] + if FOperator=NOTOKEN then + begin + if not objcidcall then + hashedid.id:=FProcsym.name + else + hashedid.id:=class_helper_prefix+FProcsym.name; + end else - hashedid.id:=FProcsym.name; + hashedid.id:=overloaded_names[FOperator]; checkstack:=symtablestack.stack; if assigned(FProcsymtable) then @@ -1731,8 +1736,10 @@ implementation hasoverload:=true; ProcdefOverloadList.Add(tprocsym(srsym).ProcdefList[j]); end; - { when there is no explicit overload we stop searching } - if not hasoverload then + { when there is no explicit overload we stop searching, + except for Objective-C methods called via id } + if not hasoverload and + not objcidcall then break; end; end; @@ -1741,7 +1748,7 @@ implementation end; - procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas:boolean); + procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall:boolean); var j : integer; pd : tprocdef; @@ -1755,11 +1762,12 @@ implementation { Find all available overloads for this procsym } ProcdefOverloadList:=TFPObjectList.Create(false); - if (FOperator=NOTOKEN) and + if not objcidcall and + (FOperator=NOTOKEN) and (FProcsym.owner.symtabletype=objectsymtable) then collect_overloads_in_class(ProcdefOverloadList) else - collect_overloads_in_units(ProcdefOverloadList); + collect_overloads_in_units(ProcdefOverloadList,objcidcall); { determine length of parameter list. for operators also enable the variant-operators if @@ -1823,7 +1831,9 @@ implementation hp:=FCandidateProcs; while assigned(hp) do begin - if compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then + if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,[cpo_ignorehidden])>=te_equal) and + (not(po_objc in pd.procoptions) or + (pd.messageinf.str^=hp^.data.messageinf.str^)) then begin found:=true; break; @@ -1831,7 +1841,7 @@ implementation hp:=hp^.next; end; if not found then - proc_add(fprocsym,pd); + proc_add(fprocsym,pd,objcidcall); end; end; @@ -1839,9 +1849,10 @@ implementation end; - function tcallcandidates.proc_add(ps:tprocsym;pd:tprocdef):pcandidate; + function tcallcandidates.proc_add(ps:tprocsym;pd:tprocdef;objcidcall: boolean):pcandidate; var defaultparacnt : integer; + parentst : tsymtable; begin { generate new candidate entry } new(result); @@ -1868,7 +1879,15 @@ implementation end; { Give a small penalty for overloaded methods not in defined the current class/unit } - if ps.owner<>pd.owner then + parentst:=ps.owner; + { when calling Objective-C methods via id.method, then the found + procsym will be inside an arbitrary ObjectSymtable, and we don't + want togive the methods of that particular objcclass precedence over + other methods, so instead check against the symtable in which this + objcclass is defined } + if objcidcall then + parentst:=parentst.defowner.owner; + if (parentst<>pd.owner) then result^.ordinal_distance:=result^.ordinal_distance+1.0; end; diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 487444f83b..9ce1028bf4 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -47,7 +47,8 @@ interface cnf_member_call, { called with implicit methodpointer tree } cnf_uses_varargs, { varargs are used in the declaration } cnf_create_failed, { exception thrown in constructor -> don't call beforedestruction } - cnf_objc_processed { the procedure name has been set to the appropriate objc_msgSend* variant -> don't process again } + cnf_objc_processed, { the procedure name has been set to the appropriate objc_msgSend* variant -> don't process again } + cnf_objc_id_call { the procedure is a member call via id -> any ObjC method of any ObjC type in scope is fair game } ); tcallnodeflags = set of tcallnodeflag; @@ -2538,7 +2539,7 @@ implementation { ignore possible private for properties or in delphi mode for anon. inherited (FK) } ignorevisibility:=(nf_isproperty in flags) or ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)); - candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags)); + candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags); { no procedures found? then there is something wrong with the parameter size or the procedures are diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 5c3a6e1d8d..d2740a2c83 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -2086,9 +2086,32 @@ implementation end; pointerdef: begin - Message(parser_e_invalid_qualifier); - if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then - Message(parser_h_maybe_deref_caret_missing); + if (p1.resultdef=objc_idtype) then + begin + { objc's id type can be used to call any + Objective-C method of any Objective-C class + type that's currently in scope } + if search_objc_method(pattern,srsym,srsymtable) then + begin + consume(_ID); + do_proc_call(srsym,srsymtable,nil, + (getaddr and not(token in [_CARET,_POINT])), + again,p1,[cnf_objc_id_call]); + { we need to know which procedure is called } + do_typecheckpass(p1); + end + else + begin + consume(_ID); + Message(parser_e_methode_id_expected); + end; + end + else + begin + Message(parser_e_invalid_qualifier); + if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then + Message(parser_h_maybe_deref_caret_missing); + end end; else begin diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 70db7198d5..5c08f02263 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -4140,7 +4140,8 @@ implementation tstoredsymtable(symtable).derefimpl; { the procdefs are not owned by the class helper procsyms, so they are not stored/restored either -> re-add them here } - if (oo_is_classhelper in objectoptions) then + if (objecttype=odt_objcclass) or + (oo_is_classhelper in objectoptions) then symtable.DefList.ForEachCall(@create_class_helper_for_procdef,nil); end; diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 306a585b14..67cd426a6f 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -205,6 +205,7 @@ interface function search_assignment_operator(from_def,to_def:Tdef):Tprocdef; function search_enumerator_operator(type_def:Tdef):Tprocdef; function search_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; + function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; {Looks for macro s (must be given in upper case) in the macrosymbolstack, } {and returns it if found. Returns nil otherwise.} function search_macro(const s : string):tsym; @@ -2060,6 +2061,12 @@ implementation if (oo_is_classhelper in defowner.objectoptions) and pd.is_related(defowner.childof) then begin + { we need to know if a procedure references symbols + 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 + 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 @@ -2069,12 +2076,6 @@ implementation } srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym; srsymtable:=srsym.owner; - { we need to know if a procedure references symbols - 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 - include(current_procinfo.flags,pi_uses_static_symtable); addsymref(srsym); result:=true; exit; @@ -2089,6 +2090,61 @@ implementation end; + function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; + var + hashedid : THashedIDString; + stackitem : psymtablestackitem; + i : longint; + begin + hashedid.id:=class_helper_prefix+s; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + srsymtable:=stackitem^.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) then + begin + if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or + not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or + (srsym.typ<>procsym) then + internalerror(2009112005); + { check whether this procsym includes a helper for this particular class } + for i:=0 to tprocsym(srsym).procdeflist.count-1 do + begin + { we need to know if a procedure references symbols + 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 + include(current_procinfo.flags,pi_uses_static_symtable); + { no need to keep looking. There might be other + methods with the same name, but that doesn't matter + as far as the basic procsym is concerned. + } + srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym; + { We need the symtable in which the classhelper-like sym + is located, not the objectdef. The reason is that the + callnode will climb the symtablestack until it encounters + this symtable to start looking for overloads (and it won't + find the objectsymtable in which this method sym is + located + + srsymtable:=srsym.owner; + } + addsymref(srsym); + result:=true; + exit; + end; + end; + stackitem:=stackitem^.next; + end; + srsym:=nil; + srsymtable:=nil; + result:=false; + end; + + + function search_class_member(pd : tobjectdef;const s : string):tsym; { searches n in symtable of pd and all anchestors } var diff --git a/tests/test/tobjc30.pp b/tests/test/tobjc30.pp new file mode 100644 index 0000000000..0abc62fbef --- /dev/null +++ b/tests/test/tobjc30.pp @@ -0,0 +1,17 @@ +{ %target=darwin } +{ %cpu=powerpc,powerpc64,i386,x86_64,arm } + +{ Written by Jonas Maebe in 2009, released into the Public Domain } + +{$mode objfpc} +{$modeswitch objectivec1} + +var + a: id; +begin + a:=NSObject.alloc.init; + if a.conformsToProtocol_(objcprotocol(NSObjectProtocol)) then + writeln('ok conformsToProtocol') + else + halt(1); +end. diff --git a/tests/test/tobjc30a.pp b/tests/test/tobjc30a.pp new file mode 100644 index 0000000000..eda8e148b9 --- /dev/null +++ b/tests/test/tobjc30a.pp @@ -0,0 +1,36 @@ +{ %target=darwin } +{ %cpu=powerpc,powerpc64,i386,x86_64,arm } + +{ Written by Jonas Maebe in 2009, released into the Public Domain } + +{$mode objfpc} +{$modeswitch objectivec1} + +type + { should succeed because both methods have the same selector } + ta = objcclass(NSObject) + function proc1(para: longint): longint; message 'proc1:'; + end; + + tb = objcclass(NSObject) + function proc1(para: longint): longint; message 'proc1:'; + end; + +function ta.proc1(para: longint): longint; +begin + writeln(para); + proc1:=para; +end; + +function tb.proc1(para: longint): longint; +begin + writeln(para); + proc1:=para; +end; + +var + a: id; +begin + a:=ta.alloc.init; + a.proc1(5); +end. diff --git a/tests/test/tobjc30b.pp b/tests/test/tobjc30b.pp new file mode 100644 index 0000000000..ffe9e08f43 --- /dev/null +++ b/tests/test/tobjc30b.pp @@ -0,0 +1,37 @@ +{ %target=darwin } +{ %cpu=powerpc,powerpc64,i386,x86_64,arm } +{ %fail } + +{ Written by Jonas Maebe in 2009, released into the Public Domain } + +{$mode objfpc} +{$modeswitch objectivec1} + +type + { should succeed because both methods have the same selector } + ta = objcclass(NSObject) + function proc1(para: longint): longint; message 'proc1:'; + end; + + tb = objcclass(NSObject) + function proc1(para: longint): longint; message 'anotherselector:'; + end; + +function ta.proc1(para: longint): longint; +begin + writeln(para); + proc1:=para; +end; + +function tb.proc1(para: longint): longint; +begin + writeln(para); + proc1:=para; +end; + +var + a: id; +begin + a:=ta.alloc.init; + a.proc1(5); +end. diff --git a/tests/test/tobjc30c.pp b/tests/test/tobjc30c.pp new file mode 100644 index 0000000000..a2fbd86f47 --- /dev/null +++ b/tests/test/tobjc30c.pp @@ -0,0 +1,31 @@ +{ %target=darwin } +{ %cpu=powerpc,powerpc64,i386,x86_64,arm } + +{ Written by Jonas Maebe in 2009, released into the Public Domain } + +{$mode objfpc} +{$modeswitch objectivec1} + +uses + uobjc30c; + +type + tla = objcclass(NSObject) + function mytest(const c: shortstring): longint; message 'mystest:'; + end; + +function tla.mytest(const c: shortstring): longint; +begin + halt(1); + result:=-1; +end; + +var + a: id; +begin + a:=ta.alloc.init; + ta(a).field:=123; + if (a.mytest('c')<>123) then + halt(2); + a.release +end. diff --git a/tests/test/uobjc30c.pp b/tests/test/uobjc30c.pp new file mode 100644 index 0000000000..fefe907a53 --- /dev/null +++ b/tests/test/uobjc30c.pp @@ -0,0 +1,24 @@ +{$mode objfpc} +{$modeswitch objectivec1} + +{ Written by Jonas Maebe in 2009, released into the public domain } + +unit uobjc30c; + +interface + +type + ta = objcclass(NSObject) + field: longint; + function mytest(c: char): longint; message 'mystest:'; + end; + +implementation + +function ta.mytest(c: char): longint; +begin + writeln(c); + result:=field; +end; + +end.