mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-11 19:09:27 +02:00
compiler: add support for visibility blocks in records and type, const declarations:
- add parse_record_members function to parse record blocks based on parse_object_members code - disable published section in records - rename in_class argument in some functions to in_structure because the same code can work for records now which are not classes git-svn-id: branches/paul/extended_records@16513 -
This commit is contained in:
paul
parent
9a6ae5ef6d
commit
8e36256bc9
@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
|
||||
#
|
||||
# Parser
|
||||
#
|
||||
# 03296 is the last used one
|
||||
# 03298 is the last used one
|
||||
#
|
||||
% \section{Parser messages}
|
||||
% This section lists all parser messages. The parser takes care of the
|
||||
@ -1342,6 +1342,8 @@ parser_f_no_generic_inside_generic=03297_F_Declaration of generic class inside a
|
||||
% Since generics are implemented by recording tokens, it is not possible to
|
||||
% have declaration of generic class inside another generic class.
|
||||
% \end{description}
|
||||
parser_e_no_record_published=03298_E_Record types cannot have published sections.
|
||||
% Published sections can be used only inside classes
|
||||
#
|
||||
# Type Checking
|
||||
#
|
||||
|
||||
@ -386,6 +386,7 @@ const
|
||||
parser_e_objc_missing_enumeration_defs=03295;
|
||||
parser_e_no_procvarnested_const=03296;
|
||||
parser_f_no_generic_inside_generic=03297;
|
||||
parser_e_no_record_published=03298;
|
||||
type_e_mismatch=04000;
|
||||
type_e_incompatible_types=04001;
|
||||
type_e_not_equal_types=04002;
|
||||
@ -871,9 +872,9 @@ const
|
||||
option_info=11024;
|
||||
option_help_pages=11025;
|
||||
|
||||
MsgTxtSize = 57905;
|
||||
MsgTxtSize = 57958;
|
||||
|
||||
MsgIdxMax : array[1..20] of longint=(
|
||||
24,88,298,97,82,54,111,22,202,63,
|
||||
24,88,299,97,82,54,111,22,202,63,
|
||||
49,20,1,1,1,1,1,1,1,1
|
||||
);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -36,10 +36,10 @@ interface
|
||||
function readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym;
|
||||
|
||||
procedure const_dec;
|
||||
procedure consts_dec(in_class: boolean);
|
||||
procedure consts_dec(in_structure: boolean);
|
||||
procedure label_dec;
|
||||
procedure type_dec;
|
||||
procedure types_dec(in_class: boolean);
|
||||
procedure types_dec(in_structure: boolean);
|
||||
procedure var_dec;
|
||||
procedure threadvar_dec;
|
||||
procedure property_dec(is_classpropery: boolean);
|
||||
@ -161,7 +161,7 @@ implementation
|
||||
consts_dec(false);
|
||||
end;
|
||||
|
||||
procedure consts_dec(in_class: boolean);
|
||||
procedure consts_dec(in_structure: boolean);
|
||||
var
|
||||
orgname : TIDString;
|
||||
hdef : tdef;
|
||||
@ -254,7 +254,7 @@ implementation
|
||||
tclist:=current_asmdata.asmlists[al_rotypedconsts]
|
||||
else
|
||||
tclist:=current_asmdata.asmlists[al_typedconsts];
|
||||
read_typed_const(tclist,tstaticvarsym(sym),in_class);
|
||||
read_typed_const(tclist,tstaticvarsym(sym),in_structure);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -262,7 +262,7 @@ implementation
|
||||
{ generate an error }
|
||||
consume(_EQUAL);
|
||||
end;
|
||||
until (token<>_ID)or(in_class and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
|
||||
until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
|
||||
block_type:=old_block_type;
|
||||
end;
|
||||
|
||||
@ -309,7 +309,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure types_dec(in_class: boolean);
|
||||
procedure types_dec(in_structure: boolean);
|
||||
|
||||
procedure get_cpp_class_external_status(od: tobjectdef);
|
||||
var
|
||||
@ -669,7 +669,7 @@ implementation
|
||||
end;
|
||||
if assigned(generictypelist) then
|
||||
generictypelist.free;
|
||||
until (token<>_ID)or(in_class and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
|
||||
until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT]));
|
||||
{ resolve type block forward declarations and restore a unit
|
||||
container for them }
|
||||
resolve_forward_types;
|
||||
|
||||
@ -1407,7 +1407,7 @@ implementation
|
||||
sc:=TFPObjectList.create(false);
|
||||
recstlist:=TFPObjectList.create(false);;
|
||||
while (token=_ID) and
|
||||
not((vd_object in options) and
|
||||
not(([vd_object,vd_record]*options<>[]) and
|
||||
(idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do
|
||||
begin
|
||||
visibility:=symtablestack.top.currentvisibility;
|
||||
|
||||
@ -27,7 +27,7 @@ interface
|
||||
|
||||
uses symtype,symsym,aasmdata;
|
||||
|
||||
procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
|
||||
procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_structure:boolean);
|
||||
|
||||
|
||||
implementation
|
||||
@ -1429,7 +1429,7 @@ implementation
|
||||
|
||||
{$maxfpuregisters default}
|
||||
|
||||
procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_class:boolean);
|
||||
procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_structure:boolean);
|
||||
var
|
||||
storefilepos : tfileposinfo;
|
||||
cursectype : TAsmSectionType;
|
||||
@ -1461,7 +1461,7 @@ implementation
|
||||
consume(_SEMICOLON);
|
||||
|
||||
{ parse public/external/export/... }
|
||||
if not in_class and
|
||||
if not in_structure and
|
||||
(
|
||||
(
|
||||
(token = _ID) and
|
||||
|
||||
@ -72,7 +72,7 @@ implementation
|
||||
nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,
|
||||
{ parser }
|
||||
scanner,
|
||||
pbase,pexpr,pdecsub,pdecvar,pdecobj;
|
||||
pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl;
|
||||
|
||||
|
||||
procedure resolve_forward_types;
|
||||
@ -551,6 +551,325 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure parse_record_members(recorddef: trecorddef);
|
||||
|
||||
procedure maybe_parse_hint_directives(pd:tprocdef);
|
||||
var
|
||||
dummysymoptions : tsymoptions;
|
||||
deprecatedmsg : pshortstring;
|
||||
begin
|
||||
dummysymoptions:=[];
|
||||
deprecatedmsg:=nil;
|
||||
while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do
|
||||
Consume(_SEMICOLON);
|
||||
if assigned(pd) then
|
||||
begin
|
||||
pd.symoptions:=pd.symoptions+dummysymoptions;
|
||||
pd.deprecatedmsg:=deprecatedmsg;
|
||||
end
|
||||
else
|
||||
stringdispose(deprecatedmsg);
|
||||
end;
|
||||
|
||||
var
|
||||
pd : tprocdef;
|
||||
has_destructor,
|
||||
oldparse_only: boolean;
|
||||
member_blocktype : tblock_type;
|
||||
fields_allowed, is_classdef, classfields: boolean;
|
||||
vdoptions: tvar_dec_options;
|
||||
begin
|
||||
{ empty record declaration ? }
|
||||
if (token=_SEMICOLON) then
|
||||
Exit;
|
||||
|
||||
recorddef.symtable.currentvisibility:=vis_public;
|
||||
has_destructor:=false;
|
||||
fields_allowed:=true;
|
||||
is_classdef:=false;
|
||||
classfields:=false;
|
||||
member_blocktype:=bt_general;
|
||||
repeat
|
||||
case token of
|
||||
_TYPE :
|
||||
begin
|
||||
consume(_TYPE);
|
||||
member_blocktype:=bt_type;
|
||||
end;
|
||||
_VAR :
|
||||
begin
|
||||
consume(_VAR);
|
||||
fields_allowed:=true;
|
||||
member_blocktype:=bt_general;
|
||||
classfields:=is_classdef;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
_CONST:
|
||||
begin
|
||||
consume(_CONST);
|
||||
member_blocktype:=bt_const;
|
||||
end;
|
||||
_ID, _CASE :
|
||||
begin
|
||||
case idtoken of
|
||||
_PRIVATE :
|
||||
begin
|
||||
consume(_PRIVATE);
|
||||
recorddef.symtable.currentvisibility:=vis_private;
|
||||
fields_allowed:=true;
|
||||
is_classdef:=false;
|
||||
classfields:=false;
|
||||
member_blocktype:=bt_general;
|
||||
end;
|
||||
_PROTECTED :
|
||||
begin
|
||||
consume(_PROTECTED);
|
||||
recorddef.symtable.currentvisibility:=vis_protected;
|
||||
fields_allowed:=true;
|
||||
is_classdef:=false;
|
||||
classfields:=false;
|
||||
member_blocktype:=bt_general;
|
||||
end;
|
||||
_PUBLIC :
|
||||
begin
|
||||
consume(_PUBLIC);
|
||||
recorddef.symtable.currentvisibility:=vis_public;
|
||||
fields_allowed:=true;
|
||||
is_classdef:=false;
|
||||
classfields:=false;
|
||||
member_blocktype:=bt_general;
|
||||
end;
|
||||
_PUBLISHED :
|
||||
begin
|
||||
Message(parser_e_no_record_published);
|
||||
consume(_PUBLISHED);
|
||||
recorddef.symtable.currentvisibility:=vis_published;
|
||||
fields_allowed:=true;
|
||||
is_classdef:=false;
|
||||
classfields:=false;
|
||||
member_blocktype:=bt_general;
|
||||
end;
|
||||
_STRICT :
|
||||
begin
|
||||
consume(_STRICT);
|
||||
if token=_ID then
|
||||
begin
|
||||
case idtoken of
|
||||
_PRIVATE:
|
||||
begin
|
||||
consume(_PRIVATE);
|
||||
recorddef.symtable.currentvisibility:=vis_strictprivate;
|
||||
end;
|
||||
_PROTECTED:
|
||||
begin
|
||||
consume(_PROTECTED);
|
||||
recorddef.symtable.currentvisibility:=vis_strictprotected;
|
||||
end;
|
||||
else
|
||||
message(parser_e_protected_or_private_expected);
|
||||
end;
|
||||
end
|
||||
else
|
||||
message(parser_e_protected_or_private_expected);
|
||||
fields_allowed:=true;
|
||||
is_classdef:=false;
|
||||
classfields:=false;
|
||||
member_blocktype:=bt_general;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if member_blocktype=bt_general then
|
||||
begin
|
||||
if (not fields_allowed) then
|
||||
Message(parser_e_field_not_allowed_here);
|
||||
vdoptions:=[vd_record];
|
||||
if classfields then
|
||||
include(vdoptions,vd_class);
|
||||
read_record_fields(vdoptions);
|
||||
end
|
||||
else if member_blocktype=bt_type then
|
||||
types_dec(true)
|
||||
else if member_blocktype=bt_const then
|
||||
consts_dec(true)
|
||||
else
|
||||
internalerror(201001110);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
_PROPERTY :
|
||||
begin
|
||||
property_dec(is_classdef);
|
||||
fields_allowed:=false;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
_CLASS:
|
||||
begin
|
||||
is_classdef:=false;
|
||||
{ read class method }
|
||||
if try_to_consume(_CLASS) then
|
||||
begin
|
||||
{ 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);
|
||||
|
||||
is_classdef:=true;
|
||||
end;
|
||||
end;
|
||||
{ todo: record methods
|
||||
_PROCEDURE,
|
||||
_FUNCTION:
|
||||
begin
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
pd:=parse_proc_dec(is_classdef, recorddef);
|
||||
|
||||
{ this is for error recovery as well as forward }
|
||||
{ interface mappings, i.e. mapping to a method }
|
||||
{ which isn't declared yet }
|
||||
if assigned(pd) then
|
||||
begin
|
||||
parse_object_proc_directives(pd);
|
||||
|
||||
{ check if dispid is set }
|
||||
if is_dispinterface(pd._class) and not (po_dispid in pd.procoptions) then
|
||||
begin
|
||||
pd.dispid:=pd._class.get_next_dispid;
|
||||
include(pd.procoptions, po_dispid);
|
||||
end;
|
||||
|
||||
{ all Macintosh Object Pascal methods are virtual. }
|
||||
{ this can't be a class method, because macpas mode }
|
||||
{ has no m_class }
|
||||
if (m_mac in current_settings.modeswitches) then
|
||||
include(pd.procoptions,po_virtualmethod);
|
||||
|
||||
handle_calling_convention(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_msgint in pd.procoptions) then
|
||||
include(current_objectdef.objectoptions,oo_has_msgint);
|
||||
if (po_msgstr in pd.procoptions) then
|
||||
include(current_objectdef.objectoptions,oo_has_msgstr);
|
||||
if (po_virtualmethod in pd.procoptions) then
|
||||
include(current_objectdef.objectoptions,oo_has_virtual);
|
||||
|
||||
chkcpp(pd);
|
||||
chkobjc(pd);
|
||||
end;
|
||||
|
||||
maybe_parse_hint_directives(pd);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
fields_allowed:=false;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
_CONSTRUCTOR :
|
||||
begin
|
||||
if (current_objectdef.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in current_objectdef.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
if not is_classdef and not(current_objectdef.symtable.currentvisibility in [vis_public,vis_published]) then
|
||||
Message(parser_w_constructor_should_be_public);
|
||||
|
||||
if is_interface(current_objectdef) then
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
{ Objective-C does not know the concept of a constructor }
|
||||
if is_objc_class_or_protocol(current_objectdef) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
{ only 1 class constructor is allowed }
|
||||
if is_classdef and (oo_has_class_constructor in current_objectdef.objectoptions) then
|
||||
Message1(parser_e_only_one_class_constructor_allowed, current_objectdef.objrealname^);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
if is_classdef then
|
||||
pd:=class_constructor_head
|
||||
else
|
||||
pd:=constructor_head;
|
||||
parse_object_proc_directives(pd);
|
||||
handle_calling_convention(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_virtualmethod in pd.procoptions) then
|
||||
include(current_objectdef.objectoptions,oo_has_virtual);
|
||||
chkcpp(pd);
|
||||
maybe_parse_hint_directives(pd);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
fields_allowed:=false;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
_DESTRUCTOR :
|
||||
begin
|
||||
if (current_objectdef.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in current_objectdef.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
if not is_classdef then
|
||||
if has_destructor then
|
||||
Message(parser_n_only_one_destructor)
|
||||
else
|
||||
has_destructor:=true;
|
||||
|
||||
if is_interface(current_objectdef) then
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
if not is_classdef and (current_objectdef.symtable.currentvisibility<>vis_public) then
|
||||
Message(parser_w_destructor_should_be_public);
|
||||
|
||||
{ Objective-C does not know the concept of a destructor }
|
||||
if is_objc_class_or_protocol(current_objectdef) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
{ only 1 class destructor is allowed }
|
||||
if is_classdef and (oo_has_class_destructor in current_objectdef.objectoptions) then
|
||||
Message1(parser_e_only_one_class_destructor_allowed, current_objectdef.objrealname^);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
if is_classdef then
|
||||
pd:=class_destructor_head
|
||||
else
|
||||
pd:=destructor_head;
|
||||
parse_object_proc_directives(pd);
|
||||
handle_calling_convention(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_virtualmethod in pd.procoptions) then
|
||||
include(current_objectdef.objectoptions,oo_has_virtual);
|
||||
|
||||
chkcpp(pd);
|
||||
maybe_parse_hint_directives(pd);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
fields_allowed:=false;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
}
|
||||
_END :
|
||||
begin
|
||||
consume(_END);
|
||||
break;
|
||||
end;
|
||||
else
|
||||
consume(_ID); { Give a ident expected message, like tp7 }
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
{ reads a record declaration }
|
||||
function record_dec : tdef;
|
||||
var
|
||||
@ -558,13 +877,12 @@ implementation
|
||||
begin
|
||||
{ create recdef }
|
||||
recst:=trecordsymtable.create(current_settings.packrecords);
|
||||
record_dec:=trecorddef.create(recst);
|
||||
result:=trecorddef.create(recst);
|
||||
{ insert in symtablestack }
|
||||
symtablestack.push(recst);
|
||||
{ parse record }
|
||||
consume(_RECORD);
|
||||
read_record_fields([vd_record]);
|
||||
consume(_END);
|
||||
parse_record_members(trecorddef(result));
|
||||
{ make the record size aligned }
|
||||
recst.addalignmentpadding;
|
||||
{ restore symtable stack }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user