diff --git a/.gitattributes b/.gitattributes
index 1dc22b533a..f03f7df3eb 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -15415,6 +15415,7 @@ tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal
tests/test/units/classes/ttbits.pp svneol=native#text/pascal
tests/test/units/classes/ttlist.pp svneol=native#text/plain
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 c4b4059404..67eeca3bc0 100644
--- a/compiler/defcmp.pas
+++ b/compiler/defcmp.pas
@@ -2505,6 +2505,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 79c15018d3..61d95f9a21 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -3864,6 +3864,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 a7041e4312..a97ad6399f 100644
--- a/compiler/pdecl.pas
+++ b/compiler/pdecl.pas
@@ -539,6 +539,52 @@ implementation
consume(_RECKKLAMMER);
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;var rtti_attrs_def: trtti_attribute_list);
function determine_generic_def(name:tidstring):tstoreddef;
@@ -1057,7 +1103,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 bc7d0caba9..cfbe00b23f 100644
--- a/compiler/symconst.pas
+++ b/compiler/symconst.pas
@@ -420,7 +420,9 @@ type
po_noinline,
{ same as po_varargs, but with an array-of-const parameter instead of with the
"varargs" modifier or Mac-Pascal ".." parameter }
- po_variadic
+ po_variadic,
+ { implicitly return same type as the class instance to which the message is sent }
+ po_objc_related_result_type
);
tprocoptions=set of tprocoption;
@@ -1064,7 +1066,8 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
'po_is_auto_getter',{po_is_auto_getter}
'po_is_auto_setter',{po_is_auto_setter}
'po_noinline',{po_noinline}
- 'C-style array-of-const' {po_variadic}
+ 'C-style array-of-const', {po_variadic}
+ 'objc-related-result-type' {po_objc_related_result_type}
);
implementation
diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp
index 4a648ce950..f162dc5cbc 100644
--- a/compiler/utils/ppuutils/ppudump.pp
+++ b/compiler/utils/ppuutils/ppudump.pp
@@ -2951,7 +2951,8 @@ const
(mask:po_is_auto_getter; str: 'Automatically generated getter'),
(mask:po_is_auto_setter; str: 'Automatically generated setter'),
(mask:po_noinline; str: 'Never inline'),
- (mask:po_variadic; str: 'C VarArgs with array-of-const para')
+ (mask:po_variadic; str: 'C VarArgs with array-of-const para'),
+ (mask:po_objc_related_result_type; str: 'Objective-C related result type')
);
var
proctypeoption : tproctypeoption;
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.