mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 07:09:29 +02:00
* various small support fixes for Java classes:
o support formal external definitions (like for objcclass)
o allow specifying an "import_dll" for external Java classes, which can
be used to specify the Java package name (like the dll for cppclass)
o take the package name into account when mangling the Java class name
o several messages that were specific to Objective-Pascal classes have
been generalised because they also apply to Java classes, same for
several compiler function names
o disabled some proccall directives for Java, but more needs to happen
(Java methods are always either instance-virtual or class-static)
git-svn-id: branches/jvmbackend@18319 -
This commit is contained in:
Jonas Maebe
parent
74d684878d
commit
6e82417a51
@ -1266,8 +1266,8 @@ implementation
|
||||
begin
|
||||
{ Objective-C classes (handle anonymous externals) }
|
||||
if (def_from.typ=objectdef) and
|
||||
(find_real_objcclass_definition(tobjectdef(def_from),false) =
|
||||
find_real_objcclass_definition(tobjectdef(def_to),false)) then
|
||||
(find_real_class_definition(tobjectdef(def_from),false) =
|
||||
find_real_class_definition(tobjectdef(def_to),false)) then
|
||||
begin
|
||||
doconv:=tc_equal;
|
||||
{ exact, not equal, because can change between interface
|
||||
|
||||
@ -181,7 +181,12 @@ implementation
|
||||
case tobjectdef(def).objecttype of
|
||||
odt_javaclass,
|
||||
odt_interfacejava:
|
||||
encodedstr:=encodedstr+'L'+tobjectdef(def).objextname^+';';
|
||||
begin
|
||||
encodedstr:=encodedstr+'L';
|
||||
if assigned(tobjectdef(def).import_lib) then
|
||||
encodedstr:=encodedstr+tobjectdef(def).import_lib^+'/';
|
||||
encodedstr:=encodedstr+tobjectdef(def).objextname^+';';
|
||||
end
|
||||
else
|
||||
result:=false;
|
||||
end;
|
||||
|
||||
@ -1268,9 +1268,9 @@ parser_e_objc_message_name_changed=03275_E_Message name "$1" in inherited 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.
|
||||
parser_e_no_objc_unique=03276_E_It is not yet possible to make unique copies of Objective-C types
|
||||
% Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to
|
||||
% obtain the desired effect using \var{type x = objcclass(y) end;} instead.
|
||||
parser_e_unique_unsupported=03276_E_It is not yet possible to make unique copies of Objective-C or Java types
|
||||
% Duplicating an Objective-C or Java type using \var{type x = type y;} is not yet supported. You may be able to
|
||||
% obtain the desired effect using \var{type x = objcclass(y) end;} resp.{} \var{type x = class(y) end;} instead.
|
||||
parser_e_no_category_as_types=03277_E_Objective-C categories and Object Pascal class helpers cannot be used as types
|
||||
% It is not possible to declare a variable as an instance of an Objective-C
|
||||
% category or an Object Pascal class helper. A category/class helper adds
|
||||
@ -1997,8 +1997,8 @@ sym_w_experimental_unit=05079_W_Unit "$1" is experimental
|
||||
% declared as \var{experimental} is used. Experimental units
|
||||
% might disappear or change semantics in future versions. Usage of this unit
|
||||
% should be avoided as much as possible.
|
||||
sym_e_objc_formal_class_not_resolved=05080_E_No complete definition of the formally declared objcclass "$1" is in scope
|
||||
% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared.
|
||||
sym_e_formal_class_not_resolved=05080_E_No complete definition of the formally declared class "$1" is in scope
|
||||
% Objecive-C and Java classes can be imported formally, without using the the unit in which it is fully declared.
|
||||
% This enables making forward references to such classes and breaking circular dependencies amongst units.
|
||||
% However, as soon as you wish to actually do something with an entity of this class type (such as
|
||||
% access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition
|
||||
|
||||
@ -367,7 +367,7 @@ const
|
||||
parser_e_must_use_override_objc=03273;
|
||||
parser_h_should_use_override_objc=03274;
|
||||
parser_e_objc_message_name_changed=03275;
|
||||
parser_e_no_objc_unique=03276;
|
||||
parser_e_unique_unsupported=03276;
|
||||
parser_e_no_category_as_types=03277;
|
||||
parser_e_no_category_override=03278;
|
||||
parser_e_must_use_reintroduce_objc=03279;
|
||||
@ -564,7 +564,7 @@ const
|
||||
sym_w_library_unit=05077;
|
||||
sym_w_non_implemented_unit=05078;
|
||||
sym_w_experimental_unit=05079;
|
||||
sym_e_objc_formal_class_not_resolved=05080;
|
||||
sym_e_formal_class_not_resolved=05080;
|
||||
sym_e_interprocgoto_into_init_final_code_not_allowed=05081;
|
||||
sym_e_external_class_name_mismatch1=05082;
|
||||
sym_e_external_class_name_mismatch2=05083;
|
||||
@ -900,7 +900,7 @@ const
|
||||
option_info=11024;
|
||||
option_help_pages=11025;
|
||||
|
||||
MsgTxtSize = 60991;
|
||||
MsgTxtSize = 60995;
|
||||
|
||||
MsgIdxMax : array[1..20] of longint=(
|
||||
26,89,314,103,85,54,111,23,202,63,
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -383,7 +383,7 @@ implementation
|
||||
|
||||
procedure types_dec(in_structure: boolean);
|
||||
|
||||
procedure finalize_objc_class_or_protocol_external_status(od: tobjectdef);
|
||||
procedure finalize_class_external_status(od: tobjectdef);
|
||||
begin
|
||||
if [oo_is_external,oo_is_forward] <= od.objectoptions then
|
||||
begin
|
||||
@ -537,8 +537,9 @@ implementation
|
||||
istyperenaming:=true;
|
||||
if isunique then
|
||||
begin
|
||||
if is_objc_class_or_protocol(hdef) then
|
||||
Message(parser_e_no_objc_unique);
|
||||
if is_objc_class_or_protocol(hdef) or
|
||||
is_java_class_or_interface(hdef) then
|
||||
Message(parser_e_unique_unsupported);
|
||||
|
||||
hdef:=tstoreddef(hdef).getcopy;
|
||||
|
||||
@ -606,11 +607,12 @@ implementation
|
||||
try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
|
||||
consume(_SEMICOLON);
|
||||
|
||||
{ change a forward and external objcclass declaration into
|
||||
{ change a forward and external class declaration into
|
||||
formal external definition, so the compiler does not
|
||||
expect an real definition later }
|
||||
if is_objc_class_or_protocol(hdef) then
|
||||
finalize_objc_class_or_protocol_external_status(tobjectdef(hdef));
|
||||
if is_objc_class_or_protocol(hdef) or
|
||||
is_java_class_or_interface(hdef) then
|
||||
finalize_class_external_status(tobjectdef(hdef));
|
||||
|
||||
{ Build VMT indexes, skip for type renaming and forward classes }
|
||||
if (hdef.typesym=newtype) and
|
||||
|
||||
@ -280,7 +280,7 @@ implementation
|
||||
|
||||
procedure handleImplementedProtocol(intfdef : tobjectdef);
|
||||
begin
|
||||
intfdef:=find_real_objcclass_definition(intfdef,false);
|
||||
intfdef:=find_real_class_definition(intfdef,false);
|
||||
if not is_objcprotocol(intfdef) then
|
||||
begin
|
||||
Message1(type_e_protocol_type_expected,intfdef.typename);
|
||||
@ -345,7 +345,7 @@ implementation
|
||||
p.free;
|
||||
end;
|
||||
|
||||
procedure get_cpp_class_external_status(od: tobjectdef);
|
||||
procedure get_cpp_or_java_class_external_status(od: tobjectdef);
|
||||
var
|
||||
hs: string;
|
||||
begin
|
||||
@ -363,6 +363,9 @@ implementation
|
||||
hs:=ChangeFileExt(hs,target_info.sharedlibext);
|
||||
if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
|
||||
hs:=target_info.sharedlibprefix+hs;
|
||||
{ the JVM expects java/lang/Object rather than java.lang.Object }
|
||||
if target_info.system=system_jvm_java32 then
|
||||
Replace(hs,'.','/');
|
||||
od.import_lib:=stringdup(hs);
|
||||
end;
|
||||
include(od.objectoptions, oo_is_external);
|
||||
@ -419,8 +422,9 @@ implementation
|
||||
if [oo_is_abstract, oo_is_sealed] * current_structdef.objectoptions = [oo_is_abstract, oo_is_sealed] then
|
||||
Message(parser_e_abstract_and_sealed_conflict);
|
||||
end;
|
||||
odt_cppclass:
|
||||
get_cpp_class_external_status(current_objectdef);
|
||||
odt_cppclass,
|
||||
odt_javaclass:
|
||||
get_cpp_or_java_class_external_status(current_objectdef);
|
||||
odt_objcclass,odt_objcprotocol,odt_objccategory:
|
||||
get_objc_class_or_protocol_external_status(current_objectdef);
|
||||
odt_helper: ; // nothing
|
||||
@ -460,10 +464,14 @@ implementation
|
||||
{ a mix of class, interfaces, objects and cppclasses
|
||||
isn't allowed }
|
||||
case current_objectdef.objecttype of
|
||||
odt_class:
|
||||
if not(is_class(childof)) then
|
||||
odt_class,
|
||||
odt_javaclass:
|
||||
if (childof.objecttype<>current_objectdef.objecttype) then
|
||||
begin
|
||||
if is_interface(childof) then
|
||||
if (is_interface(childof) and
|
||||
is_class(current_objectdef)) or
|
||||
(is_javainterface(childof) and
|
||||
is_javaclass(current_objectdef)) then
|
||||
begin
|
||||
{ we insert the interface after the child
|
||||
is set, see below
|
||||
@ -476,7 +484,9 @@ implementation
|
||||
end
|
||||
else
|
||||
if oo_is_sealed in childof.objectoptions then
|
||||
Message1(parser_e_sealed_descendant,childof.typename);
|
||||
Message1(parser_e_sealed_descendant,childof.typename)
|
||||
else
|
||||
childof:=find_real_class_definition(childof,true);
|
||||
odt_interfacecorba,
|
||||
odt_interfacecom:
|
||||
begin
|
||||
@ -507,7 +517,7 @@ implementation
|
||||
Message(parser_e_mix_of_classes_and_objects);
|
||||
end
|
||||
else
|
||||
childof:=find_real_objcclass_definition(childof,true);
|
||||
childof:=find_real_class_definition(childof,true);
|
||||
odt_objcprotocol:
|
||||
begin
|
||||
if not(is_objcprotocol(childof)) then
|
||||
@ -515,6 +525,13 @@ implementation
|
||||
intfchildof:=childof;
|
||||
childof:=nil;
|
||||
end;
|
||||
odt_interfacejava:
|
||||
begin
|
||||
if not(is_javainterface(childof)) then
|
||||
Message(parser_e_mix_of_classes_and_objects);
|
||||
intfchildof:=find_real_class_definition(childof,true);
|
||||
childof:=nil;
|
||||
end;
|
||||
odt_object:
|
||||
if not(is_object(childof)) then
|
||||
Message(parser_e_mix_of_classes_and_objects)
|
||||
@ -548,6 +565,9 @@ implementation
|
||||
childof:=interface_idispatch;
|
||||
odt_objcclass:
|
||||
CGMessage(parser_h_no_objc_parent);
|
||||
odt_javaclass:
|
||||
if current_objectdef<>java_jlobject then
|
||||
childof:=java_jlobject;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -562,7 +582,7 @@ implementation
|
||||
else if not(oo_is_formal in childof.objectoptions) then
|
||||
current_objectdef.set_parent(childof)
|
||||
else
|
||||
Message1(sym_e_objc_formal_class_not_resolved,childof.objrealname^);
|
||||
Message1(sym_e_formal_class_not_resolved,childof.objrealname^);
|
||||
end;
|
||||
|
||||
{ remove forward flag, is resolved }
|
||||
@ -570,7 +590,7 @@ implementation
|
||||
|
||||
if hasparentdefined then
|
||||
begin
|
||||
if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
|
||||
if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
|
||||
begin
|
||||
if assigned(intfchildof) then
|
||||
if current_objectdef.objecttype=odt_class then
|
||||
@ -664,6 +684,15 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure chkjava(pd: tprocdef);
|
||||
begin
|
||||
if is_java_class_or_interface(pd.struct) then
|
||||
begin
|
||||
include(pd.procoptions,po_java);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure chkcpp(pd:tprocdef);
|
||||
begin
|
||||
{ nothing currently }
|
||||
@ -696,7 +725,7 @@ implementation
|
||||
vdoptions: tvar_dec_options;
|
||||
begin
|
||||
{ empty class declaration ? }
|
||||
if (current_objectdef.objecttype in [odt_class,odt_objcclass]) and
|
||||
if (current_objectdef.objecttype in [odt_class,odt_objcclass,odt_javaclass]) and
|
||||
(token=_SEMICOLON) then
|
||||
exit;
|
||||
|
||||
@ -749,7 +778,8 @@ implementation
|
||||
_PRIVATE :
|
||||
begin
|
||||
if is_interface(current_structdef) or
|
||||
is_objc_protocol_or_category(current_structdef) then
|
||||
is_objc_protocol_or_category(current_structdef) or
|
||||
is_javainterface(current_structdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_PRIVATE);
|
||||
current_structdef.symtable.currentvisibility:=vis_private;
|
||||
@ -762,7 +792,8 @@ implementation
|
||||
_PROTECTED :
|
||||
begin
|
||||
if is_interface(current_structdef) or
|
||||
is_objc_protocol_or_category(current_structdef) then
|
||||
is_objc_protocol_or_category(current_structdef) or
|
||||
is_javainterface(current_structdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_PROTECTED);
|
||||
current_structdef.symtable.currentvisibility:=vis_protected;
|
||||
@ -775,7 +806,8 @@ implementation
|
||||
_PUBLIC :
|
||||
begin
|
||||
if is_interface(current_structdef) or
|
||||
is_objc_protocol_or_category(current_structdef) then
|
||||
is_objc_protocol_or_category(current_structdef) or
|
||||
is_javainterface(current_structdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_PUBLIC);
|
||||
current_structdef.symtable.currentvisibility:=vis_public;
|
||||
@ -791,9 +823,10 @@ implementation
|
||||
{ this is the way, delphi does it }
|
||||
if is_interface(current_structdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
{ Objective-C classes do not support "published",
|
||||
{ Objective-C and Java classes do not support "published",
|
||||
as basically everything is published. }
|
||||
if is_objc_class_or_protocol(current_structdef) then
|
||||
if is_objc_class_or_protocol(current_structdef) or
|
||||
is_java_class_or_interface(current_structdef) then
|
||||
Message(parser_e_no_objc_published);
|
||||
consume(_PUBLISHED);
|
||||
current_structdef.symtable.currentvisibility:=vis_published;
|
||||
@ -805,9 +838,10 @@ implementation
|
||||
_STRICT :
|
||||
begin
|
||||
if is_interface(current_structdef) or
|
||||
is_objc_protocol_or_category(current_structdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_STRICT);
|
||||
is_objc_protocol_or_category(current_structdef) or
|
||||
is_javainterface(current_structdef) then
|
||||
Message(parser_e_no_access_specifier_in_interfaces);
|
||||
consume(_STRICT);
|
||||
if token=_ID then
|
||||
begin
|
||||
case idtoken of
|
||||
@ -840,7 +874,8 @@ implementation
|
||||
begin
|
||||
if is_interface(current_structdef) or
|
||||
is_objc_protocol_or_category(current_structdef) or
|
||||
is_objectpascal_helper(current_structdef) then
|
||||
is_objectpascal_helper(current_structdef) or
|
||||
is_javainterface(current_structdef) then
|
||||
Message(parser_e_no_vars_in_interfaces);
|
||||
|
||||
if (current_structdef.symtable.currentvisibility=vis_published) and
|
||||
@ -937,6 +972,7 @@ implementation
|
||||
|
||||
chkcpp(pd);
|
||||
chkobjc(pd);
|
||||
chkjava(pd);
|
||||
end;
|
||||
|
||||
maybe_parse_hint_directives(pd);
|
||||
@ -1124,6 +1160,9 @@ implementation
|
||||
odt_class :
|
||||
if (current_structdef.objname^='TOBJECT') then
|
||||
class_tobject:=current_objectdef;
|
||||
odt_javaclass:
|
||||
if (current_objectdef.objname^='TOBJECT') then
|
||||
java_jlobject:=current_objectdef;
|
||||
end;
|
||||
end;
|
||||
if (current_module.modulename^='OBJCBASE') then
|
||||
@ -1149,11 +1188,11 @@ implementation
|
||||
(current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then
|
||||
include(current_structdef.objectoptions,oo_can_have_published);
|
||||
|
||||
{ Objective-C objectdefs can be "formal definitions", in which case
|
||||
{ Objective-C/Java objectdefs can be "formal definitions", in which case
|
||||
the syntax is "type tc = objcclass external;" -> we have to parse
|
||||
its object options (external) already here, to make sure that such
|
||||
definitions are recognised as formal defs }
|
||||
if objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory] then
|
||||
if objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory,odt_javaclass,odt_interfacejava] then
|
||||
parse_object_options;
|
||||
|
||||
{ forward def? }
|
||||
@ -1178,7 +1217,7 @@ implementation
|
||||
include(current_objectdef.objectoptions,oo_is_classhelper);
|
||||
|
||||
{ parse list of options (abstract / sealed) }
|
||||
if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) then
|
||||
if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory,odt_javaclass,odt_interfacejava]) then
|
||||
parse_object_options;
|
||||
|
||||
symtablestack.push(current_structdef.symtable);
|
||||
@ -1221,11 +1260,13 @@ implementation
|
||||
if (oo_has_vmt in current_structdef.objectoptions) and
|
||||
not(oo_is_forward in current_structdef.objectoptions) and
|
||||
not(oo_has_constructor in current_structdef.objectoptions) and
|
||||
not is_objc_class_or_protocol(current_structdef) then
|
||||
not is_objc_class_or_protocol(current_structdef) and
|
||||
not is_java_class_or_interface(current_structdef) then
|
||||
Message1(parser_w_virtual_without_constructor,current_structdef.objrealname^);
|
||||
|
||||
if is_interface(current_structdef) or
|
||||
is_objcprotocol(current_structdef) then
|
||||
is_objcprotocol(current_structdef) or
|
||||
is_javainterface(current_structdef) then
|
||||
setinterfacemethodoptions
|
||||
else if is_objcclass(current_structdef) then
|
||||
setobjcclassmethodoptions;
|
||||
|
||||
@ -44,7 +44,9 @@ interface
|
||||
pd_cppobject, { directive can be used with cppclass }
|
||||
pd_objcclass, { directive can be used with objcclass }
|
||||
pd_objcprot, { directive can be used with objcprotocol }
|
||||
pd_nothelper { directive can not be used with record/class helper declaration }
|
||||
pd_nothelper, { directive can not be used with record/class helper declaration }
|
||||
pd_javaclass, { directive can be used with Java class }
|
||||
pd_intfjava { directive can be used with Java interface }
|
||||
);
|
||||
tpdflags=set of tpdflag;
|
||||
|
||||
@ -295,7 +297,9 @@ implementation
|
||||
|
||||
{ Generate VMT variable for constructor/destructor }
|
||||
if (pd.proctypeoption in [potype_constructor,potype_destructor]) and
|
||||
not(is_cppclass(tprocdef(pd).struct) or is_record(tprocdef(pd).struct)) then
|
||||
not(is_cppclass(tprocdef(pd).struct) or
|
||||
is_record(tprocdef(pd).struct) or
|
||||
is_javaclass(tprocdef(pd).struct)) then
|
||||
begin
|
||||
{ can't use classrefdef as type because inheriting
|
||||
will then always file because of a type mismatch }
|
||||
@ -2073,6 +2077,9 @@ begin
|
||||
hs:=ChangeFileExt(hs,target_info.sharedlibext);
|
||||
if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
|
||||
hs:=target_info.sharedlibprefix+hs;
|
||||
{ the JVM expects java/lang/Object rather than java.lang.Object }
|
||||
if target_info.system=system_jvm_java32 then
|
||||
Replace(hs,'.','/');
|
||||
import_dll:=stringdup(hs);
|
||||
include(procoptions,po_has_importdll);
|
||||
if (idtoken=_NAME) then
|
||||
@ -2379,7 +2386,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_OVERRIDE;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_notrecord];
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_javaclass,pd_notrecord];
|
||||
handler : @pd_override;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_overridingmethod,po_virtualmethod];
|
||||
@ -2444,7 +2451,7 @@ const
|
||||
mutexclpo : []
|
||||
),(
|
||||
idtok:_STATIC;
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_object,pd_record,pd_notobjintf];
|
||||
pd_flags : [pd_interface,pd_implemen,pd_body,pd_object,pd_record,pd_javaclass,pd_notobjintf];
|
||||
handler : @pd_static;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_staticmethod];
|
||||
@ -2680,6 +2687,15 @@ const
|
||||
{ check if method and directive not for record/class helper }
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) and
|
||||
(pd_nothelper in proc_direcdata[p].pd_flags) then
|
||||
|
||||
{ check if method and directive not for java class }
|
||||
if is_javaclass(tprocdef(pd).struct) and
|
||||
not(pd_javaclass in proc_direcdata[p].pd_flags) then
|
||||
exit;
|
||||
|
||||
{ check if method and directive not for java interface }
|
||||
if is_javainterface(tprocdef(pd).struct) and
|
||||
not(pd_intfjava in proc_direcdata[p].pd_flags) then
|
||||
exit;
|
||||
|
||||
end;
|
||||
|
||||
@ -367,6 +367,7 @@ implementation
|
||||
{ Allow classrefdef, which is required for
|
||||
Typeof(self) in static class methods }
|
||||
if not(is_objc_class_or_protocol(p1.resultdef)) and
|
||||
not(is_java_class_or_interface(p1.resultdef)) and
|
||||
((p1.resultdef.typ = objectdef) or
|
||||
(assigned(current_procinfo) and
|
||||
((po_classmethod in current_procinfo.procdef.procoptions) or
|
||||
|
||||
@ -314,7 +314,9 @@ type
|
||||
(when calling a regular procedure using the above convention, it will
|
||||
simply not see the frame pointer parameter, and since the caller cleans
|
||||
up the stack will also remain balanced) }
|
||||
po_delphi_nested_cc
|
||||
po_delphi_nested_cc,
|
||||
{ Java method }
|
||||
po_java
|
||||
);
|
||||
tprocoptions=set of tprocoption;
|
||||
|
||||
|
||||
@ -760,6 +760,10 @@ interface
|
||||
objc_fastenumeration : tobjectdef;
|
||||
objc_fastenumerationstate : trecorddef;
|
||||
|
||||
{ Java base types }
|
||||
{ java.lang.Object }
|
||||
java_jlobject : tobjectdef;
|
||||
|
||||
const
|
||||
{$ifdef i386}
|
||||
pbestrealtype : ^tdef = @s80floattype;
|
||||
@ -830,6 +834,10 @@ interface
|
||||
function is_class_or_object(def: tdef): boolean;
|
||||
function is_record(def: tdef): boolean;
|
||||
|
||||
function is_javaclass(def: tdef): boolean;
|
||||
function is_javainterface(def: tdef): boolean;
|
||||
function is_java_class_or_interface(def: tdef): boolean;
|
||||
|
||||
procedure loadobjctypes;
|
||||
procedure maybeloadcocoatypes;
|
||||
|
||||
@ -4516,7 +4524,7 @@ implementation
|
||||
if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
|
||||
prepareguid;
|
||||
{ setup implemented interfaces }
|
||||
if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
|
||||
if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_interfacejava] then
|
||||
ImplementedInterfaces:=TFPObjectList.Create(true)
|
||||
else
|
||||
ImplementedInterfaces:=nil;
|
||||
@ -4575,7 +4583,7 @@ implementation
|
||||
end;
|
||||
|
||||
{ load implemented interfaces }
|
||||
if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
|
||||
if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_interfacejava] then
|
||||
begin
|
||||
ImplementedInterfaces:=TFPObjectList.Create(true);
|
||||
implintfcount:=ppufile.getlongint;
|
||||
@ -4613,6 +4621,10 @@ implementation
|
||||
(objecttype=odt_objcclass) and
|
||||
(objname^='PROTOCOL') then
|
||||
objc_protocoltype:=self;
|
||||
if (childof=nil) and
|
||||
(objecttype=odt_javaclass) and
|
||||
(objname^='TOBJECT') then
|
||||
java_jlobject:=self;
|
||||
writing_class_record_dbginfo:=false;
|
||||
end;
|
||||
|
||||
@ -4955,7 +4967,7 @@ implementation
|
||||
{ inherit options and status }
|
||||
objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
|
||||
{ add the data of the anchestor class/object }
|
||||
if (objecttype in [odt_class,odt_object,odt_objcclass]) then
|
||||
if (objecttype in [odt_class,odt_object,odt_objcclass,odt_javaclass]) then
|
||||
begin
|
||||
tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize+tObjectSymtable(c.symtable).datasize;
|
||||
{ inherit recordalignment }
|
||||
@ -4986,7 +4998,7 @@ implementation
|
||||
var
|
||||
vs: tfieldvarsym;
|
||||
begin
|
||||
if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
|
||||
if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
|
||||
exit;
|
||||
if (oo_has_vmt in objectoptions) then
|
||||
internalerror(12345)
|
||||
@ -5017,7 +5029,7 @@ implementation
|
||||
|
||||
procedure tobjectdef.check_forwards;
|
||||
begin
|
||||
if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol]) then
|
||||
if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol,odt_interfacejava]) then
|
||||
inherited;
|
||||
if (oo_is_forward in objectoptions) then
|
||||
begin
|
||||
@ -5029,7 +5041,7 @@ implementation
|
||||
|
||||
|
||||
{ true if prot implements d (or if they are equal) }
|
||||
function is_related_protocol(prot: tobjectdef; d : tdef) : boolean;
|
||||
function is_related_interface_multiple(prot: tobjectdef; d : tdef) : boolean;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
@ -5041,7 +5053,7 @@ implementation
|
||||
|
||||
for i:=0 to prot.ImplementedInterfaces.count-1 do
|
||||
begin
|
||||
result:=is_related_protocol(TImplementedInterface(prot.ImplementedInterfaces[i]).intfdef,d);
|
||||
result:=is_related_interface_multiple(TImplementedInterface(prot.ImplementedInterfaces[i]).intfdef,d);
|
||||
if result then
|
||||
exit;
|
||||
end;
|
||||
@ -5065,22 +5077,34 @@ implementation
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ Objective-C protocols can use multiple inheritance }
|
||||
if (objecttype=odt_objcprotocol) then
|
||||
{ Objective-C protocols and Java interfaces can use multiple
|
||||
inheritance }
|
||||
if (objecttype in [odt_objcprotocol,odt_interfacejava]) then
|
||||
begin
|
||||
is_related:=is_related_protocol(self,d);
|
||||
is_related:=is_related_interface_multiple(self,d);
|
||||
exit
|
||||
end;
|
||||
|
||||
{ formally declared Objective-C classes match Objective-C classes with
|
||||
the same name }
|
||||
if (objecttype=odt_objcclass) and
|
||||
(tobjectdef(d).objecttype=odt_objcclass) and
|
||||
{ formally declared Objective-C and Java classes match Objective-C/Java
|
||||
classes with the same name. In case of Java, the package must also
|
||||
match}
|
||||
if (objecttype in [odt_objcclass,odt_javaclass]) and
|
||||
(tobjectdef(d).objecttype=objecttype) and
|
||||
((oo_is_formal in objectoptions) or
|
||||
(oo_is_formal in tobjectdef(d).objectoptions)) and
|
||||
(objrealname^=tobjectdef(d).objrealname^) then
|
||||
begin
|
||||
is_related:=true;
|
||||
{ check package name for Java }
|
||||
if objecttype=odt_objcclass then
|
||||
is_related:=true
|
||||
else
|
||||
begin
|
||||
is_related:=
|
||||
assigned(import_lib)=assigned(tobjectdef(d).import_lib);
|
||||
if is_related and
|
||||
assigned(import_lib) then
|
||||
is_related:=import_lib^=tobjectdef(d).import_lib^;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -5120,7 +5144,7 @@ implementation
|
||||
|
||||
function tobjectdef.size : asizeint;
|
||||
begin
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper,odt_javaclass,odt_interfacejava] then
|
||||
result:=sizeof(pint)
|
||||
else
|
||||
result:=tObjectSymtable(symtable).datasize;
|
||||
@ -5129,7 +5153,7 @@ implementation
|
||||
|
||||
function tobjectdef.alignment:shortint;
|
||||
begin
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper,odt_javaclass,odt_interfacejava] then
|
||||
alignment:=sizeof(pint)
|
||||
else
|
||||
alignment:=tObjectSymtable(symtable).recordalignment;
|
||||
@ -5149,6 +5173,10 @@ implementation
|
||||
vmtmethodoffset:=0;
|
||||
odt_interfacecom,odt_interfacecorba,odt_dispinterface:
|
||||
vmtmethodoffset:=index*sizeof(pint);
|
||||
odt_javaclass,
|
||||
odt_interfacejava:
|
||||
{ invalid }
|
||||
vmtmethodoffset:=-1;
|
||||
else
|
||||
{$ifdef WITHDMT}
|
||||
vmtmethodoffset:=(index+4)*sizeof(pint);
|
||||
@ -5182,7 +5210,9 @@ implementation
|
||||
needs_inittable:=tObjectSymtable(symtable).needs_init_final;
|
||||
odt_cppclass,
|
||||
odt_objcclass,
|
||||
odt_objcprotocol:
|
||||
odt_objcprotocol,
|
||||
odt_javaclass,
|
||||
odt_interfacejava:
|
||||
needs_inittable:=false;
|
||||
else
|
||||
internalerror(200108267);
|
||||
@ -5953,7 +5983,7 @@ implementation
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper]);
|
||||
(tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper,odt_javaclass,odt_interfacejava]);
|
||||
end;
|
||||
|
||||
function is_class_or_object(def: tdef): boolean;
|
||||
@ -5971,6 +6001,30 @@ implementation
|
||||
(def.typ=recorddef);
|
||||
end;
|
||||
|
||||
function is_javaclass(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype=odt_javaclass);
|
||||
end;
|
||||
|
||||
function is_javainterface(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype=odt_interfacejava);
|
||||
end;
|
||||
|
||||
function is_java_class_or_interface(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
(tobjectdef(def).objecttype in [odt_javaclass,odt_interfacejava]);
|
||||
end;
|
||||
|
||||
procedure loadobjctypes;
|
||||
begin
|
||||
objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_CLASS',true).typedef);
|
||||
|
||||
@ -252,7 +252,7 @@ interface
|
||||
|
||||
{*** Object Helpers ***}
|
||||
function search_default_property(pd : tabstractrecorddef) : tpropertysym;
|
||||
function find_real_objcclass_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
|
||||
function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
|
||||
|
||||
{*** Macro Helpers ***}
|
||||
{If called initially, the following procedures manipulate macros in }
|
||||
@ -2128,12 +2128,16 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function find_real_objcclass_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
|
||||
function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
|
||||
var
|
||||
hashedid : THashedIDString;
|
||||
stackitem : psymtablestackitem;
|
||||
srsymtable : tsymtable;
|
||||
srsym : tsym;
|
||||
formalname,
|
||||
foundname : shortstring;
|
||||
formalnameptr,
|
||||
foundnameptr: pshortstring;
|
||||
begin
|
||||
{ not a formal definition -> return it }
|
||||
if not(oo_is_formal in pd.objectoptions) then
|
||||
@ -2147,20 +2151,45 @@ implementation
|
||||
begin
|
||||
srsymtable:=stackitem^.symtable;
|
||||
{ ObjC classes can't appear in generics or as nested class
|
||||
definitions }
|
||||
if not(srsymtable.symtabletype in [recordsymtable,ObjectSymtable,parasymtable]) then
|
||||
definitions. Java classes can. }
|
||||
if not(srsymtable.symtabletype in [recordsymtable,parasymtable]) or
|
||||
(is_java_class_or_interface(pd) and
|
||||
(srsymtable.symtabletype=ObjectSymtable)) then
|
||||
begin
|
||||
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
||||
if assigned(srsym) and
|
||||
(srsym.typ=typesym) and
|
||||
is_objcclass(ttypesym(srsym).typedef) and
|
||||
(ttypesym(srsym).typedef.typ=objectdef) and
|
||||
(tobjectdef(ttypesym(srsym).typedef).objecttype=pd.objecttype) and
|
||||
not(oo_is_formal in tobjectdef(ttypesym(srsym).typedef).objectoptions) then
|
||||
begin
|
||||
{ the external name for the formal and the real definition must match }
|
||||
if tobjectdef(ttypesym(srsym).typedef).objextname^<>pd.objextname^ then
|
||||
if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) or
|
||||
assigned(pd.import_lib) then
|
||||
begin
|
||||
Message2(sym_e_external_class_name_mismatch1,pd.objextname^,pd.typename);
|
||||
MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,tobjectdef(ttypesym(srsym).typedef).objextname^);
|
||||
if assigned(pd.import_lib) then
|
||||
formalname:=pd.import_lib^
|
||||
else
|
||||
formalname:='';
|
||||
formalname:=formalname+'.'+pd.objextname^;
|
||||
if assigned(tobjectdef(ttypesym(srsym).typedef).import_lib) then
|
||||
foundname:=tobjectdef(ttypesym(srsym).typedef).import_lib^+'.'
|
||||
else
|
||||
foundname:='';
|
||||
foundname:=foundname+tobjectdef(ttypesym(srsym).typedef).objextname^;
|
||||
|
||||
formalnameptr:=@formalname;
|
||||
foundnameptr:=@foundname;
|
||||
end
|
||||
else
|
||||
begin
|
||||
formalnameptr:=pd.objextname;
|
||||
foundnameptr:=tobjectdef(ttypesym(srsym).typedef).objextname;
|
||||
end;
|
||||
if foundnameptr^<>formalnameptr^ then
|
||||
begin
|
||||
Message2(sym_e_external_class_name_mismatch1,formalnameptr^,pd.typename);
|
||||
MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,foundnameptr^);
|
||||
end;
|
||||
result:=tobjectdef(ttypesym(srsym).typedef);
|
||||
if assigned(current_procinfo) and
|
||||
@ -2175,7 +2204,7 @@ implementation
|
||||
{ nothing found: optionally give an error and return the original
|
||||
(empty) one }
|
||||
if erroronfailure then
|
||||
Message1(sym_e_objc_formal_class_not_resolved,pd.objrealname^);
|
||||
Message1(sym_e_formal_class_not_resolved,pd.objrealname^);
|
||||
result:=pd;
|
||||
end;
|
||||
|
||||
@ -2187,11 +2216,11 @@ implementation
|
||||
i : longint;
|
||||
begin
|
||||
orgclass:=classh;
|
||||
{ in case this is a formal objcclass, first find the real definition }
|
||||
{ in case this is a formal class, first find the real definition }
|
||||
if assigned(classh) then
|
||||
begin
|
||||
if (oo_is_formal in classh.objectoptions) then
|
||||
classh:=find_real_objcclass_definition(classh,true);
|
||||
classh:=find_real_class_definition(classh,true);
|
||||
{ The contextclassh is used for visibility. The classh must be equal to
|
||||
or be a parent of contextclassh. E.g. for inherited searches the classh is the
|
||||
parent or a class helper. }
|
||||
@ -2203,9 +2232,10 @@ implementation
|
||||
end;
|
||||
result:=false;
|
||||
hashedid.id:=s;
|
||||
{ an Objective-C protocol can inherit from multiple other protocols
|
||||
-> uses ImplementedInterfaces instead }
|
||||
if is_objcprotocol(classh) then
|
||||
{ an Objective-C protocol or Java interface can inherit from multiple
|
||||
other protocols/interfaces -> use ImplementedInterfaces instead }
|
||||
if is_objcprotocol(classh) or
|
||||
is_javainterface(classh) then
|
||||
begin
|
||||
srsymtable:=classh.symtable;
|
||||
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
||||
@ -2303,10 +2333,10 @@ implementation
|
||||
def : tdef;
|
||||
i : longint;
|
||||
begin
|
||||
{ in case this is a formal objcclass, first find the real definition }
|
||||
{ in case this is a formal class, first find the real definition }
|
||||
if assigned(classh) and
|
||||
(oo_is_formal in classh.objectoptions) then
|
||||
classh:=find_real_objcclass_definition(classh,true);
|
||||
classh:=find_real_class_definition(classh,true);
|
||||
result:=false;
|
||||
def:=nil;
|
||||
while assigned(classh) do
|
||||
@ -2341,10 +2371,10 @@ implementation
|
||||
def : tdef;
|
||||
i : longint;
|
||||
begin
|
||||
{ in case this is a formal objcclass, first find the real definition }
|
||||
{ in case this is a formal class, first find the real definition }
|
||||
if assigned(classh) and
|
||||
(oo_is_formal in classh.objectoptions) then
|
||||
classh:=find_real_objcclass_definition(classh,true);
|
||||
classh:=find_real_class_definition(classh,true);
|
||||
result:=false;
|
||||
def:=nil;
|
||||
while assigned(classh) do
|
||||
@ -2798,9 +2828,9 @@ implementation
|
||||
orgpd : tabstractrecorddef;
|
||||
srsymtable : tsymtable;
|
||||
begin
|
||||
{ in case this is a formal objcclass, first find the real definition }
|
||||
{ in case this is a formal class, first find the real definition }
|
||||
if (oo_is_formal in pd.objectoptions) then
|
||||
pd:=find_real_objcclass_definition(tobjectdef(pd),true);
|
||||
pd:=find_real_class_definition(tobjectdef(pd),true);
|
||||
if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
|
||||
exit;
|
||||
hashedid.id:=s;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user