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

+ support for "final" fields in *external* (Java and other) classes, enabled

Browse Source 
via {$modeswitch finalfields} (on by default on the JVM target). The
    meaning is the same as in Java: a final (class) field can only be set
    in a (class) constructor of the class it's defined in, and can only be
    written once there (and *must* be set there). They are currently only
    supported for external classes since that basically turns them into
    constants, since for non-external classes we need full dataflow analysis
  o refactored pdecobj.parse_object_members() a bit in the process to reduce
    the amount of repetition (which would have been further increased for
    the support for final fields)
  o made error message about "wrong use of absolute" for fields etc generic,
    so it gives a proper error depending on which token was used (it had
    to be made generic for "final" support, but already was used for other
    things that were wrongly reported as "absolute" misusages)

git-svn-id: branches/jvmbackend@18398 -
This commit is contained in:
Jonas Maebe 2011-08-20 07:56:18 +00:00
parent 6b176351e1
commit 37b5c061e3
10 changed files with 528 additions and 408 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/globtype.pas
View File

@ -288,7 +288,10 @@ interface
m_nested_procvars, { support nested procedural variables }
m_non_local_goto, { support non local gotos (like iso pascal) }
m_advanced_records, { advanced record syntax with visibility sections, methods and properties }
m_isolike_unary_minus { unary minus like in iso pascal: same precedence level as binary minus/plus }
m_isolike_unary_minus, { unary minus like in iso pascal: same precedence level as binary minus/plus }
m_final_fields { allows declaring fields as "final", which means they must be initialised
in the (class) constructor and are constant from then on (same as final
fields in Java) }
);
tmodeswitches = set of tmodeswitch;
@ -440,7 +443,8 @@ interface
'NESTEDPROCVARS',
'NONLOCALGOTO',
'ADVANCEDRECORDS',
'ISOUNARYMINUS');
'ISOUNARYMINUS',
'FINALFIELDS');
type

45
compiler/htypechk.pas
View File

@ -983,6 +983,11 @@ implementation
if (tloadnode(p).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) then
begin
hsym:=tabstractvarsym(tloadnode(p).symtableentry);
{ this check requires proper data flow analysis... }
(* if (hsym.varspez=vs_final) and
(hsym.varstate in [vs_written,vs_readwritten]) and
(newstate in [vs_written,vs_readwritten]) then
CGMessagePos1(p.fileinfo,sym_e_final_write_once); *)
if (vsf_must_be_valid in varstateflags) and
(hsym.varstate in [vs_declared,vs_read_not_warned,vs_referred_not_inited]) then
begin
@ -1080,6 +1085,32 @@ implementation
todef : tdef;
errmsg,
temp : longint;
function constaccessok(vs: tabstractvarsym): boolean;
begin
result:=false;
{ allow p^:= constructions with p is const parameter }
if gotderef or gotdynarray or (Valid_Const in opts) or
(nf_isinternal_ignoreconst in hp.flags) then
result:=true
{ final (class) fields can only be initialised in the (class) constructors of
class in which they have been declared (not in descendent constructors) }
else if vs.varspez=vs_final then
begin
if (current_procinfo.procdef.owner=vs.owner) then
if sp_static in vs.symoptions then
result:=current_procinfo.procdef.proctypeoption=potype_class_constructor
else
result:=current_procinfo.procdef.proctypeoption=potype_constructor;
if not result and
report_errors then
CGMessagePos(hp.fileinfo,type_e_invalid_final_assignment);
end
else
if report_errors then
CGMessagePos(hp.fileinfo,type_e_no_assign_to_const);
end;
begin
if valid_const in opts then
errmsg:=type_e_variable_id_expected
@ -1316,6 +1347,10 @@ implementation
CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr);
exit;
end;
{ check for final fields }
if (tsubscriptnode(hp).vs.varspez=vs_final) and
not constaccessok(tsubscriptnode(hp).vs) then
exit;
gotsubscript:=true;
{ loop counter? }
if not(Valid_Const in opts) and
@ -1480,15 +1515,9 @@ implementation
exit;
end;
{ read-only variable? }
if (tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_const,vs_constref]) then
if (tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_const,vs_constref,vs_final]) then
begin
{ allow p^:= constructions with p is const parameter }
if gotderef or gotdynarray or (Valid_Const in opts) or
(nf_isinternal_ignoreconst in tloadnode(hp).flags) then
result:=true
else
if report_errors then
CGMessagePos(tloadnode(hp).fileinfo,type_e_no_assign_to_const);
result:=constaccessok(tabstractvarsym(tloadnode(hp).symtableentry));
exit;
end;
result:=true;

20
compiler/msg/errore.msg
View File

