mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 18:09:15 +02:00
--WARNING: start build process with FPC 2.2.4; won't work when
starting with a previous 2.3.1 or compiler built from the objc branch
+ added basic objcprotocol support (only for external protocols
currently)
o use in type declaration: "type xp = objcprotocol ... end;"
o when defining a root class that implements it:
"type yc = objcclass(xp) ... end" (note: no support yet
for something like "objcclass(id,xp)" or so)
o when defining a non-root class that implements a protocol:
"type zc = objcclass(nsobject,xp) ... end"
o includes support for "required" and "optional" sections
o no support yet for the objcprotocol(<protocol>) expression
that enables getting a class instance representing the
protocol (e.g., for use with "conformsToProtocol:")
o message names have to specified in protocol declarations,
but if an objcclass implements a protocol, the message names do
not have to be repeated (but if they are, they have to match;
the same goes when overriding inherited methods)
+ allow specifying the external name of Objective-C classes and
protocols, since classes and protocols can have the same name
(and you cannot use the same Pascal identifier in such caseq)
+ added NSObject protocol, and make the NSObject class use it
+ added missing NSObject class methods that have the same name
as instance methods (added "class" name prefix to avoid clashes)
* fixed several cases where the compiler did not treat Objective-C
classes/protocols the same as Object Pascal classes/interfaces
(a.o., forward declarations, alignment, regvars, several type
conversions, ...)
* allow "override" directive in objcclass declarations, and print
a hint if it's forgotten in an external declaration (because it
doesn't really matter there, and may make automated header
conversion harder than necessary) and an error if will be used in
a non-external declaration (because it is not possible to start
a new vmt entry-tree in Objective-C, you can only override parent
methods)
* reject objcclasses/protocols as parameters to typeof()
* don't try to test VMT validity of objcclasses/protocols
git-svn-id: branches/objc@13375 -
This commit is contained in:
Jonas Maebe
parent
2bcef8e018
commit
5a2ccfff52
12
.gitattributes
vendored
12
.gitattributes
vendored
@ -8206,6 +8206,18 @@ tests/test/tobjc2.pp svneol=native#text/plain
|
||||
tests/test/tobjc3.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
|
||||
tests/test/tobjc5a.pp svneol=native#text/plain
|
||||
tests/test/tobjc6.pp svneol=native#text/plain
|
||||
tests/test/tobjc7.pp svneol=native#text/plain
|
||||
tests/test/tobjc7a.pp svneol=native#text/plain
|
||||
tests/test/tobjc7b.pp svneol=native#text/plain
|
||||
tests/test/tobjc7c.pp svneol=native#text/plain
|
||||
tests/test/tobjc8.pp svneol=native#text/plain
|
||||
tests/test/tobjc8a.pp svneol=native#text/plain
|
||||
tests/test/tobjc9.pp svneol=native#text/plain
|
||||
tests/test/tobjc9a.pp svneol=native#text/plain
|
||||
tests/test/tobjc9b.pp svneol=native#text/plain
|
||||
tests/test/tobject1.pp svneol=native#text/plain
|
||||
tests/test/tobject2.pp svneol=native#text/plain
|
||||
tests/test/tobject3.pp svneol=native#text/plain
|
||||
|
||||
@ -3023,7 +3023,8 @@ implementation
|
||||
current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0));
|
||||
doappend;
|
||||
end;
|
||||
odt_objcclass:
|
||||
odt_objcclass,
|
||||
odt_objcprotocol:
|
||||
begin
|
||||
// Objective-C class: plain pointer for now
|
||||
append_entry(DW_TAG_pointer_type,false,[]);
|
||||
|
||||
@ -277,7 +277,7 @@ implementation
|
||||
objectdef:
|
||||
begin
|
||||
if (m_delphi in current_settings.modeswitches) and
|
||||
is_class_or_interface_or_dispinterface(def_from) and
|
||||
is_class_or_interface_or_dispinterface_or_objc(def_from) and
|
||||
(cdo_explicit in cdoptions) then
|
||||
begin
|
||||
eq:=te_convert_l1;
|
||||
@ -1113,7 +1113,7 @@ implementation
|
||||
can be assigned to void pointers, but it is less
|
||||
preferred than assigning to a related objectdef }
|
||||
if (
|
||||
is_class_or_interface_or_dispinterface(def_from) or
|
||||
is_class_or_interface_or_dispinterface_or_objc(def_from) or
|
||||
(def_from.typ=classrefdef)
|
||||
) and
|
||||
(tpointerdef(def_to).pointeddef.typ=orddef) and
|
||||
@ -1122,11 +1122,11 @@ implementation
|
||||
doconv:=tc_equal;
|
||||
eq:=te_convert_l2;
|
||||
end
|
||||
else if is_objcclass(def_from) and
|
||||
else if is_objc_class_or_protocol(def_from) and
|
||||
(def_to=objc_idtype) then
|
||||
begin
|
||||
doconv:=tc_equal;
|
||||
eq:=te_convert_l1;
|
||||
eq:=te_convert_l2;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1230,7 +1230,7 @@ implementation
|
||||
end
|
||||
else
|
||||
{ Class/interface specific }
|
||||
if is_class_or_interface_or_dispinterface(def_to) then
|
||||
if is_class_or_interface_or_dispinterface_or_objc(def_to) then
|
||||
begin
|
||||
{ void pointer also for delphi mode }
|
||||
if (m_delphi in current_settings.modeswitches) and
|
||||
@ -1247,9 +1247,19 @@ implementation
|
||||
doconv:=tc_equal;
|
||||
eq:=te_convert_l1;
|
||||
end
|
||||
{ classes can be assigned to interfaces }
|
||||
else if is_interface(def_to) and
|
||||
is_class(def_from) and
|
||||
{ All Objective-C classes are compatible with ID }
|
||||
else if is_objcclass(def_to) and
|
||||
(def_from=objc_idtype) then
|
||||
begin
|
||||
doconv:=tc_equal;
|
||||
eq:=te_convert_l2;
|
||||
end
|
||||
{ classes can be assigned to interfaces
|
||||
(same with objcclass and objcprotocol) }
|
||||
else if ((is_interface(def_to) and
|
||||
is_class(def_from)) or
|
||||
(is_objcprotocol(def_to) and
|
||||
is_objcclass(def_from))) and
|
||||
assigned(tobjectdef(def_from).ImplementedInterfaces) then
|
||||
begin
|
||||
{ we've to search in parent classes as well }
|
||||
@ -1258,7 +1268,11 @@ implementation
|
||||
begin
|
||||
if hobjdef.find_implemented_interface(tobjectdef(def_to))<>nil then
|
||||
begin
|
||||
doconv:=tc_class_2_intf;
|
||||
if is_interface(def_to) then
|
||||
doconv:=tc_class_2_intf
|
||||
else
|
||||
{ for Objective-C, we don't have to do anything special }
|
||||
doconv:=tc_equal;
|
||||
{ don't prefer this over objectdef->objectdef }
|
||||
eq:=te_convert_l2;
|
||||
break;
|
||||
@ -1288,14 +1302,7 @@ implementation
|
||||
doconv:=tc_int_2_int;
|
||||
eq:=te_convert_l1;
|
||||
end;
|
||||
end
|
||||
else if is_objcclass(def_to) and
|
||||
(def_from=objc_idtype) then
|
||||
begin
|
||||
{ All Objective-C classes are compatible with ID }
|
||||
doconv:=tc_equal;
|
||||
eq:=te_convert_l1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
classrefdef :
|
||||
@ -1693,8 +1700,8 @@ implementation
|
||||
(equal_defs(parentretdef,childretdef)) or
|
||||
((parentretdef.typ=objectdef) and
|
||||
(childretdef.typ=objectdef) and
|
||||
is_class_or_interface(parentretdef) and
|
||||
is_class_or_interface(childretdef) and
|
||||
is_class_or_interface_or_objc(parentretdef) and
|
||||
is_class_or_interface_or_objc(childretdef) and
|
||||
(tobjectdef(childretdef).is_related(tobjectdef(parentretdef))))
|
||||
end;
|
||||
|
||||
|
||||
@ -970,7 +970,7 @@ implementation
|
||||
end;
|
||||
objectdef :
|
||||
begin
|
||||
if is_class_or_interface(def) then
|
||||
if is_class_or_interface_or_objc(def) then
|
||||
result := OS_ADDR
|
||||
else
|
||||
result:=int_cgsize(def.size);
|
||||
|
||||
@ -218,7 +218,7 @@ implementation
|
||||
pointerdef :
|
||||
begin
|
||||
if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or
|
||||
is_class_or_interface(rd)) then
|
||||
is_class_or_interface_or_objc(rd)) then
|
||||
begin
|
||||
allowed:=false;
|
||||
exit;
|
||||
@ -280,7 +280,7 @@ implementation
|
||||
begin
|
||||
{ <> and = are defined for classes }
|
||||
if (treetyp in [equaln,unequaln]) and
|
||||
is_class_or_interface(ld) then
|
||||
is_class_or_interface_or_objc(ld) then
|
||||
begin
|
||||
allowed:=false;
|
||||
exit;
|
||||
@ -842,7 +842,7 @@ implementation
|
||||
end;
|
||||
subscriptn :
|
||||
begin
|
||||
if is_class_or_interface(tunarynode(p).left.resultdef) then
|
||||
if is_class_or_interface_or_objc(tunarynode(p).left.resultdef) then
|
||||
newstate := vs_read;
|
||||
p:=tunarynode(p).left;
|
||||
end;
|
||||
@ -996,7 +996,7 @@ implementation
|
||||
pointerdef :
|
||||
gotpointer:=true;
|
||||
objectdef :
|
||||
gotclass:=is_class_or_interface(hp.resultdef);
|
||||
gotclass:=is_class_or_interface_or_objc(hp.resultdef);
|
||||
recorddef :
|
||||
gotrecord:=true;
|
||||
classrefdef :
|
||||
@ -1113,7 +1113,7 @@ implementation
|
||||
pointerdef :
|
||||
gotpointer:=true;
|
||||
objectdef :
|
||||
gotclass:=is_class_or_interface(hp.resultdef);
|
||||
gotclass:=is_class_or_interface_or_objc(hp.resultdef);
|
||||
classrefdef :
|
||||
gotclass:=true;
|
||||
arraydef :
|
||||
@ -1210,7 +1210,7 @@ implementation
|
||||
{ a class/interface access is an implicit }
|
||||
{ dereferencing }
|
||||
hp:=tsubscriptnode(hp).left;
|
||||
if is_class_or_interface(hp.resultdef) then
|
||||
if is_class_or_interface_or_objc(hp.resultdef) then
|
||||
gotderef:=true;
|
||||
end;
|
||||
muln,
|
||||
@ -1299,7 +1299,7 @@ implementation
|
||||
pointerdef :
|
||||
gotpointer:=true;
|
||||
objectdef :
|
||||
gotclass:=is_class_or_interface(hp.resultdef);
|
||||
gotclass:=is_class_or_interface_or_objc(hp.resultdef);
|
||||
recorddef, { handle record like class it needs a subscription }
|
||||
classrefdef :
|
||||
gotclass:=true;
|
||||
|
||||
@ -366,7 +366,7 @@ scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure
|
||||
#
|
||||
# Parser
|
||||
#
|
||||
# 03256 is the last used one
|
||||
# 03261 is the last used one
|
||||
#
|
||||
% \section{Parser messages}
|
||||
% This section lists all parser messages. The parser takes care of the
|
||||
@ -911,12 +911,12 @@ parser_e_no_con_des_in_interfaces=03171_E_Con- and destructors aren't allowed in
|
||||
% Constructor and destructor declarations aren't allowed in interfaces.
|
||||
% In the most cases method \var{QueryInterface} of \var{IUnknown} can
|
||||
% be used to create a new interface.
|
||||
parser_e_no_access_specifier_in_interfaces=03172_E_Access specifiers can't be used in INTERFACES
|
||||
parser_e_no_access_specifier_in_interfaces=03172_E_Access specifiers can't be used in INTERFACEs and OBJCPROTOCOLs
|
||||
% The access specifiers \var{public}, \var{private}, \var{protected} and
|
||||
% \var{published} can't be used in interfaces because all methods
|
||||
% of an interface must be public.
|
||||
parser_e_no_vars_in_interfaces=03173_E_An interface can't contain fields
|
||||
% Declarations of fields aren't allowed in interfaces. An interface
|
||||
% \var{published} can't be used in interfaces and Objective-C protocols because all methods
|
||||
% of an interface/protocol must be public.
|
||||
parser_e_no_vars_in_interfaces=03173_E_An interface or Objective-C protocol cannot contain fields
|
||||
% Declarations of fields are not allowed in interfaces and Objective-C protocols. An interface/protocol
|
||||
% can contain only methods and properties with method read/write specifiers.
|
||||
parser_e_no_local_proc_external=03174_E_Can't declare local procedure as EXTERNAL
|
||||
% Declaring local procedures as external is not possible. Local procedures
|
||||
@ -1203,12 +1203,30 @@ parser_h_no_objc_parent=03256_H_Defining a new Objective-C root class. To derive
|
||||
% root classes in Objective-C. For example, in the Cocoa framework both NSObject and NSProxy are root classes.
|
||||
% Therefore, you have to explicitly define a parent class (such as NSObject) if you want to derive your
|
||||
% Objective-C class from it.
|
||||
parser_e_no_objc_published=03257_E_Objective-C classes cannot have published sections.
|
||||
% In Object Pascal, ``published'' determines whether or not RTTI is generated. Since the Objective-C runtime always needs
|
||||
% RTTI for everything, this specified does not make sense for Objective-C classes.
|
||||
parser_f_need_objc=03258_F_This module requires an Objective-C mode switch to be compiled
|
||||
% This error indicates the use of Objective-C language features without an Objective-C mode switch
|
||||
% active. Enable one via the -M command line switch, or the {\$modeswitch x} directive.
|
||||
parser_e_must_use_override_objc=03259_E_Inherited methods can only be overridden in Objective-C, add ``override''.
|
||||
parser_h_should_use_override_objc=03260_H_Inherited methods can only be overridden in Objective-C, add ``override''.
|
||||
% It is not possible to ``reintroduce'' methods in Objective-C like in Object Pascal. Methods with the same
|
||||
% name always map to the same virtual method entry. In order to make this clear in the source code,
|
||||
% the compiler always requires the ``override'' directive to be specified when implementing overriding
|
||||
% Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C
|
||||
% does not have any ``override''-style keyword (since it's the default and only behaviour in that language),
|
||||
% which makes it hard for automated header conversion tools to include it everywhere.
|
||||
parser_e_objc_message_name_changed=03261_E_Message name "$1" in inherited class is different from message name "$2" in current class.
|
||||
% An overriding Objective-C method cannot have a different message name than an inherited method. The reason
|
||||
% is that these message names uniquely define the message to the Objective-C runtime, which means that
|
||||
% giving them a different message name breaks the ``override'' semantics.
|
||||
% \end{description}
|
||||
|
||||
#
|
||||
# Type Checking
|
||||
#
|
||||
# 04087 is the last used one
|
||||
# 04088 is the last used one
|
||||
#
|
||||
% \section{Type checking errors}
|
||||
% This section lists all errors that can occur when type checking is
|
||||
@ -1506,6 +1524,8 @@ type_e_no_type_info=04087_E_No type info available for this type
|
||||
% Type information is not generated for some types, such as enumerations with gaps
|
||||
% in their value range (this includes enumerations whose lower bound is different
|
||||
% from zero).
|
||||
type_e_protocol_type_expected=04088_E_Objective-C protocol type expected, but got "$1"
|
||||
% The compiler expected a protocol type name, but found something else.
|
||||
% \end{description}
|
||||
#
|
||||
# Symtable
|
||||
|
||||
@ -344,6 +344,11 @@ const
|
||||
parser_e_message_string_too_long=03254;
|
||||
parser_e_objc_message_name_too_long=03255;
|
||||
parser_h_no_objc_parent=03256;
|
||||
parser_e_no_objc_published=03257;
|
||||
parser_f_need_objc=03258;
|
||||
parser_e_must_use_override_objc=03259;
|
||||
parser_h_should_use_override_objc=03260;
|
||||
parser_e_objc_message_name_changed=03261;
|
||||
type_e_mismatch=04000;
|
||||
type_e_incompatible_types=04001;
|
||||
type_e_not_equal_types=04002;
|
||||
@ -422,6 +427,7 @@ const
|
||||
type_e_expected_objc_method_but_got=04085;
|
||||
type_e_expected_objc_method=04086;
|
||||
type_e_no_type_info=04087;
|
||||
type_e_protocol_type_expected=04088;
|
||||
sym_e_id_not_found=05000;
|
||||
sym_f_internal_error_in_symtablestack=05001;
|
||||
sym_e_duplicate_id=05002;
|
||||
@ -794,9 +800,9 @@ const
|
||||
option_info=11024;
|
||||
option_help_pages=11025;
|
||||
|
||||
MsgTxtSize = 51955;
|
||||
MsgTxtSize = 52451;
|
||||
|
||||
MsgIdxMax : array[1..20] of longint=(
|
||||
24,87,257,88,65,51,108,22,202,62,
|
||||
24,87,262,89,65,51,108,22,202,62,
|
||||
47,20,1,1,1,1,1,1,1,1
|
||||
);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1560,18 +1560,18 @@ implementation
|
||||
end
|
||||
|
||||
{ class or interface equation }
|
||||
else if is_class_or_interface(rd) or is_class_or_interface(ld) then
|
||||
else if is_class_or_interface_or_objc(rd) or is_class_or_interface_or_objc(ld) then
|
||||
begin
|
||||
if (nodetype in [equaln,unequaln]) then
|
||||
begin
|
||||
if is_class_or_interface(rd) and is_class_or_interface(ld) then
|
||||
if is_class_or_interface_or_objc(rd) and is_class_or_interface_or_objc(ld) then
|
||||
begin
|
||||
if tobjectdef(rd).is_related(tobjectdef(ld)) then
|
||||
inserttypeconv(right,left.resultdef)
|
||||
else
|
||||
inserttypeconv(left,right.resultdef);
|
||||
end
|
||||
else if is_class_or_interface(rd) then
|
||||
else if is_class_or_interface_or_objc(rd) then
|
||||
inserttypeconv(left,right.resultdef)
|
||||
else
|
||||
inserttypeconv(right,left.resultdef);
|
||||
@ -1595,7 +1595,7 @@ implementation
|
||||
end
|
||||
|
||||
{ allows comperasion with nil pointer }
|
||||
else if is_class_or_interface(rd) or (rd.typ=classrefdef) then
|
||||
else if is_class_or_interface_or_objc(rd) or (rd.typ=classrefdef) then
|
||||
begin
|
||||
if (nodetype in [equaln,unequaln]) then
|
||||
inserttypeconv(left,right.resultdef)
|
||||
@ -1603,7 +1603,7 @@ implementation
|
||||
CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename);
|
||||
end
|
||||
|
||||
else if is_class_or_interface(ld) or (ld.typ=classrefdef) then
|
||||
else if is_class_or_interface_or_objc(ld) or (ld.typ=classrefdef) then
|
||||
begin
|
||||
if (nodetype in [equaln,unequaln]) then
|
||||
inserttypeconv(right,left.resultdef)
|
||||
@ -2671,7 +2671,7 @@ implementation
|
||||
expectloc:=LOC_FLAGS;
|
||||
end
|
||||
|
||||
else if is_class_or_interface(ld) then
|
||||
else if is_class_or_interface_or_objc(ld) then
|
||||
begin
|
||||
expectloc:=LOC_FLAGS;
|
||||
end
|
||||
|
||||
@ -273,9 +273,8 @@ implementation
|
||||
if codegenerror then
|
||||
exit;
|
||||
paraloc1.init;
|
||||
{ classes and interfaces must be dereferenced implicit }
|
||||
if is_class_or_interface(left.resultdef) or
|
||||
is_objcclass(left.resultdef) then
|
||||
{ classes and interfaces must be dereferenced implicitly }
|
||||
if is_class_or_interface_or_objc(left.resultdef) then
|
||||
begin
|
||||
{ the contents of a class are aligned to a sizeof(pointer) }
|
||||
location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),sizeof(pint));
|
||||
|
||||
@ -2867,7 +2867,8 @@ implementation
|
||||
|
||||
{ test validity of VMT }
|
||||
if not(is_interface(objdef)) and
|
||||
not(is_cppclass(objdef)) then
|
||||
not(is_cppclass(objdef)) and
|
||||
not(is_objc_class_or_protocol(objdef)) then
|
||||
cg.g_maybe_testvmt(list,vmtreg,objdef);
|
||||
end;
|
||||
|
||||
|
||||
@ -1793,8 +1793,8 @@ implementation
|
||||
make_not_regable(left,[ra_addr_regable]);
|
||||
|
||||
{ class/interface to class/interface, with checkobject support }
|
||||
if is_class_or_interface(resultdef) and
|
||||
is_class_or_interface(left.resultdef) then
|
||||
if is_class_or_interface_or_objc(resultdef) and
|
||||
is_class_or_interface_or_objc(left.resultdef) then
|
||||
begin
|
||||
{ check if the types are related }
|
||||
if not(nf_internal in flags) and
|
||||
@ -1815,7 +1815,9 @@ implementation
|
||||
end;
|
||||
|
||||
{ Add runtime check? }
|
||||
if (cs_check_object in current_settings.localswitches) and
|
||||
if not is_objc_class_or_protocol(resultdef) and
|
||||
not is_objc_class_or_protocol(left.resultdef) and
|
||||
(cs_check_object in current_settings.localswitches) and
|
||||
not(nf_internal in flags) then
|
||||
begin
|
||||
{ we can translate the typeconvnode to 'as' when
|
||||
@ -1866,7 +1868,7 @@ implementation
|
||||
{ however, there are some exceptions }
|
||||
(not(resultdef.typ in [arraydef,recorddef,setdef,stringdef,
|
||||
filedef,variantdef,objectdef]) or
|
||||
is_class_or_interface(resultdef) or
|
||||
is_class_or_interface_or_objc(resultdef) or
|
||||
{ the softfloat code generates casts <const. float> to record }
|
||||
(nf_internal in flags)
|
||||
))
|
||||
|
||||
@ -629,8 +629,8 @@ implementation
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
{ classes must be dereferenced implicit }
|
||||
if is_class_or_interface(left.resultdef) then
|
||||
{ classes must be dereferenced implicitly }
|
||||
if is_class_or_interface_or_objc(left.resultdef) then
|
||||
expectloc:=LOC_REFERENCE
|
||||
else
|
||||
begin
|
||||
|
||||
@ -39,6 +39,7 @@ interface
|
||||
_Class : tobjectdef;
|
||||
function is_new_vmt_entry(pd:tprocdef):boolean;
|
||||
procedure add_new_vmt_entry(pd:tprocdef);
|
||||
function check_msg_str(vmtpd, pd: tprocdef):boolean;
|
||||
function intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
|
||||
procedure intf_get_procdefs(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
|
||||
procedure intf_get_procdefs_recursive(ImplIntf:TImplementedInterface;IntfDef:TObjectDef);
|
||||
@ -47,7 +48,8 @@ interface
|
||||
public
|
||||
constructor create(c:tobjectdef);
|
||||
destructor destroy;override;
|
||||
procedure generate_vmt;
|
||||
procedure generate_vmt;
|
||||
procedure build_interface_mappings;
|
||||
end;
|
||||
|
||||
type
|
||||
@ -179,9 +181,49 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function TVMTBuilder.check_msg_str(vmtpd, pd: tprocdef): boolean;
|
||||
begin
|
||||
result:=true;
|
||||
if not(is_objc_class_or_protocol(_class)) then
|
||||
begin
|
||||
{ the only requirement for normal methods is that both either
|
||||
have a message string or not (the value is irrelevant) }
|
||||
if ((pd.procoptions * [po_msgstr]) <> (vmtpd.procoptions * [po_msgstr])) then
|
||||
begin
|
||||
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false));
|
||||
tprocsym(vmtpd.procsym).write_parameter_lists(pd);
|
||||
result:=false;
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ the compiler should have ensured that the protocol or parent
|
||||
class method has a message name specified }
|
||||
if not(po_msgstr in vmtpd.procoptions) then
|
||||
internalerror(2009070601);
|
||||
if not(po_msgstr in pd.procoptions) then
|
||||
begin
|
||||
{ copy the protocol's/parent class' message name to the one in
|
||||
the class if none has been specified there }
|
||||
include(pd.procoptions,po_msgstr);
|
||||
pd.messageinf.str:=stringdup(vmtpd.messageinf.str^);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ if both have a message name, make sure they are equal }
|
||||
if (vmtpd.messageinf.str^<>pd.messageinf.str^) then
|
||||
begin
|
||||
MessagePos2(pd.fileinfo,parser_e_objc_message_name_changed,vmtpd.messageinf.str^,pd.messageinf.str^);
|
||||
result:=false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function TVMTBuilder.is_new_vmt_entry(pd:tprocdef):boolean;
|
||||
const
|
||||
po_comp = [po_classmethod,po_virtualmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
|
||||
po_comp = [po_classmethod,po_virtualmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgint,
|
||||
po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
|
||||
var
|
||||
i : longint;
|
||||
@ -233,7 +275,7 @@ implementation
|
||||
(
|
||||
not(po_virtualmethod in pd.procoptions) or
|
||||
{ new one has not override }
|
||||
(is_class_or_interface(_class) and not(po_overridingmethod in pd.procoptions))
|
||||
(is_class_or_interface_or_objc(_class) and not(po_overridingmethod in pd.procoptions))
|
||||
) then
|
||||
begin
|
||||
if (
|
||||
@ -242,7 +284,31 @@ implementation
|
||||
) then
|
||||
begin
|
||||
if not(po_reintroduce in pd.procoptions) then
|
||||
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false));
|
||||
if not(is_objc_class_or_protocol(_class)) then
|
||||
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
|
||||
else
|
||||
begin
|
||||
{ In Objective-C, you cannot create a new VMT entry to
|
||||
start a new inheritance tree. We therefore give an
|
||||
error when the class is implemented in Pascal, to
|
||||
avoid confusion due to things working differently
|
||||
with Object Pascal classes.
|
||||
|
||||
In case of external classes, we only give a hint,
|
||||
because requiring override everywhere may make
|
||||
automated header translation tools too complex. }
|
||||
if not(oo_is_external in _class.objectoptions) then
|
||||
MessagePos1(pd.fileinfo,parser_e_must_use_override_objc,pd.fullprocname(false))
|
||||
{ there may be a lot of these in auto-translated
|
||||
heaeders, so only calculate the fullprocname if
|
||||
the hint will be shown }
|
||||
else if CheckVerbosity(V_Hint) then
|
||||
MessagePos1(pd.fileinfo,parser_h_should_use_override_objc,pd.fullprocname(false));
|
||||
{ no new entry, but copy the message name if any from
|
||||
the procdef in the parent class }
|
||||
check_msg_str(vmtpd,pd);
|
||||
exit;
|
||||
end;
|
||||
{ disable/hide old VMT entry }
|
||||
vmtentry^.visibility:=vis_hidden;
|
||||
end;
|
||||
@ -275,6 +341,8 @@ implementation
|
||||
tprocsym(vmtpd.procsym).write_parameter_lists(pd);
|
||||
end;
|
||||
|
||||
check_msg_str(vmtpd,pd);
|
||||
|
||||
{ Give a note if the new visibility is lower. For a higher
|
||||
visibility update the vmt info }
|
||||
if vmtentry^.visibility>pd.visibility then
|
||||
@ -301,10 +369,12 @@ implementation
|
||||
begin
|
||||
if not(po_reintroduce in pd.procoptions) then
|
||||
begin
|
||||
if not is_object(_class) then
|
||||
if not is_object(_class) and
|
||||
not is_objc_class_or_protocol(_class) then
|
||||
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
|
||||
else
|
||||
{ objects don't allow starting a new virtual tree }
|
||||
{ objects don't allow starting a new virtual tree
|
||||
and neither does Objective-C }
|
||||
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,vmtpd.fullprocname(false));
|
||||
end;
|
||||
{ disable/hide old VMT entry }
|
||||
@ -320,7 +390,7 @@ implementation
|
||||
|
||||
function TVMTBuilder.intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef;
|
||||
const
|
||||
po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgstr,po_msgint,
|
||||
po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgint,
|
||||
po_exports,po_varargs,po_explicitparaloc,po_nostackframe];
|
||||
var
|
||||
implprocdef : Tprocdef;
|
||||
@ -346,7 +416,8 @@ implementation
|
||||
(compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and
|
||||
(proc.proccalloption=implprocdef.proccalloption) and
|
||||
(proc.proctypeoption=implprocdef.proctypeoption) and
|
||||
((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) then
|
||||
((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) and
|
||||
check_msg_str(proc,implprocdef) then
|
||||
begin
|
||||
result:=implprocdef;
|
||||
exit;
|
||||
@ -386,9 +457,32 @@ implementation
|
||||
implprocdef:=intf_search_procdef_by_name(tprocdef(def),tprocdef(def).procsym.name);
|
||||
{ Add procdef to the implemented interface }
|
||||
if assigned(implprocdef) then
|
||||
ImplIntf.AddImplProc(implprocdef)
|
||||
begin
|
||||
if (implprocdef._class.objecttype<>odt_objcclass) then
|
||||
ImplIntf.AddImplProc(implprocdef)
|
||||
else
|
||||
begin
|
||||
{ If no message name has been specified for the method
|
||||
in the objcclass, copy it from the protocol
|
||||
definition. }
|
||||
if not(po_msgstr in tprocdef(def).procoptions) then
|
||||
begin
|
||||
include(tprocdef(def).procoptions,po_msgstr);
|
||||
implprocdef.messageinf.str:=stringdup(tprocdef(def).messageinf.str^);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ If a message name has been specified in the
|
||||
objcclass, it has to match the message name in the
|
||||
protocol definition. }
|
||||
if (implprocdef.messageinf.str^<>tprocdef(def).messageinf.str^) then
|
||||
MessagePos2(implprocdef.fileinfo,parser_e_objc_message_name_changed,tprocdef(def).messageinf.str^,implprocdef.messageinf.str^);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if ImplIntf.IType=etStandard then
|
||||
if (ImplIntf.IType=etStandard) and
|
||||
not(tprocdef(def).optional) then
|
||||
Message1(sym_e_no_matching_implementation_found,tprocdef(def).fullprocname(false));
|
||||
end;
|
||||
end;
|
||||
@ -545,7 +639,6 @@ implementation
|
||||
var
|
||||
i : longint;
|
||||
def : tdef;
|
||||
ImplIntf : TImplementedInterface;
|
||||
old_current_objectdef : tobjectdef;
|
||||
begin
|
||||
old_current_objectdef:=current_objectdef;
|
||||
@ -574,7 +667,25 @@ implementation
|
||||
add_new_vmt_entry(tprocdef(def));
|
||||
end;
|
||||
end;
|
||||
build_interface_mappings;
|
||||
if assigned(_class.ImplementedInterfaces) and
|
||||
not(is_objc_class_or_protocol(_class)) then
|
||||
begin
|
||||
{ Optimize interface tables to reuse wrappers }
|
||||
intf_optimize_vtbls;
|
||||
{ Allocate interface tables }
|
||||
intf_allocate_vtbls;
|
||||
end;
|
||||
|
||||
current_objectdef:=old_current_objectdef;
|
||||
end;
|
||||
|
||||
|
||||
procedure TVMTBuilder.build_interface_mappings;
|
||||
var
|
||||
ImplIntf : TImplementedInterface;
|
||||
i: longint;
|
||||
begin
|
||||
{ Find Procdefs implementing the interfaces }
|
||||
if assigned(_class.ImplementedInterfaces) then
|
||||
begin
|
||||
@ -584,13 +695,7 @@ implementation
|
||||
ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]);
|
||||
intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef);
|
||||
end;
|
||||
{ Optimize interface tables to reuse wrappers }
|
||||
intf_optimize_vtbls;
|
||||
{ Allocate interface tables }
|
||||
intf_allocate_vtbls;
|
||||
end;
|
||||
|
||||
current_objectdef:=old_current_objectdef;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -658,7 +658,7 @@ implementation
|
||||
end;
|
||||
subscriptn:
|
||||
begin
|
||||
if is_class_or_interface(tunarynode(p).left.resultdef) then
|
||||
if is_class_or_interface_or_objc(tunarynode(p).left.resultdef) then
|
||||
inc(result);
|
||||
if (result = NODE_COMPLEXITY_INF) then
|
||||
exit;
|
||||
|
||||
@ -278,19 +278,30 @@ implementation
|
||||
|
||||
procedure types_dec;
|
||||
|
||||
procedure finish_objc_class(od: tobjectdef);
|
||||
procedure get_objc_class_or_protocol_external_status(od: tobjectdef);
|
||||
begin
|
||||
{ Objective-C classes can be external -> all messages inside are
|
||||
external (defined at the class level instead of per method, so
|
||||
that you cannot define some methods as external and some not)
|
||||
}
|
||||
if (token = _ID) and
|
||||
(idtoken = _EXTERNAL) then
|
||||
if (token=_ID) and
|
||||
(idtoken=_EXTERNAL) then
|
||||
begin
|
||||
consume(_EXTERNAL);
|
||||
if (token=_ID) and
|
||||
(idtoken=_NAME) then
|
||||
begin
|
||||
consume(_NAME);
|
||||
od.objextname:=stringdup(get_stringconst);
|
||||
end
|
||||
else
|
||||
od.objextname:=stringdup(od.objrealname^);
|
||||
consume(_SEMICOLON);
|
||||
od.make_all_methods_external;
|
||||
end;
|
||||
include(od.objectoptions,oo_is_external);
|
||||
end
|
||||
else { or also allow "public name 'x'"? }
|
||||
od.objextname:=stringdup(od.objrealname^);
|
||||
end;
|
||||
|
||||
|
||||
@ -380,7 +391,7 @@ implementation
|
||||
(token=_DISPINTERFACE) or
|
||||
(token=_OBJCCLASS)) and
|
||||
(assigned(ttypesym(sym).typedef)) and
|
||||
is_class_or_interface_or_dispinterface(ttypesym(sym).typedef) and
|
||||
is_class_or_interface_or_dispinterface_or_objc(ttypesym(sym).typedef) and
|
||||
(oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then
|
||||
begin
|
||||
case token of
|
||||
@ -395,6 +406,8 @@ implementation
|
||||
objecttype:=odt_dispinterface;
|
||||
_OBJCCLASS :
|
||||
objecttype:=odt_objcclass;
|
||||
_OBJCPROTOCOL :
|
||||
objecttype:=odt_objcprotocol;
|
||||
else
|
||||
internalerror(200811072);
|
||||
end;
|
||||
@ -432,7 +445,7 @@ implementation
|
||||
hdef:=tstoreddef(hdef).getcopy;
|
||||
|
||||
{ fix name, it is used e.g. for tables }
|
||||
if is_class_or_interface_or_dispinterface(hdef) then
|
||||
if is_class_or_interface_or_dispinterface_or_objc(hdef) then
|
||||
with tobjectdef(hdef) do
|
||||
begin
|
||||
stringdispose(objname);
|
||||
@ -489,21 +502,33 @@ implementation
|
||||
end;
|
||||
objectdef :
|
||||
begin
|
||||
try_consume_hintdirective(newtype.symoptions);
|
||||
consume(_SEMICOLON);
|
||||
|
||||
{ we have to know whether the class or protocol is
|
||||
external before the vmt is built, because some errors/
|
||||
hints depend on this }
|
||||
if is_objc_class_or_protocol(hdef) then
|
||||
get_objc_class_or_protocol_external_status(tobjectdef(hdef));
|
||||
|
||||
{ Build VMT indexes, skip for type renaming and forward classes }
|
||||
if (hdef.typesym=newtype) and
|
||||
not(oo_is_forward in tobjectdef(hdef).objectoptions) and
|
||||
not(df_generic in hdef.defoptions) and
|
||||
not is_objcclass(hdef) then
|
||||
not(df_generic in hdef.defoptions) then
|
||||
begin
|
||||
vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef));
|
||||
vmtbuilder.generate_vmt;
|
||||
vmtbuilder.free;
|
||||
end;
|
||||
try_consume_hintdirective(newtype.symoptions);
|
||||
consume(_SEMICOLON);
|
||||
|
||||
if is_objcclass(hdef) then
|
||||
finish_objc_class(tobjectdef(hdef));
|
||||
{ In case of an objcclass, verify that all methods have a message
|
||||
name set. We only check this now, because message names can be set
|
||||
during the protocol (interface) mapping. At the same time, set the
|
||||
mangled names.
|
||||
}
|
||||
if is_objc_class_or_protocol(hdef) then
|
||||
tobjectdef(hdef).check_and_finish_messages;
|
||||
|
||||
end;
|
||||
recorddef :
|
||||
begin
|
||||
|
||||
@ -160,6 +160,23 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure setobjcclassmethodoptions;
|
||||
var
|
||||
i : longint;
|
||||
def : tdef;
|
||||
begin
|
||||
for i:=0 to current_objectdef.symtable.DefList.count-1 do
|
||||
begin
|
||||
def:=tdef(current_objectdef.symtable.DefList[i]);
|
||||
if assigned(def) and
|
||||
(def.typ=procdef) then
|
||||
begin
|
||||
include(tprocdef(def).procoptions,po_virtualmethod);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure handleImplementedInterface(intfdef : tobjectdef);
|
||||
begin
|
||||
if not is_interface(intfdef) then
|
||||
@ -180,7 +197,23 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure readImplementedInterfaces;
|
||||
procedure handleImplementedProtocol(intfdef : tobjectdef);
|
||||
begin
|
||||
if not is_objcprotocol(intfdef) then
|
||||
begin
|
||||
Message1(type_e_protocol_type_expected,intfdef.typename);
|
||||
exit;
|
||||
end;
|
||||
if current_objectdef.find_implemented_interface(intfdef)<>nil then
|
||||
Message1(sym_e_duplicate_id,intfdef.objname^)
|
||||
else
|
||||
begin
|
||||
current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure readImplementedInterfacesAndProtocols(intf: boolean);
|
||||
var
|
||||
hdef : tdef;
|
||||
begin
|
||||
@ -189,10 +222,16 @@ implementation
|
||||
id_type(hdef,false);
|
||||
if (hdef.typ<>objectdef) then
|
||||
begin
|
||||
Message1(type_e_interface_type_expected,hdef.typename);
|
||||
if intf then
|
||||
Message1(type_e_interface_type_expected,hdef.typename)
|
||||
else
|
||||
Message1(type_e_protocol_type_expected,hdef.typename);
|
||||
continue;
|
||||
end;
|
||||
handleImplementedInterface(tobjectdef(hdef));
|
||||
if intf then
|
||||
handleImplementedInterface(tobjectdef(hdef))
|
||||
else
|
||||
handleImplementedProtocol(tobjectdef(hdef));
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -274,6 +313,18 @@ implementation
|
||||
Message(parser_e_mix_of_classes_and_objects);
|
||||
odt_objcclass:
|
||||
if not(is_objcclass(childof)) then
|
||||
begin
|
||||
if is_objcprotocol(childof) then
|
||||
begin
|
||||
intfchildof:=childof;
|
||||
childof:=nil;
|
||||
CGMessage(parser_h_no_objc_parent);
|
||||
end
|
||||
else
|
||||
Message(parser_e_mix_of_classes_and_objects);
|
||||
end;
|
||||
odt_objcprotocol:
|
||||
if not(is_objcprotocol(childof)) then
|
||||
Message(parser_e_mix_of_classes_and_objects);
|
||||
odt_object:
|
||||
if not(is_object(childof)) then
|
||||
@ -325,11 +376,14 @@ implementation
|
||||
|
||||
if hasparentdefined then
|
||||
begin
|
||||
if current_objectdef.objecttype=odt_class then
|
||||
if current_objectdef.objecttype in [odt_class,odt_objcclass] then
|
||||
begin
|
||||
if assigned(intfchildof) then
|
||||
handleImplementedInterface(intfchildof);
|
||||
readImplementedInterfaces;
|
||||
if current_objectdef.objecttype=odt_class then
|
||||
handleImplementedInterface(intfchildof)
|
||||
else
|
||||
handleImplementedProtocol(intfchildof);
|
||||
readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
|
||||
end;
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
@ -374,14 +428,12 @@ implementation
|
||||
|
||||
procedure chkobjc(pd: tprocdef);
|
||||
begin
|
||||
if is_objcclass(pd._class) then
|
||||
if is_objc_class_or_protocol(pd._class) then
|
||||
begin
|
||||
{ none of the explicit calling conventions should be allowed }
|
||||
if (po_hascallingconvention in pd.procoptions) then
|
||||
internalerror(2009032501);
|
||||
pd.proccalloption:=pocall_cdecl;
|
||||
if not(po_msgstr in pd.procoptions) then
|
||||
Message(parser_e_objc_requires_msgstr);
|
||||
include(pd.procoptions,po_objc);
|
||||
end;
|
||||
end;
|
||||
@ -450,11 +502,19 @@ implementation
|
||||
end;
|
||||
_ID :
|
||||
begin
|
||||
case idtoken of
|
||||
if is_objcprotocol(current_objectdef) and
|
||||
((idtoken=_REQUIRED) or
|
||||
(idtoken=_OPTIONAL)) then
|
||||
begin
|
||||
current_objectdef.symtable.currentlyoptional:=(idtoken=_OPTIONAL);
|
||||
consume(idtoken)
|
||||
end
|
||||
else case idtoken of
|
||||
_PRIVATE :
|
||||
begin
|
||||
if is_interface(current_objectdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
if is_interface(current_objectdef) or
|
||||
is_objcprotocol(current_objectdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_PRIVATE);
|
||||
current_objectdef.symtable.currentvisibility:=vis_private;
|
||||
include(current_objectdef.objectoptions,oo_has_private);
|
||||
@ -462,7 +522,8 @@ implementation
|
||||
end;
|
||||
_PROTECTED :
|
||||
begin
|
||||
if is_interface(current_objectdef) then
|
||||
if is_interface(current_objectdef) or
|
||||
is_objcprotocol(current_objectdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_PROTECTED);
|
||||
current_objectdef.symtable.currentvisibility:=vis_protected;
|
||||
@ -471,7 +532,8 @@ implementation
|
||||
end;
|
||||
_PUBLIC :
|
||||
begin
|
||||
if is_interface(current_objectdef) then
|
||||
if is_interface(current_objectdef) or
|
||||
is_objcprotocol(current_objectdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_PUBLIC);
|
||||
current_objectdef.symtable.currentvisibility:=vis_public;
|
||||
@ -482,15 +544,21 @@ implementation
|
||||
{ we've to check for a pushlished section in non- }
|
||||
{ publishable classes later, if a real declaration }
|
||||
{ this is the way, delphi does it }
|
||||
if is_interface(current_objectdef) then
|
||||
if is_interface(current_objectdef) or
|
||||
is_objcprotocol(current_objectdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
{ Objective-C classes do not support "published",
|
||||
as basically everything is published. }
|
||||
if is_objc_class_or_protocol(current_objectdef) then
|
||||
Message(parser_e_no_objc_published);
|
||||
consume(_PUBLISHED);
|
||||
current_objectdef.symtable.currentvisibility:=vis_published;
|
||||
fields_allowed:=true;
|
||||
end;
|
||||
_STRICT :
|
||||
begin
|
||||
if is_interface(current_objectdef) then
|
||||
if is_interface(current_objectdef) or
|
||||
is_objcprotocol(current_objectdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_STRICT);
|
||||
if token=_ID then
|
||||
@ -520,7 +588,8 @@ implementation
|
||||
begin
|
||||
if object_member_blocktype=bt_general then
|
||||
begin
|
||||
if is_interface(current_objectdef) then
|
||||
if is_interface(current_objectdef) or
|
||||
is_objcprotocol(current_objectdef) then
|
||||
Message(parser_e_no_vars_in_interfaces);
|
||||
|
||||
if (current_objectdef.symtable.currentvisibility=vis_published) and
|
||||
@ -601,7 +670,7 @@ implementation
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
{ Objective-C does not know the concept of a constructor }
|
||||
if is_objcclass(current_objectdef) then
|
||||
if is_objc_class_or_protocol(current_objectdef) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
@ -639,7 +708,7 @@ implementation
|
||||
Message(parser_w_destructor_should_be_public);
|
||||
|
||||
{ Objective-C does not know the concept of a destructor }
|
||||
if is_objcclass(current_objectdef) then
|
||||
if is_objc_class_or_protocol(current_objectdef) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
@ -727,6 +796,14 @@ implementation
|
||||
class_tobject:=current_objectdef;
|
||||
end;
|
||||
end;
|
||||
if (current_module.modulename^='OBJCBASE') then
|
||||
begin
|
||||
case current_objectdef.objecttype of
|
||||
odt_objcclass:
|
||||
if (current_objectdef.objname^='Protocol') then
|
||||
objc_protocoltype:=current_objectdef;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ set published flag in $M+ mode, it can also be inherited and will
|
||||
@ -772,8 +849,11 @@ implementation
|
||||
not(oo_has_constructor in current_objectdef.objectoptions) then
|
||||
Message1(parser_w_virtual_without_constructor,current_objectdef.objrealname^);
|
||||
|
||||
if is_interface(current_objectdef) then
|
||||
setinterfacemethodoptions;
|
||||
if is_interface(current_objectdef) or
|
||||
is_objcprotocol(current_objectdef) then
|
||||
setinterfacemethodoptions
|
||||
else if is_objcclass(current_objectdef) then
|
||||
setobjcclassmethodoptions;
|
||||
|
||||
{ return defined objectdef }
|
||||
result:=current_objectdef;
|
||||
|
||||
@ -40,7 +40,8 @@ interface
|
||||
pd_notprocvar, { directive can not be used procvar declaration }
|
||||
pd_dispinterface,{ directive can be used with dispinterface methods }
|
||||
pd_cppobject, { directive can be used with cppclass }
|
||||
pd_objcclass { directive can be used with objcclass }
|
||||
pd_objcclass, { directive can be used with objcclass }
|
||||
pd_objcprot { directive can be used with objcprotocol }
|
||||
);
|
||||
tpdflags=set of tpdflag;
|
||||
|
||||
@ -160,7 +161,7 @@ implementation
|
||||
vsp : tvarspez;
|
||||
begin
|
||||
if (pd.typ=procdef) and
|
||||
is_objcclass(tprocdef(pd)._class) then
|
||||
is_objc_class_or_protocol(tprocdef(pd)._class) then
|
||||
begin
|
||||
{ insert Objective-C self and selector parameters }
|
||||
vs:=tparavarsym.create('$msgsel',paranr_vmt,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]);
|
||||
@ -883,6 +884,7 @@ implementation
|
||||
{ symbol options that need to be kept per procdef }
|
||||
pd.fileinfo:=procstartfilepos;
|
||||
pd.visibility:=symtablestack.top.currentvisibility;
|
||||
pd.optional:=symtablestack.top.currentlyoptional;
|
||||
|
||||
{ parse parameters }
|
||||
if token=_LKLAMMER then
|
||||
@ -932,6 +934,7 @@ implementation
|
||||
if is_interface(aclass) then
|
||||
Message(parser_e_no_static_method_in_interfaces)
|
||||
else
|
||||
{ class methods are also allowed for Objective-C protocols }
|
||||
isclassmethod:=true;
|
||||
end;
|
||||
case token of
|
||||
@ -1329,7 +1332,7 @@ procedure pd_override(pd:tabstractprocdef);
|
||||
begin
|
||||
if pd.typ<>procdef then
|
||||
internalerror(2003042611);
|
||||
if not(is_class_or_interface(tprocdef(pd)._class)) then
|
||||
if not(is_class_or_interface_or_objc(tprocdef(pd)._class)) then
|
||||
Message(parser_e_no_object_override);
|
||||
end;
|
||||
|
||||
@ -1348,10 +1351,10 @@ begin
|
||||
if pd.typ<>procdef then
|
||||
internalerror(2003042613);
|
||||
if not is_class(tprocdef(pd)._class) and
|
||||
not is_objcclass(tprocdef(pd)._class) then
|
||||
not is_objc_class_or_protocol(tprocdef(pd)._class) then
|
||||
Message(parser_e_msg_only_for_classes);
|
||||
{ check parameter type }
|
||||
if not is_objcclass(tprocdef(pd)._class) then
|
||||
if not is_objc_class_or_protocol(tprocdef(pd)._class) then
|
||||
begin
|
||||
paracnt:=0;
|
||||
pd.parast.SymList.ForEachCall(@check_msg_para,@paracnt);
|
||||
@ -1365,11 +1368,6 @@ begin
|
||||
if (tstringconstnode(pt).len>255) then
|
||||
Message(parser_e_message_string_too_long);
|
||||
tprocdef(pd).messageinf.str:=stringdup(tstringconstnode(pt).value_str);
|
||||
{ the message string is the last part we need to set the mangled name
|
||||
for an Objective-C message
|
||||
}
|
||||
if is_objcclass(tprocdef(pd)._class) then
|
||||
tprocdef(pd).setmangledname(tprocdef(pd).objcmangledname);
|
||||
end
|
||||
else
|
||||
if is_constintnode(pt) and
|
||||
@ -1855,7 +1853,7 @@ const
|
||||
mutexclpo : [po_external,po_exports]
|
||||
),(
|
||||
idtok:_MESSAGE;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass];
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass, pd_objcprot];
|
||||
handler : @pd_message;
|
||||
pocall : pocall_none;
|
||||
pooption : []; { can be po_msgstr or po_msgint }
|
||||
@ -1900,7 +1898,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_OVERRIDE;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf];
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass];
|
||||
handler : @pd_override;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_overridingmethod,po_virtualmethod];
|
||||
@ -2013,7 +2011,7 @@ const
|
||||
mutexclpo : [po_assembler,po_external,po_virtualmethod]
|
||||
),(
|
||||
idtok:_VARARGS;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_procvar,pd_objcclass];
|
||||
pd_flags : [pd_interface,pd_implemen,pd_procvar,pd_objcclass, pd_objcprot];
|
||||
handler : nil;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_varargs];
|
||||
@ -2110,7 +2108,7 @@ const
|
||||
begin
|
||||
{ parsing a procvar type the name can be any
|
||||
next variable !! }
|
||||
if ((pdflags * [pd_procvar,pd_object,pd_objcclass])=[]) and
|
||||
if ((pdflags * [pd_procvar,pd_object,pd_objcclass,pd_objcprot])=[]) and
|
||||
not(idtoken=_PROPERTY) then
|
||||
Message1(parser_w_unknown_proc_directive_ignored,name);
|
||||
exit;
|
||||
@ -2178,6 +2176,12 @@ const
|
||||
if is_objcclass(tprocdef(pd)._class) and
|
||||
not(pd_objcclass in proc_direcdata[p].pd_flags) then
|
||||
exit;
|
||||
|
||||
{ check if method and directive not for objcprotocol }
|
||||
if is_objcprotocol(tprocdef(pd)._class) and
|
||||
not(pd_objcprot in proc_direcdata[p].pd_flags) then
|
||||
exit;
|
||||
|
||||
end;
|
||||
|
||||
{ consume directive, and turn flag on }
|
||||
|
||||
@ -370,11 +370,12 @@ implementation
|
||||
ttypenode(p1).allowed:=true;
|
||||
{ Allow classrefdef, which is required for
|
||||
Typeof(self) in static class methods }
|
||||
if (p1.resultdef.typ = objectdef) or
|
||||
(assigned(current_procinfo) and
|
||||
((po_classmethod in current_procinfo.procdef.procoptions) or
|
||||
(po_staticmethod in current_procinfo.procdef.procoptions)) and
|
||||
(p1.resultdef.typ=classrefdef)) then
|
||||
if not(is_objc_class_or_protocol(p1.resultdef)) and
|
||||
((p1.resultdef.typ = objectdef) or
|
||||
(assigned(current_procinfo) and
|
||||
((po_classmethod in current_procinfo.procdef.procoptions) or
|
||||
(po_staticmethod in current_procinfo.procdef.procoptions)) and
|
||||
(p1.resultdef.typ=classrefdef))) then
|
||||
statement_syssym:=geninlinenode(in_typeof_x,false,p1)
|
||||
else
|
||||
begin
|
||||
@ -488,7 +489,7 @@ implementation
|
||||
procvardef,
|
||||
classrefdef : ;
|
||||
objectdef :
|
||||
if not is_class_or_interface(p1.resultdef) then
|
||||
if not is_class_or_interface_or_objc(p1.resultdef) then
|
||||
begin
|
||||
Message(parser_e_illegal_parameter_list);
|
||||
err:=true;
|
||||
|
||||
@ -536,7 +536,7 @@ implementation
|
||||
typecheckpass(p);
|
||||
end;
|
||||
{ classes and interfaces have implicit dereferencing }
|
||||
hasimplicitderef:=is_class_or_interface(p.resultdef) or
|
||||
hasimplicitderef:=is_class_or_interface_or_objc(p.resultdef) or
|
||||
(p.resultdef.typ = classrefdef);
|
||||
if hasimplicitderef then
|
||||
hdef:=p.resultdef
|
||||
|
||||
@ -1223,7 +1223,7 @@ implementation
|
||||
end;
|
||||
|
||||
{ only allow nil for class and interface }
|
||||
if is_class_or_interface(def) then
|
||||
if is_class_or_interface_or_objc(def) then
|
||||
begin
|
||||
n:=comp_expr(true);
|
||||
if n.nodetype<>niln then
|
||||
|
||||
@ -302,7 +302,7 @@ implementation
|
||||
{ Reparse the original type definition }
|
||||
if not err then
|
||||
begin
|
||||
{ Firsta new typesym so we can reuse this specialization and
|
||||
{ First a new typesym so we can reuse this specialization and
|
||||
references to this specialization can be handled }
|
||||
srsym:=ttypesym.create(specializename,generrordef);
|
||||
specializest.insert(srsym);
|
||||
@ -357,7 +357,7 @@ implementation
|
||||
(current_objectdef.objname^=pattern) and
|
||||
(
|
||||
(testcurobject=2) or
|
||||
is_class_or_interface(current_objectdef)
|
||||
is_class_or_interface_or_objc(current_objectdef)
|
||||
)then
|
||||
begin
|
||||
consume(_ID);
|
||||
@ -542,7 +542,7 @@ implementation
|
||||
(current_objectdef.objname^=pattern) and
|
||||
(
|
||||
(testcurobject=2) or
|
||||
is_class_or_interface(current_objectdef)
|
||||
is_class_or_interface_or_objc(current_objectdef)
|
||||
)then
|
||||
begin
|
||||
consume(_ID);
|
||||
@ -989,6 +989,9 @@ implementation
|
||||
end;
|
||||
_OBJCCLASS :
|
||||
begin
|
||||
if not(m_objectivec1 in current_settings.modeswitches) then
|
||||
Message(parser_f_need_objc);
|
||||
|
||||
consume(token);
|
||||
def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil);
|
||||
end;
|
||||
@ -1004,6 +1007,14 @@ implementation
|
||||
else {it_interfacecorba}
|
||||
def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil);
|
||||
end;
|
||||
_OBJCPROTOCOL :
|
||||
begin
|
||||
if not(m_objectivec1 in current_settings.modeswitches) then
|
||||
Message(parser_f_need_objc);
|
||||
|
||||
consume(token);
|
||||
def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil);
|
||||
end;
|
||||
_OBJECT :
|
||||
begin
|
||||
consume(token);
|
||||
@ -1105,7 +1116,7 @@ implementation
|
||||
if (
|
||||
assigned(def.typesym) and
|
||||
(st.symtabletype=globalsymtable) and
|
||||
not is_objcclass(def)
|
||||
not is_objc_class_or_protocol(def)
|
||||
) or
|
||||
def.needs_inittable or
|
||||
(ds_init_table_used in def.defstates) then
|
||||
@ -1114,7 +1125,7 @@ implementation
|
||||
if (
|
||||
assigned(def.typesym) and
|
||||
(st.symtabletype=globalsymtable) and
|
||||
not is_objcclass(def)
|
||||
not is_objc_class_or_protocol(def)
|
||||
) or
|
||||
(ds_rtti_table_used in def.defstates) then
|
||||
RTTIWriter.write_rtti(def,fullrtti);
|
||||
|
||||
@ -96,6 +96,7 @@ interface
|
||||
moduleid : longint;
|
||||
refcount : smallint;
|
||||
currentvisibility : tvisibility;
|
||||
currentlyoptional : boolean;
|
||||
{ level of symtable, used for nested procedures }
|
||||
symtablelevel : byte;
|
||||
symtabletype : TSymtabletype;
|
||||
@ -222,6 +223,7 @@ implementation
|
||||
SymList:=TFPHashObjectList.Create(true);
|
||||
refcount:=1;
|
||||
currentvisibility:=vis_public;
|
||||
currentlyoptional:=false;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -290,7 +290,8 @@ type
|
||||
odt_interfacecorba,
|
||||
odt_cppclass,
|
||||
odt_dispinterface,
|
||||
odt_objcclass
|
||||
odt_objcclass,
|
||||
odt_objcprotocol
|
||||
);
|
||||
|
||||
{ Variations in interfaces implementation }
|
||||
@ -317,7 +318,9 @@ type
|
||||
oo_has_msgint,
|
||||
oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
|
||||
oo_has_default_property,
|
||||
oo_has_valid_guid
|
||||
oo_has_valid_guid,
|
||||
oo_is_external, { the class is externally implemented (objcclass, cppclass) }
|
||||
oo_is_anonymous { the class is only formally defined in this module (objcclass x = class; external;) }
|
||||
);
|
||||
tobjectoptions=set of tobjectoption;
|
||||
|
||||
|
||||
@ -241,7 +241,9 @@ interface
|
||||
childofderef : tderef;
|
||||
|
||||
objname,
|
||||
objrealname : pshortstring;
|
||||
objrealname,
|
||||
{ for Objective-C: protocols and classes can have the same name there }
|
||||
objextname : pshortstring;
|
||||
objectoptions : tobjectoptions;
|
||||
{ to be able to have a variable vmt position }
|
||||
{ and no vmt field for objects without virtuals }
|
||||
@ -301,7 +303,9 @@ interface
|
||||
procedure register_maybe_created_object_type;
|
||||
procedure register_created_classref_type;
|
||||
procedure register_vmt_call(index:longint);
|
||||
{ ObjC }
|
||||
procedure make_all_methods_external;
|
||||
procedure check_and_finish_messages;
|
||||
end;
|
||||
|
||||
tclassrefdef = class(tabstractpointerdef)
|
||||
@ -488,7 +492,9 @@ interface
|
||||
{ true if the procedure is declared in the interface }
|
||||
interfacedef : boolean;
|
||||
{ true if the procedure has a forward declaration }
|
||||
hasforward : boolean;
|
||||
hasforward,
|
||||
{ true if the procedure is an optional method in an Objective-C protocol }
|
||||
optional : boolean;
|
||||
{ import info }
|
||||
import_dll,
|
||||
import_name : pshortstring;
|
||||
@ -669,6 +675,8 @@ interface
|
||||
objc_superclasstype,
|
||||
objc_idtype,
|
||||
objc_seltype : tpointerdef;
|
||||
{ base type of @protocol(protocolname) Objective-C statements }
|
||||
objc_protocoltype : tobjectdef;
|
||||
|
||||
const
|
||||
{$ifdef i386}
|
||||
@ -720,9 +728,13 @@ interface
|
||||
function is_cppclass(def: tdef): boolean;
|
||||
function is_objcclass(def: tdef): boolean;
|
||||
function is_objcclassref(def: tdef): boolean;
|
||||
function is_objcprotocol(def: tdef): boolean;
|
||||
function is_objc_class_or_protocol(def: tdef): boolean;
|
||||
function is_class_or_interface(def: tdef): boolean;
|
||||
function is_class_or_interface_or_objc(def: tdef): boolean;
|
||||
function is_class_or_interface_or_object(def: tdef): boolean;
|
||||
function is_class_or_interface_or_dispinterface(def: tdef): boolean;
|
||||
function is_class_or_interface_or_dispinterface_or_objc(def: tdef): boolean;
|
||||
|
||||
procedure loadobjctypes;
|
||||
|
||||
@ -1118,7 +1130,7 @@ implementation
|
||||
procvardef :
|
||||
is_intregable:=not(po_methodpointer in tprocvardef(self).procoptions);
|
||||
objectdef:
|
||||
is_intregable:=(is_class(self) or is_interface(self)) and not needs_inittable;
|
||||
is_intregable:=(is_class_or_interface_or_objc(self)) and not needs_inittable;
|
||||
setdef:
|
||||
is_intregable:=is_smallset(self);
|
||||
recorddef:
|
||||
@ -2937,6 +2949,7 @@ implementation
|
||||
forwarddef:=true;
|
||||
interfacedef:=false;
|
||||
hasforward:=false;
|
||||
optional:=false;
|
||||
_class := nil;
|
||||
import_dll:=nil;
|
||||
import_name:=nil;
|
||||
@ -2965,6 +2978,7 @@ implementation
|
||||
ppufile.getposinfo(fileinfo);
|
||||
visibility:=tvisibility(ppufile.getbyte);
|
||||
ppufile.getsmallset(symoptions);
|
||||
optional:=boolean(ppufile.getbyte);
|
||||
{$ifdef powerpc}
|
||||
{ library symbol for AmigaOS/MorphOS }
|
||||
ppufile.getderef(libsymderef);
|
||||
@ -3102,6 +3116,7 @@ implementation
|
||||
ppufile.putposinfo(fileinfo);
|
||||
ppufile.putbyte(byte(visibility));
|
||||
ppufile.putsmallset(symoptions);
|
||||
ppufile.putbyte(byte(optional));
|
||||
{$ifdef powerpc}
|
||||
{ library symbol for AmigaOS/MorphOS }
|
||||
ppufile.putderef(libsymderef);
|
||||
@ -3516,7 +3531,7 @@ implementation
|
||||
if not (po_msgstr in procoptions) then
|
||||
internalerror(2009030901);
|
||||
{ we may very well need longer strings to handle these... }
|
||||
if ((255-length(tobjectdef(procsym.owner.defowner).objrealname^)
|
||||
if ((255-length(tobjectdef(procsym.owner.defowner).objextname^)
|
||||
-length('+[ ]')-length(messageinf.str^)) < 0) then
|
||||
Message1(parser_e_objc_message_name_too_long,messageinf.str^);
|
||||
if not(po_classmethod in procoptions) then
|
||||
@ -3711,7 +3726,7 @@ implementation
|
||||
if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
|
||||
prepareguid;
|
||||
{ setup implemented interfaces }
|
||||
if objecttype in [odt_class,odt_interfacecorba] then
|
||||
if objecttype in [odt_class,odt_interfacecorba,odt_objcclass] then
|
||||
ImplementedInterfaces:=TFPObjectList.Create(true)
|
||||
else
|
||||
ImplementedInterfaces:=nil;
|
||||
@ -3731,6 +3746,10 @@ implementation
|
||||
objecttype:=tobjecttyp(ppufile.getbyte);
|
||||
objrealname:=stringdup(ppufile.getstring);
|
||||
objname:=stringdup(upper(objrealname^));
|
||||
objextname:=stringdup(ppufile.getstring);
|
||||
{ only used for external Objective-C classes/protocols }
|
||||
if (objextname^='') then
|
||||
stringdispose(objextname);
|
||||
symtable:=tObjectSymtable.create(self,objrealname^,0);
|
||||
tObjectSymtable(symtable).datasize:=ppufile.getaint;
|
||||
tObjectSymtable(symtable).fieldalignment:=ppufile.getbyte;
|
||||
@ -3761,7 +3780,7 @@ implementation
|
||||
end;
|
||||
|
||||
{ load implemented interfaces }
|
||||
if objecttype in [odt_class,odt_interfacecorba] then
|
||||
if objecttype in [odt_class,odt_interfacecorba,odt_objcclass] then
|
||||
begin
|
||||
ImplementedInterfaces:=TFPObjectList.Create(true);
|
||||
implintfcount:=ppufile.getlongint;
|
||||
@ -3792,6 +3811,10 @@ implementation
|
||||
(objecttype=odt_interfacecom) and
|
||||
(objname^='IUNKNOWN') then
|
||||
interface_iunknown:=self;
|
||||
if (childof=nil) and
|
||||
(objecttype=odt_objcclass) and
|
||||
(objname^='PROTOCOL') then
|
||||
objc_protocoltype:=self;
|
||||
writing_class_record_dbginfo:=false;
|
||||
end;
|
||||
|
||||
@ -3805,6 +3828,7 @@ implementation
|
||||
end;
|
||||
stringdispose(objname);
|
||||
stringdispose(objrealname);
|
||||
stringdispose(objextname);
|
||||
stringdispose(iidstr);
|
||||
if assigned(ImplementedInterfaces) then
|
||||
begin
|
||||
@ -3843,6 +3867,8 @@ implementation
|
||||
tobjectdef(result).objname:=stringdup(objname^);
|
||||
if assigned(objrealname) then
|
||||
tobjectdef(result).objrealname:=stringdup(objrealname^);
|
||||
if assigned(objextname) then
|
||||
tobjectdef(result).objextname:=stringdup(objextname^);
|
||||
tobjectdef(result).objectoptions:=objectoptions;
|
||||
include(tobjectdef(result).defoptions,df_copied_def);
|
||||
tobjectdef(result).vmt_offset:=vmt_offset;
|
||||
@ -3875,6 +3901,10 @@ implementation
|
||||
inherited ppuwrite(ppufile);
|
||||
ppufile.putbyte(byte(objecttype));
|
||||
ppufile.putstring(objrealname^);
|
||||
if assigned(objextname) then
|
||||
ppufile.putstring(objextname^)
|
||||
else
|
||||
ppufile.putstring('');
|
||||
ppufile.putaint(tObjectSymtable(symtable).datasize);
|
||||
ppufile.putbyte(tObjectSymtable(symtable).fieldalignment);
|
||||
ppufile.putbyte(tObjectSymtable(symtable).recordalignment);
|
||||
@ -4113,7 +4143,7 @@ implementation
|
||||
|
||||
procedure tobjectdef.check_forwards;
|
||||
begin
|
||||
if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) then
|
||||
if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol]) then
|
||||
tstoredsymtable(symtable).check_forwards;
|
||||
if (oo_is_forward in objectoptions) then
|
||||
begin
|
||||
@ -4179,7 +4209,7 @@ implementation
|
||||
|
||||
function tobjectdef.size : aint;
|
||||
begin
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass] then
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
|
||||
result:=sizeof(pint)
|
||||
else
|
||||
result:=tObjectSymtable(symtable).datasize;
|
||||
@ -4188,7 +4218,7 @@ implementation
|
||||
|
||||
function tobjectdef.alignment:shortint;
|
||||
begin
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass] then
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
|
||||
alignment:=sizeof(pint)
|
||||
else
|
||||
alignment:=tObjectSymtable(symtable).recordalignment;
|
||||
@ -4202,7 +4232,8 @@ implementation
|
||||
odt_class:
|
||||
{ the +2*sizeof(pint) is size and -size }
|
||||
vmtmethodoffset:=(index+10)*sizeof(pint)+2*sizeof(pint);
|
||||
odt_objcclass:
|
||||
odt_objcclass,
|
||||
odt_objcprotocol:
|
||||
vmtmethodoffset:=0;
|
||||
odt_interfacecom,odt_interfacecorba:
|
||||
vmtmethodoffset:=index*sizeof(pint);
|
||||
@ -4237,7 +4268,8 @@ implementation
|
||||
odt_object:
|
||||
needs_inittable:=tObjectSymtable(symtable).needs_init_final;
|
||||
odt_cppclass,
|
||||
odt_objcclass:
|
||||
odt_objcclass,
|
||||
odt_objcprotocol:
|
||||
needs_inittable:=false;
|
||||
else
|
||||
internalerror(200108267);
|
||||
@ -4346,6 +4378,29 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure check_and_finish_msg(data: tobject; arg: pointer);
|
||||
var
|
||||
def: tdef absolute data;
|
||||
begin
|
||||
if (def.typ = procdef) then
|
||||
begin
|
||||
{ we have to wait until now to set the mangled name because it
|
||||
depends on the (possibly external) class name, which is defined
|
||||
at the very end. }
|
||||
if (po_msgstr in tprocdef(def).procoptions) then
|
||||
tprocdef(def).setmangledname(tprocdef(def).objcmangledname)
|
||||
else
|
||||
MessagePos(tprocdef(def).fileinfo,parser_e_objc_requires_msgstr)
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tobjectdef.check_and_finish_messages;
|
||||
begin
|
||||
self.symtable.DefList.foreachcall(@check_and_finish_msg,nil);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TImplementedInterface
|
||||
****************************************************************************}
|
||||
@ -4644,6 +4699,24 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function is_objcprotocol(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype=odt_objcprotocol);
|
||||
end;
|
||||
|
||||
|
||||
function is_objc_class_or_protocol(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype in [odt_objcclass,odt_objcprotocol]);
|
||||
end;
|
||||
|
||||
|
||||
function is_class_or_interface(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
@ -4653,6 +4726,15 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function is_class_or_interface_or_objc(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_objcclass,odt_objcprotocol]);
|
||||
end;
|
||||
|
||||
|
||||
function is_class_or_interface_or_object(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
@ -4671,6 +4753,15 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function is_class_or_interface_or_dispinterface_or_objc(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol]);
|
||||
end;
|
||||
|
||||
|
||||
procedure loadobjctypes;
|
||||
begin
|
||||
objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC1','POBJC_CLASS').typedef);
|
||||
|
||||
@ -195,7 +195,7 @@ interface
|
||||
function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
|
||||
function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
|
||||
function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
|
||||
@ -205,12 +205,14 @@ type
|
||||
_LOCATION,
|
||||
_MWPASCAL,
|
||||
_OPERATOR,
|
||||
_OPTIONAL,
|
||||
_OVERLOAD,
|
||||
_OVERRIDE,
|
||||
_PLATFORM,
|
||||
_PROPERTY,
|
||||
_READONLY,
|
||||
_REGISTER,
|
||||
_REQUIRED,
|
||||
_REQUIRES,
|
||||
_RESIDENT,
|
||||
_SAFECALL,
|
||||
@ -244,6 +246,7 @@ type
|
||||
_EXPERIMENTAL,
|
||||
_FINALIZATION,
|
||||
_NOSTACKFRAME,
|
||||
_OBJCPROTOCOL,
|
||||
_WEAKEXTERNAL,
|
||||
_DISPINTERFACE,
|
||||
_UNIMPLEMENTED,
|
||||
@ -458,12 +461,14 @@ const
|
||||
(str:'LOCATION' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'MWPASCAL' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'OPERATOR' ;special:false;keyword:m_fpc;op:NOTOKEN),
|
||||
(str:'OPTIONAL' ;special:false;keyword:m_none;op:NOTOKEN), { optional methods in an Objective-C protocol }
|
||||
(str:'OVERLOAD' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'OVERRIDE' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'PLATFORM' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'PROPERTY' ;special:false;keyword:m_property;op:NOTOKEN),
|
||||
(str:'READONLY' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'REGISTER' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'REQUIRED' ;special:false;keyword:m_none;op:NOTOKEN), { required methods in an Objective-C protocol }
|
||||
(str:'REQUIRES' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'RESIDENT' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'SAFECALL' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
@ -497,6 +502,7 @@ const
|
||||
(str:'EXPERIMENTAL' ;special:false;keyword:m_all;op:NOTOKEN),
|
||||
(str:'FINALIZATION' ;special:false;keyword:m_initfinal;op:NOTOKEN),
|
||||
(str:'NOSTACKFRAME' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'OBJCPROTOCOL' ;special:false;keyword:m_objectivec1;op:NOTOKEN), { Objective-C protocol }
|
||||
(str:'WEAKEXTERNAL' ;special:false;keyword:m_none;op:NOTOKEN),
|
||||
(str:'DISPINTERFACE' ;special:false;keyword:m_class;op:NOTOKEN),
|
||||
(str:'UNIMPLEMENTED' ;special:false;keyword:m_all;op:NOTOKEN),
|
||||
|
||||
@ -44,6 +44,7 @@ type
|
||||
_class: pobjc_class;
|
||||
end;
|
||||
id = ^objc_object;
|
||||
pobjc_object = id;
|
||||
|
||||
_fpc_objc_sel_type = record
|
||||
end;
|
||||
|
||||
@ -33,15 +33,15 @@ type
|
||||
NSCoder = objcclass; external;
|
||||
}
|
||||
|
||||
NSObject = objcclass
|
||||
strict protected
|
||||
isa: pobjc_class;
|
||||
public
|
||||
{ NSObject protocol }
|
||||
Protocol = objcclass
|
||||
end; external;
|
||||
|
||||
NSObjectProtocol = objcprotocol
|
||||
function isEqual_(obj: id): boolean; message 'isEqual:';
|
||||
function hash: cuint; message 'hash';
|
||||
// implemented as class method instead?
|
||||
// function superclass: pobjc_class;
|
||||
|
||||
function superclass: pobjc_class; message 'superclass';
|
||||
function _class: pobjc_class; message 'class';
|
||||
{ "self" is both a hidden parameter to each method, and a method of
|
||||
NSObject and thereby of each subclass as well
|
||||
}
|
||||
@ -56,8 +56,7 @@ type
|
||||
|
||||
function isKindOfClass_(aClass: pobjc_class): boolean; message 'isKindOfClass:';
|
||||
function isMemberOfClass_(aClass: pobjc_class): boolean; message 'isMemberOfClass:';
|
||||
// implemented as class method instead?
|
||||
// function conformsToProtocol(aProtocol: pobjc_protocal): boolean;
|
||||
function conformsToProtocol_(aProtocol: Protocol): boolean; message 'conformsToProtocol:';
|
||||
|
||||
function respondsToSelector_(aSelector: SEL): boolean; message 'respondsToSelector:';
|
||||
|
||||
@ -66,8 +65,51 @@ type
|
||||
function autorelease: id; message 'autorelease';
|
||||
function retainCount: cint; message 'retainCount';
|
||||
|
||||
// implemented as class method instead?
|
||||
// function description: NSString;
|
||||
function description: {NSString} id; message 'description';
|
||||
end; external name 'NSObject';
|
||||
|
||||
|
||||
NSObject = objcclass(NSObjectProtocol)
|
||||
strict protected
|
||||
isa: pobjc_class;
|
||||
public
|
||||
{ NSObjectProtocol -- the message names are copied from the protocol
|
||||
definition by the compiler, but you can still repeat them if you want }
|
||||
function isEqual_(obj: id): boolean;
|
||||
function hash: cuint;
|
||||
|
||||
function superclass: pobjc_class;
|
||||
function _class: pobjc_class;
|
||||
{ "self" is both a hidden parameter to each method, and a method of
|
||||
NSObject and thereby of each subclass as well
|
||||
}
|
||||
function self: id;
|
||||
function zone: id; { NSZone }
|
||||
|
||||
function performSelector_(aSelector: SEL): id;
|
||||
function performSelector_withObject_(aSelector: SEL; obj: id): id;
|
||||
function performSelector_withObject_withObject(aSelector: SEL; obj1, obj2: id): id;
|
||||
|
||||
function isProxy: boolean;
|
||||
|
||||
function isKindOfClass_(aClass: pobjc_class): boolean;
|
||||
function isMemberOfClass_(aClass: pobjc_class): boolean;
|
||||
function conformsToProtocol_(aProtocol: Protocol): boolean;
|
||||
|
||||
function respondsToSelector_(aSelector: SEL): boolean;
|
||||
|
||||
function retain: id;
|
||||
procedure release; { oneway }
|
||||
function autorelease: id;
|
||||
function retainCount: cint;
|
||||
|
||||
function description: {NSString} id;
|
||||
|
||||
{ NSObject class }
|
||||
{ "class" prefix to method name to avoid name collision with NSObjectProtocol }
|
||||
class function classIsEqual_(obj: id): boolean; message 'isEqual:';
|
||||
{ "class" prefix to method name to avoid name collision with NSObjectProtocol }
|
||||
class function classHash: cuint; message 'hash';
|
||||
|
||||
{ NSObject methods }
|
||||
|
||||
@ -80,6 +122,7 @@ type
|
||||
class function allocWithZone_(_zone: id {NSZone}): id; message 'allocWithZone:';
|
||||
class function alloc: id; message 'alloc';
|
||||
procedure dealloc; message 'dealloc';
|
||||
|
||||
{ if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_4 }
|
||||
procedure finalize; message 'finalize';
|
||||
{ endif }
|
||||
@ -90,11 +133,14 @@ type
|
||||
class function copyWithZone_(_zone: id {NSZone}): id; message 'copyWithZone:';
|
||||
class function mutableCopyWithZone_(_zone: id {NSZone}): id; message 'mutableCopyWithZone:';
|
||||
|
||||
class function superclass: pobjc_class; message 'superclass';
|
||||
class function _class: pobjc_class; message 'class';
|
||||
{ "class" prefix to method name to avoid name collision with NSObjectProtocol }
|
||||
class function classSuperclass: pobjc_class; message 'superclass';
|
||||
{ "class" prefix to method name to avoid name collision with NSObjectProtocol }
|
||||
class function classClass: pobjc_class; message 'class';
|
||||
class procedure poseAsClass_(aClass: pobjc_class); message 'poseAsClass:';
|
||||
class function instancesRespondToSelector_(aSelector: SEL): boolean; message 'instancesRespondToSelector:';
|
||||
class function conformsToProtocol_(aProtocol: pobjc_protocal): boolean; message 'conformsToProtocol:';
|
||||
{ "class" prefix to method name to avoid name collision with NSObjectProtocol }
|
||||
class function classConformsToProtocol_(aProtocol: Protocol): boolean; message 'conformsToProtocol:';
|
||||
function methodForSelector_(aSelector: SEL): IMP; message 'methodForSelector:';
|
||||
class function instanceMethodForSelector_(aSelector: SEL): IMP; message 'instanceMethodForSelector:';
|
||||
class function version: cint; message 'version';
|
||||
@ -103,7 +149,7 @@ type
|
||||
procedure forwardInvocation_(anInvocation: id {NSInvocation}); message 'forwardInvocation:';
|
||||
function methodSignatureForSelector_(aSelector: SEL): id {NSMethodSignature}; message 'methodSignatureForSelector:';
|
||||
|
||||
class function description: id {NSString}; message 'description';
|
||||
class function classDescription: id {NSString}; message 'description';
|
||||
|
||||
function classForCoder: pobjc_class; message 'classForCoder';
|
||||
function replacementObjectForCoder_(aCoder: id {NSCoder}): id; message 'replacementObjectForCoder:';
|
||||
|
||||
@ -11,5 +11,16 @@ type
|
||||
ta = objcclass
|
||||
end; external;
|
||||
|
||||
var
|
||||
a: ta;
|
||||
b: nsobject;
|
||||
c: id;
|
||||
begin
|
||||
{ avoid hints about unused types/variables/units }
|
||||
a:=nil;
|
||||
if (a<>nil) then
|
||||
exit;
|
||||
c:=nil;
|
||||
b:=c;
|
||||
b.isEqual_(b);
|
||||
end.
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
type
|
||||
ta = objcclass
|
||||
{ no constructors in Objective-C }
|
||||
constructor create;
|
||||
constructor create; message 'create';
|
||||
end; external;
|
||||
|
||||
begin
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
type
|
||||
ta = objcclass
|
||||
{ no destructors in Objective-C }
|
||||
destructor done;
|
||||
destructor done; message 'done';
|
||||
end; external;
|
||||
|
||||
begin
|
||||
|
||||
14
tests/test/tobjc5.pp
Normal file
14
tests/test/tobjc5.pp
Normal file
@ -0,0 +1,14 @@
|
||||
{ %fail }
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
type
|
||||
ta = objcclass
|
||||
{ needs message name specification }
|
||||
procedure test;
|
||||
end; external;
|
||||
|
||||
begin
|
||||
end.
|
||||
14
tests/test/tobjc5a.pp
Normal file
14
tests/test/tobjc5a.pp
Normal file
@ -0,0 +1,14 @@
|
||||
{ %fail }
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
type
|
||||
ta = objcprotocol
|
||||
{ needs message name specification }
|
||||
procedure test;
|
||||
end; external;
|
||||
|
||||
begin
|
||||
end.
|
||||
14
tests/test/tobjc6.pp
Normal file
14
tests/test/tobjc6.pp
Normal file
@ -0,0 +1,14 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
type
|
||||
ta = objcclass;
|
||||
|
||||
ta = objcclass
|
||||
end;
|
||||
|
||||
begin
|
||||
end.
|
||||
23
tests/test/tobjc7.pp
Normal file
23
tests/test/tobjc7.pp
Normal file
@ -0,0 +1,23 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %norun }
|
||||
{ %recompile }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
uobjc7;
|
||||
|
||||
type
|
||||
tobjcclass = objcclass(tobjcprot)
|
||||
procedure isrequired;
|
||||
procedure alsorequired;
|
||||
{ fake external name to avoid linking errors once we
|
||||
add external references in all cases to ensure that
|
||||
all necessary libraries are linked, like gcc does }
|
||||
end; external name 'NSObject';
|
||||
|
||||
|
||||
begin
|
||||
end.
|
||||
22
tests/test/tobjc7a.pp
Normal file
22
tests/test/tobjc7a.pp
Normal file
@ -0,0 +1,22 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %fail }
|
||||
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
uobjc7;
|
||||
|
||||
type
|
||||
tobjcclass = objcclass(tobjcprot)
|
||||
procedure alsorequired;
|
||||
{ fake external name to avoid linking errors once we
|
||||
add external references in all cases to ensure that
|
||||
all necessary libraries are linked, like gcc does }
|
||||
end; external name 'NSObject';
|
||||
|
||||
|
||||
begin
|
||||
end.
|
||||
21
tests/test/tobjc7b.pp
Normal file
21
tests/test/tobjc7b.pp
Normal file
@ -0,0 +1,21 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %fail }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
uobjc7;
|
||||
|
||||
type
|
||||
tobjcclass = objcclass(tobjcprot)
|
||||
procedure isrequired;
|
||||
{ fake external name to avoid linking errors once we
|
||||
add external references in all cases to ensure that
|
||||
all necessary libraries are linked, like gcc does }
|
||||
end; external name 'NSObject';
|
||||
|
||||
|
||||
begin
|
||||
end.
|
||||
23
tests/test/tobjc7c.pp
Normal file
23
tests/test/tobjc7c.pp
Normal file
@ -0,0 +1,23 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %norun }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
uobjc7;
|
||||
|
||||
type
|
||||
tobjcclass = objcclass(tobjcprot)
|
||||
procedure isrequired;
|
||||
procedure isoptional;
|
||||
procedure alsorequired;
|
||||
{ fake external name to avoid linking errors once we
|
||||
add external references in all cases to ensure that
|
||||
all necessary libraries are linked, like gcc does }
|
||||
end; external name 'NSObject';
|
||||
|
||||
|
||||
begin
|
||||
end.
|
||||
24
tests/test/tobjc8.pp
Normal file
24
tests/test/tobjc8.pp
Normal file
@ -0,0 +1,24 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %opt=-vh -Seh }
|
||||
{ %fail }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
ctypes;
|
||||
|
||||
type
|
||||
TMyTestClass = objcclass(NSObject)
|
||||
{ should give a hint because of a missing 'override' }
|
||||
function hash: cuint;
|
||||
end; external name 'NSZone';
|
||||
|
||||
var
|
||||
a: id;
|
||||
begin
|
||||
{ avoid warnings/hints about unused types/variables }
|
||||
a:=TMyTestClass.alloc;
|
||||
tmytestclass(a).Retain;
|
||||
end.
|
||||
24
tests/test/tobjc8a.pp
Normal file
24
tests/test/tobjc8a.pp
Normal file
@ -0,0 +1,24 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %opt=-vh -Seh }
|
||||
{ %norun }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
ctypes;
|
||||
|
||||
type
|
||||
TMyTestClass = objcclass(NSObject)
|
||||
{ should not give a hint, since we have 'override' }
|
||||
function hash: cuint; override;
|
||||
end; external name 'NSZone';
|
||||
|
||||
var
|
||||
a: id;
|
||||
begin
|
||||
{ avoid warnings/hints about unused types/variables }
|
||||
a:=TMyTestClass.alloc;
|
||||
tmytestclass(a).Retain;
|
||||
end.
|
||||
16
tests/test/tobjc9.pp
Normal file
16
tests/test/tobjc9.pp
Normal file
@ -0,0 +1,16 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %norun }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
ctypes;
|
||||
|
||||
var
|
||||
a: NSObjectProtocol;
|
||||
b: NSObject;
|
||||
begin
|
||||
a:=b;
|
||||
end.
|
||||
16
tests/test/tobjc9a.pp
Normal file
16
tests/test/tobjc9a.pp
Normal file
@ -0,0 +1,16 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %fail }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
ctypes;
|
||||
|
||||
var
|
||||
a: NSObjectProtocol;
|
||||
b: NSObject;
|
||||
begin
|
||||
b:=a;
|
||||
end.
|
||||
16
tests/test/tobjc9b.pp
Normal file
16
tests/test/tobjc9b.pp
Normal file
@ -0,0 +1,16 @@
|
||||
{ %target=darwin }
|
||||
{ %cpu=powerpc,i386 }
|
||||
{ %norun }
|
||||
|
||||
{$mode objfpc}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
uses
|
||||
ctypes;
|
||||
|
||||
var
|
||||
a: NSObjectProtocol;
|
||||
b: NSObject;
|
||||
begin
|
||||
a:=b;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user