paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 06:29:38 +02:00
Code Issues Packages Projects Releases Wiki Activity

* various small support fixes for Java classes:

Browse Source 
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 2011-08-20 07:38:26 +00:00
parent 74d684878d
commit 6e82417a51
12 changed files with 457 additions and 305 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/defcmp.pas
View File

@ -1266,8 +1266,8 @@ implementation
begin begin
{ Objective-C classes (handle anonymous externals) } { Objective-C classes (handle anonymous externals) }
if (def_from.typ=objectdef) and if (def_from.typ=objectdef) and
(find_real_objcclass_definition(tobjectdef(def_from),false) = (find_real_class_definition(tobjectdef(def_from),false) =
find_real_objcclass_definition(tobjectdef(def_to),false)) then find_real_class_definition(tobjectdef(def_to),false)) then
begin begin
doconv:=tc_equal; doconv:=tc_equal;
{ exact, not equal, because can change between interface { exact, not equal, because can change between interface

7
compiler/jvmdef.pas
View File

@ -181,7 +181,12 @@ implementation
case tobjectdef(def).objecttype of case tobjectdef(def).objecttype of
odt_javaclass, odt_javaclass,
odt_interfacejava: 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 else
result:=false; result:=false;
end; end;

10
compiler/msg/errore.msg
View File

@ -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 % 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 % 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. % 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 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 type using \var{type x = type y;} is not yet supported. You may be able to % 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;} instead. % 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 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 % 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 % 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 % declared as \var{experimental} is used. Experimental units
% might disappear or change semantics in future versions. Usage of this unit % might disappear or change semantics in future versions. Usage of this unit
% should be avoided as much as possible. % 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 sym_e_formal_class_not_resolved=05080_E_No complete definition of the formally declared class "$1" is in scope
% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared. % 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. % 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 % 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 % access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition

6
compiler/msgidx.inc
View File

@ -367,7 +367,7 @@ const
parser_e_must_use_override_objc=03273; parser_e_must_use_override_objc=03273;
parser_h_should_use_override_objc=03274; parser_h_should_use_override_objc=03274;
parser_e_objc_message_name_changed=03275; 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_as_types=03277;
parser_e_no_category_override=03278; parser_e_no_category_override=03278;
parser_e_must_use_reintroduce_objc=03279; parser_e_must_use_reintroduce_objc=03279;
@ -564,7 +564,7 @@ const
sym_w_library_unit=05077; sym_w_library_unit=05077;
sym_w_non_implemented_unit=05078; sym_w_non_implemented_unit=05078;
sym_w_experimental_unit=05079; 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_interprocgoto_into_init_final_code_not_allowed=05081;
sym_e_external_class_name_mismatch1=05082; sym_e_external_class_name_mismatch1=05082;
sym_e_external_class_name_mismatch2=05083; sym_e_external_class_name_mismatch2=05083;
@ -900,7 +900,7 @@ const
option_info=11024; option_info=11024;
option_help_pages=11025; option_help_pages=11025;
MsgTxtSize = 60991; MsgTxtSize = 60995;
MsgIdxMax : array[1..20] of longint=( MsgIdxMax : array[1..20] of longint=(
26,89,314,103,85,54,111,23,202,63, 26,89,314,103,85,54,111,23,202,63,

437
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

14
compiler/pdecl.pas
View File

@ -383,7 +383,7 @@ implementation
procedure types_dec(in_structure: boolean); procedure types_dec(in_structure: boolean);
procedure finalize_objc_class_or_protocol_external_status(od: tobjectdef); procedure finalize_class_external_status(od: tobjectdef);
begin begin
if [oo_is_external,oo_is_forward] <= od.objectoptions then if [oo_is_external,oo_is_forward] <= od.objectoptions then
begin begin
@ -537,8 +537,9 @@ implementation
istyperenaming:=true; istyperenaming:=true;
if isunique then if isunique then
begin begin
if is_objc_class_or_protocol(hdef) then if is_objc_class_or_protocol(hdef) or
Message(parser_e_no_objc_unique); is_java_class_or_interface(hdef) then
Message(parser_e_unique_unsupported);
hdef:=tstoreddef(hdef).getcopy; hdef:=tstoreddef(hdef).getcopy;
@ -606,11 +607,12 @@ implementation
try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg); try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg);
consume(_SEMICOLON); 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 formal external definition, so the compiler does not
expect an real definition later } expect an real definition later }
if is_objc_class_or_protocol(hdef) then if is_objc_class_or_protocol(hdef) or
finalize_objc_class_or_protocol_external_status(tobjectdef(hdef)); is_java_class_or_interface(hdef) then
finalize_class_external_status(tobjectdef(hdef));
{ Build VMT indexes, skip for type renaming and forward classes } { Build VMT indexes, skip for type renaming and forward classes }
if (hdef.typesym=newtype) and if (hdef.typesym=newtype) and

