paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 10:48:12 +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);
var
superclass,
intf: tobjectdef;
n: string;
i: longint;
begin
{ JVM 1.5+ }
AsmWriteLn('.bytecode 49.0');
@ -399,6 +402,8 @@ implementation
else
n:=InputFileName;
AsmWriteLn('.source '+ExtractFileName(n));
{ class/interface name }
if not assigned(obj) then
begin
{ fake class type for unit -> name=unitname and
@ -408,13 +413,41 @@ implementation
end
else
begin
AsmWriteLn('.class '+obj.objextname^);
if assigned(obj.childof) then
case obj.objecttype of
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
AsmWrite('.super ');
if assigned(obj.childof.import_lib) then
AsmWrite(obj.childof.import_lib^+'/');
AsmWriteln(obj.childof.objextname^);
if assigned(superclass.import_lib) then
AsmWrite(superclass.import_lib^+'/');
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;
AsmLn;
@ -492,6 +525,17 @@ implementation
procedure TJasminAssembler.WriteProcDef(pd: tprocdef);
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);
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
% This error indicates the use of Objective-C language features without an Objective-C mode switch
% active. Enable one via the -M command line switch, or the {\$modeswitch x} directive.
parser_e_must_use_override_objc=03273_E_Inherited methods can only be overridden in Objective-C, 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).
% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same
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=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 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,
% 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
% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language),
% Objective-C or Java methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C and Java
% 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.
% 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.
% 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
@ -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).
% Since generics are implemented by recording tokens, it is not possible to
% 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
% An objcprotocol must be fully defined before classes can conform to it.
% This error occurs in the following situation:
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 Objective-C protocol or Java Interface must be fully defined before classes can conform to it.
% This error occurs in the following situation (example for Objective-C, but the same goes for Java interfaces):
% \begin{verbatim}
% Type MyProtocol = objcprotoocl;
% ChildClass = Class(NSObject,MyProtocol)

8
compiler/msgidx.inc
View File

@ -364,8 +364,8 @@ const
parser_h_no_objc_parent=03270;
parser_e_no_objc_published=03271;
parser_f_need_objc=03272;
parser_e_must_use_override_objc=03273;
parser_h_should_use_override_objc=03274;
parser_e_must_use_override=03273;
parser_h_should_use_override=03274;
parser_e_objc_message_name_changed=03275;
parser_e_unique_unsupported=03276;
parser_e_no_category_as_types=03277;
@ -389,7 +389,7 @@ const
parser_e_objc_missing_enumeration_defs=03295;
parser_e_no_procvarnested_const=03296;
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_destructor_in_records=03300;
parser_e_class_methods_only_static_in_records=03301;
@ -900,7 +900,7 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 60995;
MsgTxtSize = 61005;
MsgIdxMax : array[1..20] of longint=(
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
(
{ new one does not have reintroduce in case of an objccategory }
(is_objccategory(_class) and not(po_reintroduce in pd.procoptions)) or
{ new one does not have override in case of objpas/objc class/helper/intf/proto }
(
(is_class_or_interface_or_objc(_class) or is_objectpascal_helper(_class)) and
not is_objccategory(_class) and not(po_overridingmethod in pd.procoptions)
(is_objccategory(_class) and
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
not is_objccategory(_class) and
not is_java_class_or_interface(_class) and
not(po_overridingmethod in pd.procoptions)
)
)
) then
@ -296,7 +298,8 @@ implementation
) then
begin
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))
else
begin
@ -308,10 +311,12 @@ implementation
In case of external classes, we only give a hint,
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 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
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
@ -319,7 +324,7 @@ implementation
the hint will be shown }
else if CheckVerbosity(V_Hint) 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
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
@ -397,11 +402,12 @@ implementation
if not(po_reintroduce in pd.procoptions) then
begin
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))
else
{ 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));
end;
{ disable/hide old VMT entry }
@ -771,7 +777,8 @@ implementation
end;
build_interface_mappings;
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
{ Optimize interface tables to reuse wrappers }
intf_optimize_vtbls;
@ -788,9 +795,11 @@ implementation
ImplIntf : TImplementedInterface;
i: longint;
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
(_class.objecttype<>odt_objcprotocol) then
not(_class.objecttype in [odt_objcprotocol,odt_interfacejava]) then
begin
{ Collect implementor functions into the tImplementedInterface.procdefs }
case _class.objecttype of
@ -802,11 +811,13 @@ implementation
intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef)
end;
end;
odt_objcclass:
odt_objcclass,
odt_javaclass:
begin
{ Object Pascal interfaces are afterwards optimized via the
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);
for i:=0 to _class.ImplementedInterfaces.count-1 do
begin

35
compiler/pdecobj.pas
View File

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

15
compiler/symdef.pas
View File

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