@ -375,7 +375,7 @@ scanner_e_illegal_alignment_directive=02088_E_Illegal alignment directive
#
# Parser
#
# 03310 is the last used one
# 03315 is the last used one
#
% \section{Parser messages}
% This section lists all parser messages. The parser takes care of the
@ -675,9 +675,10 @@ parser_e_mix_of_classes_and_objects=03093_E_The mix of different kind of objects
% a class cannot have an object as parent and vice versa.
parser_w_unknown_proc_directive_ignored=03094_W_Unknown procedure directive had to be ignored: "$1"
% The procedure directive you specified is unknown.
parser_e_absolute_only_one_var=03095_E_absolute can only be associated to one variable
% You cannot specify more than one variable before the \var{absolute} directive.
% Thus, the following construct will provide this error:
parser_e_directive_only_one_var=03095_E_$1 can be associated with only one variable
% You cannot specify more than one variable before the \var{absolute}, \var{export}, \var{external},
% \var{weakexternal}, \var{public} and \var{cvar} directives.
% As a result, for example the following construct will provide this error:
% \begin{verbatim}
% Var Z : Longint;
% X,Y : Longint absolute Z;
@ -1400,10 +1401,16 @@ parser_e_mapping_no_implements=03312_E_Interface "$1" can't be delegated by "$2"
% has to implement the interface directly. Delegation is not possible.
parser_e_implements_no_mapping=03313_E_Interface "$1" can't have method resolutions, "$2" already delegates it
% Method resoulution is only possible for interfaces that are implemented directly, not by delegation.
parser_e_final_only_const_var=03314_E_Only fields (var-sections) and constants can be final in object types
% A final (class) field must be assigned a single value in the (class) constructor, and cannot
% be overwritten afterwards. A final (typed) constant is read-only.
parser_e_final_only_external=03315_E_Final fields are currently only supported for external classes
% Support for final fields in non-external classes requires a full data flow
% analysis implementation in FPC, which it currently still lacks.
% \end{description}
# Type Checking
#
# 04103 is the last used one
# 04104 is the last used one
#
% \section{Type checking errors}
% This section lists all errors that can occur when type checking is
@ -1764,6 +1771,9 @@ type_e_record_helper_must_extend_same_record=04102_E_Derived record helper must
type_e_java_class_method_not_static=04103_E_Java class methods have to be static
% All methods in Java are either regular (virtual) methods, or static class
% methods. It is not possible to declare non-static class methods.
type_e_invalid_final_assignment=04104_E_Final (class) fields can only be assigned in their class' (class) constructor
% It is only possible to assign a value to a final (class) field inside a (class) constructor of its owning class.
%
%
% \end{description}
#

9
compiler/msgidx.inc
View File

@ -194,7 +194,7 @@ const
parser_f_unsupported_feature=03092;
parser_e_mix_of_classes_and_objects=03093;
parser_w_unknown_proc_directive_ignored=03094;
parser_e_absolute_only_one_var=03095;
parser_e_directive_only_one_var=03095;
parser_e_absolute_only_to_var_or_const=03096;
parser_e_initialized_only_one_var=03097;
parser_e_abstract_no_definition=03098;
@ -405,6 +405,8 @@ const
parser_e_duplicate_implements_clause=03311;
parser_e_mapping_no_implements=03312;
parser_e_implements_no_mapping=03313;
parser_e_final_only_const_var=03314;
parser_e_final_only_external=03315;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -499,6 +501,7 @@ const
type_e_class_helper_must_extend_subclass=04101;
type_e_record_helper_must_extend_same_record=04102;
type_e_java_class_method_not_static=04103;
type_e_invalid_final_assignment=04104;
sym_e_id_not_found=05000;
sym_f_internal_error_in_symtablestack=05001;
sym_e_duplicate_id=05002;
@ -901,9 +904,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 61050;
MsgTxtSize = 61281;
MsgIdxMax : array[1..20] of longint=(
26,89,314,104,85,54,111,23,202,63,
26,89,316,105,85,54,111,23,202,63,
49,20,1,1,1,1,1,1,1,1
);

615
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

12
compiler/pdecl.pas
View File

@ -290,7 +290,11 @@ implementation
{ generate an error }
consume(_EQ);
end;
until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
until (token<>_ID) or
(in_structure and
((idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]) or
((m_final_fields in current_settings.modeswitches) and
(idtoken=_FINAL))));
block_type:=old_block_type;
end;
@ -666,7 +670,11 @@ implementation
hdef.typesym:=newtype;
generictypelist.free;
end;
until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
until (token<>_ID) or
(in_structure and
((idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]) or
((m_final_fields in current_settings.modeswitches) and
(idtoken=_FINAL))));
{ resolve type block forward declarations and restore a unit
container for them }
resolve_forward_types;

197
compiler/pdecobj.pas
View File

