paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 12:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Java interface support, mostly the same as Objective-C protocols

Browse Source 
(generalised some error messages that were specific to protocols
     so they can also be used for Java interfaces)
  o note, Java interface support requires a fix to Jasmin 2.4:
    http://sourceforge.net/tracker/?func=detail&aid=2897170&group_id=100746&atid=628212

git-svn-id: branches/jvmbackend@18344 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:49:19 +00:00
parent b0d050a490
commit 83dc297346
7 changed files with 354 additions and 279 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
compiler/agjasmin.pas
View File

@ -388,7 +388,10 @@ implementation
procedure TJasminAssembler.WriteExtraHeader(obj: tobjectdef); procedure TJasminAssembler.WriteExtraHeader(obj: tobjectdef);
var var
superclass,
intf: tobjectdef;
n: string; n: string;
i: longint;
begin begin
{ JVM 1.5+ } { JVM 1.5+ }
AsmWriteLn('.bytecode 49.0'); AsmWriteLn('.bytecode 49.0');
@ -399,6 +402,8 @@ implementation
else else
n:=InputFileName; n:=InputFileName;
AsmWriteLn('.source '+ExtractFileName(n)); AsmWriteLn('.source '+ExtractFileName(n));
{ class/interface name }
if not assigned(obj) then if not assigned(obj) then
begin begin
{ fake class type for unit -> name=unitname and { fake class type for unit -> name=unitname and
@ -408,13 +413,41 @@ implementation
end end
else else
begin begin
AsmWriteLn('.class '+obj.objextname^); case obj.objecttype of
if assigned(obj.childof) then odt_javaclass:
begin
AsmWriteLn('.class '+obj.objextname^);
superclass:=obj.childof;
end;
odt_interfacejava:
begin
AsmWriteLn('.interface abstract '+obj.objextname^);
{ interfaces must always specify Java.lang.object as
superclass }
superclass:=java_jlobject;
end
else
internalerror(2011010906);
end;
{ superclass }
if assigned(superclass) then
begin begin
AsmWrite('.super '); AsmWrite('.super ');
if assigned(obj.childof.import_lib) then if assigned(superclass.import_lib) then
AsmWrite(obj.childof.import_lib^+'/'); AsmWrite(superclass.import_lib^+'/');
AsmWriteln(obj.childof.objextname^); AsmWriteln(superclass.objextname^);
end;
{ implemented interfaces }
if assigned(obj.ImplementedInterfaces) then
begin
for i:=0 to obj.ImplementedInterfaces.count-1 do
begin
intf:=TImplementedInterface(obj.ImplementedInterfaces[i]).IntfDef;
AsmWrite('.implements ');
if assigned(intf.import_lib) then
AsmWrite(intf.import_lib^+'/');
AsmWriteln(intf.objextname^);
end;
end; end;
end; end;
AsmLn; AsmLn;
@ -492,6 +525,17 @@ implementation
procedure TJasminAssembler.WriteProcDef(pd: tprocdef); procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
begin begin
{ abstract method? }
if is_javainterface(tdef(pd.owner.defowner)) or
(po_abstractmethod in pd.procoptions) then
begin
AsmWrite('.method ');
AsmWriteln(pd.mangledname(true));
AsmWriteln('.end method');
AsmLn;
exit;
end;
WriteTree(pd.exprasmlist); WriteTree(pd.exprasmlist);
end; end;

18
compiler/msg/errore.msg
View File

@ -1254,16 +1254,16 @@ parser_e_no_objc_published=03271_E_Objective-C classes cannot have published sec
parser_f_need_objc=03272_F_This module requires an Objective-C mode switch to be compiled parser_f_need_objc=03272_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 % 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. % active. Enable one via the -M command line switch, or the {\$modeswitch x} directive.
parser_e_must_use_override_objc=03273_E_Inherited methods can only be overridden in Objective-C, add "override" (inherited method defined in $1) parser_e_must_use_override=03273_E_Inherited methods can only be overridden in Objective-C and Java, add "override" (inherited method defined in $1)
parser_h_should_use_override_objc=03274_H_Inherited methods can only be overridden in Objective-C, add "override" (inherited method defined in $1). parser_h_should_use_override=03274_H_Inherited methods can only be overridden in Objective-C and Java, add "override" (inherited method defined in $1).
% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same % It is not possible to \var{reintroduce} methods in Objective-C or Java 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, % name always map to the same virtual method entry. In order to make this clear in the source code,
% the compiler always requires the \var{override} directive to be specified when implementing overriding % the compiler always requires the \var{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 % Objective-C or Java methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C and Java
% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language), % do not have any \var{override}-style keyword (since it's the default and only behaviour in these languages),
% which makes it hard for automated header conversion tools to include it everywhere. % which makes it hard for automated header conversion tools to include it everywhere.
% The type in which the inherited method is defined is explicitly mentioned, because this may either % The type in which the inherited method is defined is explicitly mentioned, because this may either
% be an objcclass or an objccategory. % be an objcclass or an objccategory in case of Objective-C.
parser_e_objc_message_name_changed=03275_E_Message name "$1" in inherited class is different from message name "$2" in current class. parser_e_objc_message_name_changed=03275_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 % 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
@ -1350,9 +1350,9 @@ parser_f_no_generic_inside_generic=03297_F_Declaration of generic class inside a
% (guarded by internal error 200511173 in tscannerfile.startrecordtokens). % (guarded by internal error 200511173 in tscannerfile.startrecordtokens).
% Since generics are implemented by recording tokens, it is not possible to % Since generics are implemented by recording tokens, it is not possible to
% have declaration of generic class inside another generic class. % have declaration of generic class inside another generic class.
parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Forward declaration of objcprotocol "$1" must be resolved before an objcclass can conform to it parser_e_forward_intf_declaration_must_be_resolved=03298_E_Forward declaration "$1" must be resolved before a class can conform to or implement it
% An objcprotocol must be fully defined before classes can conform to it. % An Objective-C protocol or Java Interface must be fully defined before classes can conform to it.
% This error occurs in the following situation: % This error occurs in the following situation (example for Objective-C, but the same goes for Java interfaces):
% \begin{verbatim} % \begin{verbatim}
% Type MyProtocol = objcprotoocl; % Type MyProtocol = objcprotoocl;
% ChildClass = Class(NSObject,MyProtocol) % ChildClass = Class(NSObject,MyProtocol)

8
compiler/msgidx.inc
View File

@ -364,8 +364,8 @@ const
parser_h_no_objc_parent=03270; parser_h_no_objc_parent=03270;
parser_e_no_objc_published=03271; parser_e_no_objc_published=03271;
parser_f_need_objc=03272; parser_f_need_objc=03272;
parser_e_must_use_override_objc=03273; parser_e_must_use_override=03273;
parser_h_should_use_override_objc=03274; parser_h_should_use_override=03274;
parser_e_objc_message_name_changed=03275; parser_e_objc_message_name_changed=03275;
parser_e_unique_unsupported=03276; parser_e_unique_unsupported=03276;
parser_e_no_category_as_types=03277; parser_e_no_category_as_types=03277;
@ -389,7 +389,7 @@ const
parser_e_objc_missing_enumeration_defs=03295; parser_e_objc_missing_enumeration_defs=03295;
parser_e_no_procvarnested_const=03296; parser_e_no_procvarnested_const=03296;
parser_f_no_generic_inside_generic=03297; parser_f_no_generic_inside_generic=03297;
parser_e_forward_protocol_declaration_must_be_resolved=03298; parser_e_forward_intf_declaration_must_be_resolved=03298;
parser_e_no_record_published=03299; parser_e_no_record_published=03299;
parser_e_no_destructor_in_records=03300; parser_e_no_destructor_in_records=03300;
parser_e_class_methods_only_static_in_records=03301; parser_e_class_methods_only_static_in_records=03301;
@ -900,7 +900,7 @@ const
option_info=11024; option_info=11024;
option_help_pages=11025; option_help_pages=11025;
MsgTxtSize = 60995; MsgTxtSize = 61005;
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,

460
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

43
compiler/nobj.pas
View File

@ -281,11 +281,13 @@ implementation
not(po_virtualmethod in pd.procoptions) or not(po_virtualmethod in pd.procoptions) or
( (
{ new one does not have reintroduce in case of an objccategory } { new one does not have reintroduce in case of an objccategory }
(is_objccategory(_class) and not(po_reintroduce in pd.procoptions)) or (is_objccategory(_class) and
{ new one does not have override in case of objpas/objc class/helper/intf/proto } not(po_reintroduce in pd.procoptions)) or
( { new one does not have override in case of objpas/objc/java class/intf/proto }
(is_class_or_interface_or_objc(_class) or is_objectpascal_helper(_class)) and ((is_class_or_interface_or_objc(_class) or is_objectpascal_helper(_class)) and
not is_objccategory(_class) and not(po_overridingmethod in pd.procoptions) not is_objccategory(_class) and
not is_java_class_or_interface(_class) and
not(po_overridingmethod in pd.procoptions)
) )
) )
) then ) then
@ -296,7 +298,8 @@ implementation
) then ) then
begin begin
if not(po_reintroduce in pd.procoptions) then if not(po_reintroduce in pd.procoptions) then
if not(is_objc_class_or_protocol(_class)) then if not(is_objc_class_or_protocol(_class)) and
not(is_java_class_or_interface(_class)) then
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false)) MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
else else
begin begin
@ -308,10 +311,12 @@ implementation
In case of external classes, we only give a hint, In case of external classes, we only give a hint,
because requiring override everywhere may make because requiring override everywhere may make
automated header translation tools too complex. } automated header translation tools too complex.
The same goes for Java. }
if not(oo_is_external in _class.objectoptions) then if not(oo_is_external in _class.objectoptions) then
if not is_objccategory(_class) then if not is_objccategory(_class) then
MessagePos1(pd.fileinfo,parser_e_must_use_override_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)) MessagePos1(pd.fileinfo,parser_e_must_use_override,FullTypeName(tdef(vmtpd.owner.defowner),nil))
else else
MessagePos1(pd.fileinfo,parser_e_must_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)) MessagePos1(pd.fileinfo,parser_e_must_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil))
{ there may be a lot of these in auto-translated { there may be a lot of these in auto-translated
@ -319,7 +324,7 @@ implementation
the hint will be shown } the hint will be shown }
else if CheckVerbosity(V_Hint) then else if CheckVerbosity(V_Hint) then
if not is_objccategory(_class) then if not is_objccategory(_class) then
MessagePos1(pd.fileinfo,parser_h_should_use_override_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)) MessagePos1(pd.fileinfo,parser_h_should_use_override,FullTypeName(tdef(vmtpd.owner.defowner),nil))
else else
MessagePos1(pd.fileinfo,parser_h_should_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)); MessagePos1(pd.fileinfo,parser_h_should_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil));
{ no new entry, but copy the message name if any from { no new entry, but copy the message name if any from
@ -397,11 +402,12 @@ implementation
if not(po_reintroduce in pd.procoptions) then if not(po_reintroduce in pd.procoptions) then
begin begin
if not is_object(_class) and if not is_object(_class) and
not is_objc_class_or_protocol(_class) then not is_objc_class_or_protocol(_class) and
not is_java_class_or_interface(_class) then
MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false)) MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false))
else else
{ objects don't allow starting a new virtual tree { objects don't allow starting a new virtual tree
and neither does Objective-C } and neither do Objective-C or Java }
MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,vmtpd.fullprocname(false)); MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,vmtpd.fullprocname(false));
end; end;
{ disable/hide old VMT entry } { disable/hide old VMT entry }
@ -771,7 +777,8 @@ implementation
end; end;
build_interface_mappings; build_interface_mappings;
if assigned(_class.ImplementedInterfaces) and if assigned(_class.ImplementedInterfaces) and
not(is_objc_class_or_protocol(_class)) then not(is_objc_class_or_protocol(_class)) and
not(is_java_class_or_interface(_class)) then
begin begin
{ Optimize interface tables to reuse wrappers } { Optimize interface tables to reuse wrappers }
intf_optimize_vtbls; intf_optimize_vtbls;
@ -788,9 +795,11 @@ implementation
ImplIntf : TImplementedInterface; ImplIntf : TImplementedInterface;
i: longint; i: longint;
begin begin
{ Find Procdefs implementing the interfaces } { Find Procdefs implementing the interfaces (both Objective-C protocols
and Java interfaces can have multiple parent interfaces, but in that
case obviously no implementations are required) }
if assigned(_class.ImplementedInterfaces) and if assigned(_class.ImplementedInterfaces) and
(_class.objecttype<>odt_objcprotocol) then not(_class.objecttype in [odt_objcprotocol,odt_interfacejava]) then
begin begin
{ Collect implementor functions into the tImplementedInterface.procdefs } { Collect implementor functions into the tImplementedInterface.procdefs }
case _class.objecttype of case _class.objecttype of
@ -802,11 +811,13 @@ implementation
intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef) intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef)
end; end;
end; end;
odt_objcclass: odt_objcclass,
odt_javaclass:
begin begin
{ Object Pascal interfaces are afterwards optimized via the { Object Pascal interfaces are afterwards optimized via the
intf_optimize_vtbls() method, but we can't do this for intf_optimize_vtbls() method, but we can't do this for
protocols -> check for duplicates here already. } protocols/Java interfaces -> check for duplicates here
already. }
handledprotocols:=tfpobjectlist.create(false); handledprotocols:=tfpobjectlist.create(false);
for i:=0 to _class.ImplementedInterfaces.count-1 do for i:=0 to _class.ImplementedInterfaces.count-1 do
begin begin