93
compiler/pdecobj.pas
View File

@ -280,7 +280,7 @@ implementation
procedure handleImplementedProtocol(intfdef : tobjectdef); procedure handleImplementedProtocol(intfdef : tobjectdef);
begin begin
intfdef:=find_real_objcclass_definition(intfdef,false); intfdef:=find_real_class_definition(intfdef,false);
if not is_objcprotocol(intfdef) then if not is_objcprotocol(intfdef) then
begin begin
Message1(type_e_protocol_type_expected,intfdef.typename); Message1(type_e_protocol_type_expected,intfdef.typename);
@ -345,7 +345,7 @@ implementation
p.free; p.free;
end; end;
procedure get_cpp_class_external_status(od: tobjectdef); procedure get_cpp_or_java_class_external_status(od: tobjectdef);
var var
hs: string; hs: string;
begin begin
@ -363,6 +363,9 @@ implementation
hs:=ChangeFileExt(hs,target_info.sharedlibext); hs:=ChangeFileExt(hs,target_info.sharedlibext);
if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
hs:=target_info.sharedlibprefix+hs; 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); od.import_lib:=stringdup(hs);
end; end;
include(od.objectoptions, oo_is_external); 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 if [oo_is_abstract, oo_is_sealed] * current_structdef.objectoptions = [oo_is_abstract, oo_is_sealed] then
Message(parser_e_abstract_and_sealed_conflict); Message(parser_e_abstract_and_sealed_conflict);
end; end;
odt_cppclass: odt_cppclass,
get_cpp_class_external_status(current_objectdef); odt_javaclass:
get_cpp_or_java_class_external_status(current_objectdef);
odt_objcclass,odt_objcprotocol,odt_objccategory: odt_objcclass,odt_objcprotocol,odt_objccategory:
get_objc_class_or_protocol_external_status(current_objectdef); get_objc_class_or_protocol_external_status(current_objectdef);
odt_helper: ; // nothing odt_helper: ; // nothing
@ -460,10 +464,14 @@ implementation
{ a mix of class, interfaces, objects and cppclasses { a mix of class, interfaces, objects and cppclasses
isn't allowed } isn't allowed }
case current_objectdef.objecttype of case current_objectdef.objecttype of
odt_class: odt_class,
if not(is_class(childof)) then odt_javaclass:
if (childof.objecttype<>current_objectdef.objecttype) then
begin 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 begin
{ we insert the interface after the child { we insert the interface after the child
is set, see below is set, see below
@ -476,7 +484,9 @@ implementation
end end
else else
if oo_is_sealed in childof.objectoptions then 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_interfacecorba,
odt_interfacecom: odt_interfacecom:
begin begin
@ -507,7 +517,7 @@ implementation
Message(parser_e_mix_of_classes_and_objects); Message(parser_e_mix_of_classes_and_objects);
end end
else else
childof:=find_real_objcclass_definition(childof,true); childof:=find_real_class_definition(childof,true);
odt_objcprotocol: odt_objcprotocol:
begin begin
if not(is_objcprotocol(childof)) then if not(is_objcprotocol(childof)) then
@ -515,6 +525,13 @@ implementation
intfchildof:=childof; intfchildof:=childof;
childof:=nil; childof:=nil;
end; 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: odt_object:
if not(is_object(childof)) then if not(is_object(childof)) then
Message(parser_e_mix_of_classes_and_objects) Message(parser_e_mix_of_classes_and_objects)
@ -548,6 +565,9 @@ implementation
childof:=interface_idispatch; childof:=interface_idispatch;
odt_objcclass: odt_objcclass:
CGMessage(parser_h_no_objc_parent); CGMessage(parser_h_no_objc_parent);
odt_javaclass:
if current_objectdef<>java_jlobject then
childof:=java_jlobject;
end; end;
end; end;
@ -562,7 +582,7 @@ implementation
else if not(oo_is_formal in childof.objectoptions) then else if not(oo_is_formal in childof.objectoptions) then
current_objectdef.set_parent(childof) current_objectdef.set_parent(childof)
else else
Message1(sym_e_objc_formal_class_not_resolved,childof.objrealname^); Message1(sym_e_formal_class_not_resolved,childof.objrealname^);
end; end;
{ remove forward flag, is resolved } { remove forward flag, is resolved }
@ -570,7 +590,7 @@ implementation
if hasparentdefined then if hasparentdefined then
begin 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 begin
if assigned(intfchildof) then if assigned(intfchildof) then
if current_objectdef.objecttype=odt_class then if current_objectdef.objecttype=odt_class then
@ -664,6 +684,15 @@ implementation
end; 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); procedure chkcpp(pd:tprocdef);
begin begin
{ nothing currently } { nothing currently }
@ -696,7 +725,7 @@ implementation
vdoptions: tvar_dec_options; vdoptions: tvar_dec_options;
begin begin
{ empty class declaration ? } { 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 (token=_SEMICOLON) then
exit; exit;
@ -749,7 +778,8 @@ implementation
_PRIVATE : _PRIVATE :
begin begin
if is_interface(current_structdef) or 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); Message(parser_e_no_access_specifier_in_interfaces);
consume(_PRIVATE); consume(_PRIVATE);
current_structdef.symtable.currentvisibility:=vis_private; current_structdef.symtable.currentvisibility:=vis_private;
@ -762,7 +792,8 @@ implementation
_PROTECTED : _PROTECTED :
begin begin
if is_interface(current_structdef) or 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); Message(parser_e_no_access_specifier_in_interfaces);
consume(_PROTECTED); consume(_PROTECTED);
current_structdef.symtable.currentvisibility:=vis_protected; current_structdef.symtable.currentvisibility:=vis_protected;
@ -775,7 +806,8 @@ implementation
_PUBLIC : _PUBLIC :
begin begin
if is_interface(current_structdef) or 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); Message(parser_e_no_access_specifier_in_interfaces);
consume(_PUBLIC); consume(_PUBLIC);
current_structdef.symtable.currentvisibility:=vis_public; current_structdef.symtable.currentvisibility:=vis_public;
@ -791,9 +823,10 @@ implementation
{ this is the way, delphi does it } { this is the way, delphi does it }
if is_interface(current_structdef) then if is_interface(current_structdef) then
Message(parser_e_no_access_specifier_in_interfaces); 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. } 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); Message(parser_e_no_objc_published);
consume(_PUBLISHED); consume(_PUBLISHED);
current_structdef.symtable.currentvisibility:=vis_published; current_structdef.symtable.currentvisibility:=vis_published;
@ -805,9 +838,10 @@ implementation
_STRICT : _STRICT :
begin begin
if is_interface(current_structdef) or if is_interface(current_structdef) or
is_objc_protocol_or_category(current_structdef) then is_objc_protocol_or_category(current_structdef) or
Message(parser_e_no_access_specifier_in_interfaces); is_javainterface(current_structdef) then
consume(_STRICT); Message(parser_e_no_access_specifier_in_interfaces);
consume(_STRICT);
if token=_ID then if token=_ID then
begin begin
case idtoken of case idtoken of
@ -840,7 +874,8 @@ implementation
begin begin
if is_interface(current_structdef) or if is_interface(current_structdef) or
is_objc_protocol_or_category(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); Message(parser_e_no_vars_in_interfaces);
if (current_structdef.symtable.currentvisibility=vis_published) and if (current_structdef.symtable.currentvisibility=vis_published) and
@ -937,6 +972,7 @@ implementation
chkcpp(pd); chkcpp(pd);
chkobjc(pd); chkobjc(pd);
chkjava(pd);
end; end;
maybe_parse_hint_directives(pd); maybe_parse_hint_directives(pd);
@ -1124,6 +1160,9 @@ implementation
odt_class : odt_class :
if (current_structdef.objname^='TOBJECT') then if (current_structdef.objname^='TOBJECT') then
class_tobject:=current_objectdef; class_tobject:=current_objectdef;
odt_javaclass:
if (current_objectdef.objname^='TOBJECT') then
java_jlobject:=current_objectdef;
end; end;
end; end;
if (current_module.modulename^='OBJCBASE') then if (current_module.modulename^='OBJCBASE') then
@ -1149,11 +1188,11 @@ implementation
(current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then (current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then
include(current_structdef.objectoptions,oo_can_have_published); 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 the syntax is "type tc = objcclass external;" -> we have to parse
its object options (external) already here, to make sure that such its object options (external) already here, to make sure that such
definitions are recognised as formal defs } 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; parse_object_options;
{ forward def? } { forward def? }
@ -1178,7 +1217,7 @@ implementation
include(current_objectdef.objectoptions,oo_is_classhelper); include(current_objectdef.objectoptions,oo_is_classhelper);
{ parse list of options (abstract / sealed) } { 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; parse_object_options;
symtablestack.push(current_structdef.symtable); symtablestack.push(current_structdef.symtable);
@ -1221,11 +1260,13 @@ implementation
if (oo_has_vmt in current_structdef.objectoptions) and if (oo_has_vmt in current_structdef.objectoptions) and
not(oo_is_forward in current_structdef.objectoptions) and not(oo_is_forward in current_structdef.objectoptions) and
not(oo_has_constructor 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^); Message1(parser_w_virtual_without_constructor,current_structdef.objrealname^);
if is_interface(current_structdef) or if is_interface(current_structdef) or
is_objcprotocol(current_structdef) then is_objcprotocol(current_structdef) or
is_javainterface(current_structdef) then
setinterfacemethodoptions setinterfacemethodoptions
else if is_objcclass(current_structdef) then else if is_objcclass(current_structdef) then
setobjcclassmethodoptions; setobjcclassmethodoptions;

24
compiler/pdecsub.pas
View File

@ -44,7 +44,9 @@ interface
pd_cppobject, { directive can be used with cppclass } 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 } 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; tpdflags=set of tpdflag;
@ -295,7 +297,9 @@ implementation
{ Generate VMT variable for constructor/destructor } { Generate VMT variable for constructor/destructor }
if (pd.proctypeoption in [potype_constructor,potype_destructor]) and 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 begin
{ can't use classrefdef as type because inheriting { can't use classrefdef as type because inheriting
will then always file because of a type mismatch } will then always file because of a type mismatch }
@ -2073,6 +2077,9 @@ begin
hs:=ChangeFileExt(hs,target_info.sharedlibext); hs:=ChangeFileExt(hs,target_info.sharedlibext);
if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
hs:=target_info.sharedlibprefix+hs; 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); import_dll:=stringdup(hs);
include(procoptions,po_has_importdll); include(procoptions,po_has_importdll);
if (idtoken=_NAME) then if (idtoken=_NAME) then
@ -2379,7 +2386,7 @@ const
mutexclpo : [] mutexclpo : []
),( ),(
idtok:_OVERRIDE; 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; handler : @pd_override;
pocall : pocall_none; pocall : pocall_none;
pooption : [po_overridingmethod,po_virtualmethod]; pooption : [po_overridingmethod,po_virtualmethod];
@ -2444,7 +2451,7 @@ const
mutexclpo : [] mutexclpo : []
),( ),(
idtok:_STATIC; 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; handler : @pd_static;
pocall : pocall_none; pocall : pocall_none;
pooption : [po_staticmethod]; pooption : [po_staticmethod];
@ -2680,6 +2687,15 @@ const
{ check if method and directive not for record/class helper } { check if method and directive not for record/class helper }
if is_objectpascal_helper(tprocdef(pd).struct) and if is_objectpascal_helper(tprocdef(pd).struct) and
(pd_nothelper in proc_direcdata[p].pd_flags) then (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; exit;
end; end;

1
compiler/pexpr.pas
View File

@ -367,6 +367,7 @@ implementation
{ Allow classrefdef, which is required for { Allow classrefdef, which is required for
Typeof(self) in static class methods } Typeof(self) in static class methods }
if not(is_objc_class_or_protocol(p1.resultdef)) and if not(is_objc_class_or_protocol(p1.resultdef)) and
not(is_java_class_or_interface(p1.resultdef)) and
((p1.resultdef.typ = objectdef) or ((p1.resultdef.typ = objectdef) or
(assigned(current_procinfo) and (assigned(current_procinfo) and
((po_classmethod in current_procinfo.procdef.procoptions) or ((po_classmethod in current_procinfo.procdef.procoptions) or

4
compiler/symconst.pas
View File

@ -314,7 +314,9 @@ type
(when calling a regular procedure using the above convention, it will (when calling a regular procedure using the above convention, it will
simply not see the frame pointer parameter, and since the caller cleans simply not see the frame pointer parameter, and since the caller cleans
up the stack will also remain balanced) } up the stack will also remain balanced) }
po_delphi_nested_cc po_delphi_nested_cc,
{ Java method }
po_java
); );
tprocoptions=set of tprocoption; tprocoptions=set of tprocoption;

92
compiler/symdef.pas
View File

@ -760,6 +760,10 @@ interface
objc_fastenumeration : tobjectdef; objc_fastenumeration : tobjectdef;
objc_fastenumerationstate : trecorddef; objc_fastenumerationstate : trecorddef;
{ Java base types }
{ java.lang.Object }
java_jlobject : tobjectdef;
const const
{$ifdef i386} {$ifdef i386}
pbestrealtype : ^tdef = @s80floattype; pbestrealtype : ^tdef = @s80floattype;
@ -830,6 +834,10 @@ interface
function is_class_or_object(def: tdef): boolean; function is_class_or_object(def: tdef): boolean;
function is_record(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 loadobjctypes;
procedure maybeloadcocoatypes; procedure maybeloadcocoatypes;
@ -4516,7 +4524,7 @@ implementation
if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
prepareguid; prepareguid;
{ setup implemented interfaces } { 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) ImplementedInterfaces:=TFPObjectList.Create(true)
else else
ImplementedInterfaces:=nil; ImplementedInterfaces:=nil;
@ -4575,7 +4583,7 @@ implementation
end; end;
{ load implemented interfaces } { 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 begin
ImplementedInterfaces:=TFPObjectList.Create(true); ImplementedInterfaces:=TFPObjectList.Create(true);
implintfcount:=ppufile.getlongint; implintfcount:=ppufile.getlongint;
@ -4613,6 +4621,10 @@ implementation
(objecttype=odt_objcclass) and (objecttype=odt_objcclass) and
(objname^='PROTOCOL') then (objname^='PROTOCOL') then
objc_protocoltype:=self; objc_protocoltype:=self;
if (childof=nil) and
(objecttype=odt_javaclass) and
(objname^='TOBJECT') then
java_jlobject:=self;
writing_class_record_dbginfo:=false; writing_class_record_dbginfo:=false;
end; end;
@ -4955,7 +4967,7 @@ implementation
{ inherit options and status } { inherit options and status }
objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions); objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
{ add the data of the anchestor class/object } { 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 begin
tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize+tObjectSymtable(c.symtable).datasize; tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize+tObjectSymtable(c.symtable).datasize;
{ inherit recordalignment } { inherit recordalignment }
@ -4986,7 +4998,7 @@ implementation
var var
vs: tfieldvarsym; vs: tfieldvarsym;
begin 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; exit;
if (oo_has_vmt in objectoptions) then if (oo_has_vmt in objectoptions) then
internalerror(12345) internalerror(12345)
@ -5017,7 +5029,7 @@ implementation
procedure tobjectdef.check_forwards; procedure tobjectdef.check_forwards;
begin 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; inherited;
if (oo_is_forward in objectoptions) then if (oo_is_forward in objectoptions) then
begin begin
@ -5029,7 +5041,7 @@ implementation
{ true if prot implements d (or if they are equal) } { 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 var
i : longint; i : longint;
begin begin
@ -5041,7 +5053,7 @@ implementation
for i:=0 to prot.ImplementedInterfaces.count-1 do for i:=0 to prot.ImplementedInterfaces.count-1 do
begin 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 if result then
exit; exit;
end; end;
@ -5065,22 +5077,34 @@ implementation
exit; exit;
end; end;
{ Objective-C protocols can use multiple inheritance } { Objective-C protocols and Java interfaces can use multiple
if (objecttype=odt_objcprotocol) then inheritance }
if (objecttype in [odt_objcprotocol,odt_interfacejava]) then
begin begin
is_related:=is_related_protocol(self,d); is_related:=is_related_interface_multiple(self,d);
exit exit
end; end;
{ formally declared Objective-C classes match Objective-C classes with { formally declared Objective-C and Java classes match Objective-C/Java
the same name } classes with the same name. In case of Java, the package must also
if (objecttype=odt_objcclass) and match}
(tobjectdef(d).objecttype=odt_objcclass) and if (objecttype in [odt_objcclass,odt_javaclass]) and
(tobjectdef(d).objecttype=objecttype) and
((oo_is_formal in objectoptions) or ((oo_is_formal in objectoptions) or
(oo_is_formal in tobjectdef(d).objectoptions)) and (oo_is_formal in tobjectdef(d).objectoptions)) and
(objrealname^=tobjectdef(d).objrealname^) then (objrealname^=tobjectdef(d).objrealname^) then
begin 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; exit;
end; end;
@ -5120,7 +5144,7 @@ implementation
function tobjectdef.size : asizeint; function tobjectdef.size : asizeint;
begin 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) result:=sizeof(pint)
else else
result:=tObjectSymtable(symtable).datasize; result:=tObjectSymtable(symtable).datasize;
@ -5129,7 +5153,7 @@ implementation
function tobjectdef.alignment:shortint; function tobjectdef.alignment:shortint;
begin 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) alignment:=sizeof(pint)
else else
alignment:=tObjectSymtable(symtable).recordalignment; alignment:=tObjectSymtable(symtable).recordalignment;
@ -5149,6 +5173,10 @@ implementation
vmtmethodoffset:=0; vmtmethodoffset:=0;
odt_interfacecom,odt_interfacecorba,odt_dispinterface: odt_interfacecom,odt_interfacecorba,odt_dispinterface:
vmtmethodoffset:=index*sizeof(pint); vmtmethodoffset:=index*sizeof(pint);
odt_javaclass,
odt_interfacejava:
{ invalid }
vmtmethodoffset:=-1;
else else
{$ifdef WITHDMT} {$ifdef WITHDMT}
vmtmethodoffset:=(index+4)*sizeof(pint); vmtmethodoffset:=(index+4)*sizeof(pint);
@ -5182,7 +5210,9 @@ implementation
needs_inittable:=tObjectSymtable(symtable).needs_init_final; needs_inittable:=tObjectSymtable(symtable).needs_init_final;
odt_cppclass, odt_cppclass,
odt_objcclass, odt_objcclass,
odt_objcprotocol: odt_objcprotocol,
odt_javaclass,
odt_interfacejava:
needs_inittable:=false; needs_inittable:=false;
else else
internalerror(200108267); internalerror(200108267);
@ -5953,7 +5983,7 @@ implementation
result:= result:=
assigned(def) and assigned(def) and
(def.typ=objectdef) 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; end;
function is_class_or_object(def: tdef): boolean; function is_class_or_object(def: tdef): boolean;
@ -5971,6 +6001,30 @@ implementation
(def.typ=recorddef); (def.typ=recorddef);
end; 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; procedure loadobjctypes;
begin begin
objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_CLASS',true).typedef); objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_CLASS',true).typedef);

70
compiler/symtable.pas
View File

@ -252,7 +252,7 @@ interface
{*** Object Helpers ***} {*** Object Helpers ***}
function search_default_property(pd : tabstractrecorddef) : tpropertysym; 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 ***} {*** Macro Helpers ***}
{If called initially, the following procedures manipulate macros in } {If called initially, the following procedures manipulate macros in }
@ -2128,12 +2128,16 @@ implementation
end; end;
function find_real_objcclass_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef; function find_real_class_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef;
var var
hashedid : THashedIDString; hashedid : THashedIDString;
stackitem : psymtablestackitem; stackitem : psymtablestackitem;
srsymtable : tsymtable; srsymtable : tsymtable;
srsym : tsym; srsym : tsym;
formalname,
foundname : shortstring;
formalnameptr,
foundnameptr: pshortstring;
begin begin
{ not a formal definition -> return it } { not a formal definition -> return it }
if not(oo_is_formal in pd.objectoptions) then if not(oo_is_formal in pd.objectoptions) then
@ -2147,20 +2151,45 @@ implementation
begin begin
srsymtable:=stackitem^.symtable; srsymtable:=stackitem^.symtable;
{ ObjC classes can't appear in generics or as nested class { ObjC classes can't appear in generics or as nested class
definitions } definitions. Java classes can. }
if not(srsymtable.symtabletype in [recordsymtable,ObjectSymtable,parasymtable]) then if not(srsymtable.symtabletype in [recordsymtable,parasymtable]) or
(is_java_class_or_interface(pd) and
(srsymtable.symtabletype=ObjectSymtable)) then
begin begin
srsym:=tsym(srsymtable.FindWithHash(hashedid)); srsym:=tsym(srsymtable.FindWithHash(hashedid));
if assigned(srsym) and if assigned(srsym) and
(srsym.typ=typesym) 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 not(oo_is_formal in tobjectdef(ttypesym(srsym).typedef).objectoptions) then
begin begin
{ the external name for the formal and the real definition must match } { 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 begin
Message2(sym_e_external_class_name_mismatch1,pd.objextname^,pd.typename); if assigned(pd.import_lib) then
MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,tobjectdef(ttypesym(srsym).typedef).objextname^); 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; end;
result:=tobjectdef(ttypesym(srsym).typedef); result:=tobjectdef(ttypesym(srsym).typedef);
if assigned(current_procinfo) and if assigned(current_procinfo) and
@ -2175,7 +2204,7 @@ implementation
{ nothing found: optionally give an error and return the original { nothing found: optionally give an error and return the original
(empty) one } (empty) one }
if erroronfailure then if erroronfailure then
Message1(sym_e_objc_formal_class_not_resolved,pd.objrealname^); Message1(sym_e_formal_class_not_resolved,pd.objrealname^);
result:=pd; result:=pd;
end; end;
@ -2187,11 +2216,11 @@ implementation
i : longint; i : longint;
begin begin
orgclass:=classh; 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 if assigned(classh) then
begin begin
if (oo_is_formal in classh.objectoptions) then 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 { 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 or be a parent of contextclassh. E.g. for inherited searches the classh is the
parent or a class helper. } parent or a class helper. }
@ -2203,9 +2232,10 @@ implementation
end; end;
result:=false; result:=false;
hashedid.id:=s; hashedid.id:=s;
{ an Objective-C protocol can inherit from multiple other protocols { an Objective-C protocol or Java interface can inherit from multiple
-> uses ImplementedInterfaces instead } other protocols/interfaces -> use ImplementedInterfaces instead }
if is_objcprotocol(classh) then if is_objcprotocol(classh) or
is_javainterface(classh) then
begin begin
srsymtable:=classh.symtable; srsymtable:=classh.symtable;
srsym:=tsym(srsymtable.FindWithHash(hashedid)); srsym:=tsym(srsymtable.FindWithHash(hashedid));
@ -2303,10 +2333,10 @@ implementation
def : tdef; def : tdef;
i : longint; i : longint;
begin 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 if assigned(classh) and
(oo_is_formal in classh.objectoptions) then (oo_is_formal in classh.objectoptions) then
classh:=find_real_objcclass_definition(classh,true); classh:=find_real_class_definition(classh,true);
result:=false; result:=false;
def:=nil; def:=nil;
while assigned(classh) do while assigned(classh) do
@ -2341,10 +2371,10 @@ implementation
def : tdef; def : tdef;
i : longint; i : longint;
begin 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 if assigned(classh) and
(oo_is_formal in classh.objectoptions) then (oo_is_formal in classh.objectoptions) then
classh:=find_real_objcclass_definition(classh,true); classh:=find_real_class_definition(classh,true);
result:=false; result:=false;
def:=nil; def:=nil;
while assigned(classh) do while assigned(classh) do
@ -2798,9 +2828,9 @@ implementation
orgpd : tabstractrecorddef; orgpd : tabstractrecorddef;
srsymtable : tsymtable; srsymtable : tsymtable;
begin 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 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 if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
exit; exit;
hashedid.id:=s; hashedid.id:=s;