paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 18:07:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Objective-Pascal inferred result type and improved category method searching

Browse Source 
--- 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 -
This commit is contained in:
Jonas Maebe 2019-08-31 11:43:41 +00:00
parent 43436808e9
commit f29598384b
11 changed files with 153 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

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

7
compiler/defcmp.pas
View File

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

14
compiler/ncal.pas
View File

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

52
compiler/pdecl.pas
View File

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

7
compiler/symconst.pas
View File

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

62
compiler/symtable.pas
View File

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

3
compiler/utils/ppuutils/ppudump.pp
View File

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

2
tests/test/tobjc34.pp
View File

@ -15,7 +15,7 @@ type
class procedure testClassOverride; override;
end;
tmyoverrideclass = class of NSObject;
tmyoverrideclass = class of MyOverride;
var
selfshouldbe: tmyoverrideclass;

4
tests/test/tobjc36.pp
View File

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

2
tests/test/tobjcl2.pp
View File

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

31
tests/test/units/cocoaall/tw35994.pp Normal file
View File

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