35
compiler/pdecobj.pas
View File

@ -280,17 +280,31 @@ implementation
end; end;
procedure handleImplementedProtocol(intfdef : tobjectdef); procedure handleImplementedProtocolOrJavaIntf(intfdef : tobjectdef);
begin begin
intfdef:=find_real_class_definition(intfdef,false); intfdef:=find_real_class_definition(intfdef,false);
if not is_objcprotocol(intfdef) then case current_objectdef.objecttype of
begin odt_objcclass,
Message1(type_e_protocol_type_expected,intfdef.typename); odt_objccategory,
exit; odt_objcprotocol:
end; if not is_objcprotocol(intfdef) then
begin
Message1(type_e_protocol_type_expected,intfdef.typename);
exit;
end;
odt_javaclass,
odt_interfacejava:
if not is_javainterface(intfdef) then
begin
Message1(type_e_interface_type_expected,intfdef.typename);
exit
end;
else
internalerror(2011010807);
end;
if ([oo_is_forward,oo_is_formal] * intfdef.objectoptions <> []) then if ([oo_is_forward,oo_is_formal] * intfdef.objectoptions <> []) then
begin begin
Message1(parser_e_forward_protocol_declaration_must_be_resolved,intfdef.objrealname^); Message1(parser_e_forward_intf_declaration_must_be_resolved,intfdef.objrealname^);
exit; exit;
end; end;
if current_objectdef.find_implemented_interface(intfdef)<>nil then if current_objectdef.find_implemented_interface(intfdef)<>nil then
@ -321,7 +335,7 @@ implementation
if intf then if intf then
handleImplementedInterface(tobjectdef(hdef)) handleImplementedInterface(tobjectdef(hdef))
else else
handleImplementedProtocol(tobjectdef(hdef)); handleImplementedProtocolOrJavaIntf(tobjectdef(hdef));
end; end;
end; end;
@ -425,7 +439,8 @@ implementation
Message(parser_e_abstract_and_sealed_conflict); Message(parser_e_abstract_and_sealed_conflict);
end; end;
odt_cppclass, odt_cppclass,
odt_javaclass: odt_javaclass,
odt_interfacejava:
get_cpp_or_java_class_external_status(current_objectdef); 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);
@ -598,7 +613,7 @@ implementation
if current_objectdef.objecttype=odt_class then if current_objectdef.objecttype=odt_class then
handleImplementedInterface(intfchildof) handleImplementedInterface(intfchildof)
else else
handleImplementedProtocol(intfchildof); handleImplementedProtocolOrJavaIntf(intfchildof);
readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class); readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
end; end;
consume(_RKLAMMER); consume(_RKLAMMER);