@ -754,10 +754,81 @@ implementation
var
pd : tprocdef;
has_destructor,
oldparse_only: boolean;
oldparse_only,
typedconstswritable: boolean;
object_member_blocktype : tblock_type;
fields_allowed, is_classdef, classfields: boolean;
fields_allowed, is_classdef, class_fields, is_final, final_fields: boolean;
vdoptions: tvar_dec_options;
procedure parse_const;
begin
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
Message(parser_e_type_var_const_only_in_records_and_classes);
consume(_CONST);
object_member_blocktype:=bt_const;
final_fields:=is_final;
is_final:=false;
end;
procedure parse_var;
begin
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
Message(parser_e_type_var_const_only_in_records_and_classes);
consume(_VAR);
fields_allowed:=true;
object_member_blocktype:=bt_general;
class_fields:=is_classdef;
final_fields:=is_final;
is_classdef:=false;
is_final:=false;
end;
procedure parse_class;
begin
is_classdef:=false;
{ read class method/field/property }
consume(_CLASS);
{ class modifier is only allowed for procedures, functions, }
{ constructors, destructors, fields and properties }
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then
Message(parser_e_procedure_or_function_expected);
if is_interface(current_structdef) or
is_javainterface(current_structdef) then
Message(parser_e_no_static_method_in_interfaces)
else
{ class methods are also allowed for Objective-C protocols }
is_classdef:=true;
end;
procedure parse_visibility(vis: tvisibility; oo: tobjectoption);
begin
{ Objective-C and Java classes do not support "published",
as basically everything is published. }
if (vis=vis_published) and
(is_objc_class_or_protocol(current_structdef) or
is_java_class_or_interface(current_structdef)) then
Message(parser_e_no_objc_published)
else if is_interface(current_structdef) or
is_objc_protocol_or_category(current_structdef) or
is_javainterface(current_structdef) then
Message(parser_e_no_access_specifier_in_interfaces);
current_structdef.symtable.currentvisibility:=vis;
consume(token);
if (oo<>oo_none) then
include(current_structdef.objectoptions,oo);
fields_allowed:=true;
is_classdef:=false;
class_fields:=false;
is_final:=false;
object_member_blocktype:=bt_general;
end;
begin
{ empty class declaration ? }
if (current_objectdef.objecttype in [odt_class,odt_objcclass,odt_javaclass]) and
@ -772,7 +843,9 @@ implementation
has_destructor:=false;
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
class_fields:=false;
is_final:=false;
final_fields:=false;
object_member_blocktype:=bt_general;
repeat
case token of
@ -785,20 +858,11 @@ implementation
end;
_VAR :
begin
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
Message(parser_e_type_var_const_only_in_records_and_classes);
consume(_VAR);
fields_allowed:=true;
object_member_blocktype:=bt_general;
classfields:=is_classdef;
is_classdef:=false;
parse_var;
end;
_CONST:
begin
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper,odt_javaclass]) then
Message(parser_e_type_var_const_only_in_records_and_classes);
consume(_CONST);
object_member_blocktype:=bt_const;
parse_const
end;
_ID :
begin
@ -812,63 +876,19 @@ implementation
else case idtoken of
_PRIVATE :
begin
if is_interface(current_structdef) or
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;
include(current_structdef.objectoptions,oo_has_private);
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
object_member_blocktype:=bt_general;
parse_visibility(vis_private,oo_has_private);
end;
_PROTECTED :
begin
if is_interface(current_structdef) or
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;
include(current_structdef.objectoptions,oo_has_protected);
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
object_member_blocktype:=bt_general;
parse_visibility(vis_protected,oo_has_protected);
end;
_PUBLIC :
begin
if is_interface(current_structdef) or
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;
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
object_member_blocktype:=bt_general;
parse_visibility(vis_public,oo_none);
end;
_PUBLISHED :
begin
{ we've to check for a pushlished section in non- }
{ publishable classes later, if a real declaration }
{ this is the way, delphi does it }
if is_interface(current_structdef) then
Message(parser_e_no_access_specifier_in_interfaces);
{ Objective-C and Java classes do not support "published",
as basically everything is published. }
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;
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
object_member_blocktype:=bt_general;
parse_visibility(vis_published,oo_none);
end;
_STRICT :
begin
@ -900,9 +920,27 @@ implementation
message(parser_e_protected_or_private_expected);
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
class_fields:=false;
is_final:=false;
final_fields:=false;
object_member_blocktype:=bt_general;
end
else if (m_final_fields in current_settings.modeswitches) and
(token=_ID) and
(idtoken=_FINAL) then
begin
{ currently only supported for external classes, because
requires fully working DFA otherwise }
if (current_structdef.typ<>objectdef) or
not(oo_is_external in tobjectdef(current_structdef).objectoptions) then
Message(parser_e_final_only_external);
consume(_final);
is_final:=true;
if token=_CLASS then
parse_class;
if not(token in [_CONST,_VAR]) then
message(parser_e_final_only_const_var);
end
else
begin
if object_member_blocktype=bt_general then
@ -920,14 +958,28 @@ implementation
Message(parser_e_field_not_allowed_here);
vdoptions:=[vd_object];
if classfields then
if class_fields then
include(vdoptions,vd_class);
if final_fields then
include(vdoptions,vd_final);
read_record_fields(vdoptions);
end
else if object_member_blocktype=bt_type then
types_dec(true)
else if object_member_blocktype=bt_const then
consts_dec(true)
begin
if final_fields then
begin
{ the value of final fields cannot be changed
once they've been assigned a value }
typedconstswritable:=cs_typed_const_writable in current_settings.localswitches;
exclude(current_settings.localswitches,cs_typed_const_writable);
end;
consts_dec(true);
if final_fields and
typedconstswritable then
include(current_settings.localswitches,cs_typed_const_writable);
end
else
internalerror(201001110);
end;
@ -941,20 +993,7 @@ implementation
end;
_CLASS:
begin
is_classdef:=false;
{ read class method/field/property }
consume(_CLASS);
{ class modifier is only allowed for procedures, functions, }
{ constructors, destructors, fields and properties }
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then
Message(parser_e_procedure_or_function_expected);
if is_interface(current_structdef) or
is_javainterface(current_structdef) then
Message(parser_e_no_static_method_in_interfaces)
else
{ class methods are also allowed for Objective-C protocols }
is_classdef:=true;
parse_class;
end;
_PROCEDURE,
_FUNCTION:

23
compiler/pdecvar.pas
View File

@ -30,7 +30,7 @@ interface
symsym,symdef;
type
tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class);
tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class,vd_final);
tvar_dec_options=set of tvar_dec_option;
function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym;
@ -925,7 +925,7 @@ implementation
{ only allowed for one var }
vs:=tabstractvarsym(sc[0]);
if sc.count>1 then
Message(parser_e_absolute_only_one_var);
Message1(parser_e_directive_only_one_var,arraytokeninfo[idtoken].str);
read_public_and_external(vs);
end;
@ -1127,7 +1127,7 @@ implementation
C_Name:=get_stringconst;
vs:=tabstractnormalvarsym(sc[0]);
if sc.count>1 then
Message(parser_e_absolute_only_one_var);
Message(parser_e_directive_only_one_var,'ABSOLUTE');
if vs.typ=staticvarsym then
begin
tstaticvarsym(vs).set_mangledname(C_Name);
@ -1152,7 +1152,7 @@ implementation
{ only allowed for one var }
vs:=tabstractvarsym(sc[0]);
if sc.count>1 then
Message(parser_e_absolute_only_one_var);
Message1(parser_e_directive_only_one_var,'ABSOLUTE');
if vo_is_typed_const in vs.varoptions then
Message(parser_e_initialized_not_for_external);
{ parse the rest }
@ -1525,7 +1525,9 @@ implementation
while (token=_ID) and
not(((vd_object in options) or
((vd_record in options) and (m_advanced_records in current_settings.modeswitches))) and
(idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do
((idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT]) or
((m_final_fields in current_settings.modeswitches) and
(idtoken=_FINAL)))) do
begin
visibility:=symtablestack.top.currentvisibility;
semicoloneaten:=false;
@ -1688,12 +1690,23 @@ implementation
fieldvs.Rename(internal_static_field_name(fieldvs.name));
recst.insert(hstaticvs);
{$endif not jvm}
if vd_final in options then
hstaticvs.varspez:=vs_final;
{ generate the symbol for the access }
sl:=tpropaccesslist.create;
sl.addsym(sl_load,hstaticvs);
recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl));
end;
end;
if vd_final in options then
begin
{ add final flag }
for i:=0 to sc.count-1 do
begin
fieldvs:=tfieldvarsym(sc[i]);
fieldvs.varspez:=vs_final;
end;
end;
if (visibility=vis_published) and
not(is_class(hdef)) then
begin

5
compiler/scanner.pas
View File

@ -356,6 +356,11 @@ implementation
else
b:=false;
{$ifdef jvm}
{ enable final fields by default for the JVM targets }
include(current_settings.modeswitches,m_final_fields);
{$endif jvm}
if b and changeInit then
init_settings.modeswitches := current_settings.modeswitches;

2
compiler/symconst.pas
View File

@ -517,7 +517,7 @@ type
vs_referred_not_inited,vs_written,vs_readwritten
);
tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref);
tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref,vs_final);
absolutetyp = (tovar,toasm,toaddr);