15
compiler/symdef.pas
View File

@ -4213,7 +4213,6 @@ implementation
{ see tprocdef.jvmmangledname for description of the format } { see tprocdef.jvmmangledname for description of the format }
if fordefinition then if fordefinition then
begin begin
{ definition: visibility/static }
case visibility of case visibility of
vis_hidden, vis_hidden,
vis_strictprivate: vis_strictprivate:
@ -4230,6 +4229,8 @@ implementation
if (procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or if (procsym.owner.symtabletype in [globalsymtable,staticsymtable,localsymtable]) or
(po_staticmethod in procoptions) then (po_staticmethod in procoptions) then
tmpresult:=tmpresult+'static '; tmpresult:=tmpresult+'static ';
if is_javainterface(tdef(owner.defowner)) then
tmpresult:=tmpresult+'abstract ';
end end
else else
begin begin
@ -4528,7 +4529,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,odt_interfacejava] then if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_javaclass,odt_interfacejava] then
ImplementedInterfaces:=TFPObjectList.Create(true) ImplementedInterfaces:=TFPObjectList.Create(true)
else else
ImplementedInterfaces:=nil; ImplementedInterfaces:=nil;
@ -5068,8 +5069,12 @@ implementation
function tobjectdef.is_related(d : tdef) : boolean; function tobjectdef.is_related(d : tdef) : boolean;
var var
hp : tobjectdef; hp : tobjectdef;
realself: tobjectdef;
begin begin
if self=d then if (d.typ=objectdef) then
d:=find_real_class_definition(tobjectdef(d),false);
realself:=find_real_class_definition(self,false);
if realself=d then
begin begin
is_related:=true; is_related:=true;
exit; exit;
@ -5085,7 +5090,7 @@ implementation
inheritance } inheritance }
if (objecttype in [odt_objcprotocol,odt_interfacejava]) then if (objecttype in [odt_objcprotocol,odt_interfacejava]) then
begin begin
is_related:=is_related_interface_multiple(self,d); is_related:=is_related_interface_multiple(realself,d);
exit exit
end; end;
@ -5112,7 +5117,7 @@ implementation
exit; exit;
end; end;
hp:=childof; hp:=realself.childof;
while assigned(hp) do while assigned(hp) do
begin begin
if hp=d then if hp=d then