paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 10:49:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

compiler: start parsing of record constructors and destructors:

Browse Source 
- disallow record destructor
  - raise internal error for constructor because it is not yet implemented
  - handle class constructors and destructors for records
  - move find_procdef_bytype to tabstractpointerdef

git-svn-id: branches/paul/extended_records@16544 -
This commit is contained in:
paul 2010-12-11 07:31:27 +00:00
parent 4e73e280f9
commit 7852295f26
6 changed files with 381 additions and 408 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/msg/errore.msg
View File

@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
#
# Parser
#
# 03298 is the last used one
# 03299 is the last used one
#
% \section{Parser messages}
% This section lists all parser messages. The parser takes care of the
@ -1342,8 +1342,10 @@ 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
parser_e_no_record_published=03298_E_Record types cannot have published sections
% Published sections can be used only inside classes.
parser_e_no_destructor_in_records=03299_E_Destructors aren't allowed in records
% Destructor declarations aren't allowed in records.
#
# Type Checking
#

5
compiler/msgidx.inc
View File

@ -387,6 +387,7 @@ const
parser_e_no_procvarnested_const=03296;
parser_f_no_generic_inside_generic=03297;
parser_e_no_record_published=03298;
parser_e_no_destructor_in_records=03299;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -872,9 +873,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 57958;
MsgTxtSize = 58003;
MsgIdxMax : array[1..20] of longint=(
24,88,299,97,82,54,111,22,202,63,
24,88,300,97,82,54,111,22,202,63,
49,20,1,1,1,1,1,1,1,1
);

635
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

34
compiler/pmodules.pas
View File

@ -376,13 +376,13 @@ implementation
ResourceStringTables.free;
end;
procedure AddToClasInits(p:TObject;arg:pointer);
procedure AddToStructInits(p:TObject;arg:pointer);
var
ClassList: TFPList absolute arg;
StructList: TFPList absolute arg;
begin
if (tdef(p).typ=objectdef) and
([oo_has_class_constructor,oo_has_class_destructor] * tobjectdef(p).objectoptions <> []) then
ClassList.Add(p);
if (tdef(p).typ in [objectdef,recorddef]) and
([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then
StructList.Add(p);
end;
procedure InsertInitFinalTable;
@ -391,32 +391,32 @@ implementation
unitinits : TAsmList;
count : longint;
procedure write_class_inits(u: tmodule);
procedure write_struct_inits(u: tmodule);
var
i: integer;
classlist: TFPList;
structlist: TFPList;
pd: tprocdef;
begin
classlist := TFPList.Create;
structlist := TFPList.Create;
if assigned(u.globalsymtable) then
u.globalsymtable.DefList.ForEachCall(@AddToClasInits,classlist);
u.localsymtable.DefList.ForEachCall(@AddToClasInits,classlist);
{ write classes }
for i := 0 to classlist.Count - 1 do
u.globalsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
u.localsymtable.DefList.ForEachCall(@AddToStructInits,structlist);
{ write structures }
for i := 0 to structlist.Count - 1 do
begin
pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_constructor);
pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_constructor);
if assigned(pd) then
unitinits.concat(Tai_const.Createname(pd.mangledname,0))
else
unitinits.concat(Tai_const.Create_pint(0));
pd := tobjectdef(classlist[i]).find_procdef_bytype(potype_class_destructor);
pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_destructor);
if assigned(pd) then
unitinits.concat(Tai_const.Createname(pd.mangledname,0))
else
unitinits.concat(Tai_const.Create_pint(0));
inc(count);
end;
classlist.free;
structlist.free;
end;
begin
@ -427,7 +427,7 @@ implementation
begin
{ insert class constructors/destructors of the unit }
if (hp.u.flags and uf_classinits) <> 0 then
write_class_inits(hp.u);
write_struct_inits(hp.u);
{ call the unit init code and make it external }
if (hp.u.flags and (uf_init or uf_finalize))<>0 then
begin
@ -445,7 +445,7 @@ implementation
end;
{ insert class constructors/destructor of the program }
if (current_module.flags and uf_classinits) <> 0 then
write_class_inits(current_module);
write_struct_inits(current_module);
{ Insert initialization/finalization of the program }
if (current_module.flags and (uf_init or uf_finalize))<>0 then
begin

67
compiler/ptype.pas
View File

@ -573,7 +573,6 @@ implementation
var
pd : tprocdef;
has_destructor,
oldparse_only: boolean;
member_blocktype : tblock_type;
fields_allowed, is_classdef, classfields: boolean;
@ -585,7 +584,6 @@ implementation
current_structdef.symtable.currentvisibility:=vis_public;
testcurobject:=1;
has_destructor:=false;
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
@ -617,6 +615,7 @@ implementation
begin
consume(_PRIVATE);
current_structdef.symtable.currentvisibility:=vis_private;
include(current_structdef.objectoptions,oo_has_private);
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
@ -626,6 +625,7 @@ implementation
begin
consume(_PROTECTED);
current_structdef.symtable.currentvisibility:=vis_protected;
include(current_structdef.objectoptions,oo_has_protected);
fields_allowed:=true;
is_classdef:=false;
classfields:=false;
@ -660,11 +660,13 @@ implementation
begin
consume(_PRIVATE);
current_structdef.symtable.currentvisibility:=vis_strictprivate;
include(current_structdef.objectoptions,oo_has_strictprivate);
end;
_PROTECTED:
begin
consume(_PROTECTED);
current_structdef.symtable.currentvisibility:=vis_strictprotected;
include(current_structdef.objectoptions,oo_has_strictprotected);
end;
else
message(parser_e_protected_or_private_expected);
@ -742,43 +744,31 @@ implementation
fields_allowed:=false;
is_classdef:=false;
end;
{ todo: constructor
_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
if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) 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^);
if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then
Message1(parser_e_only_one_class_constructor_allowed, current_structdef.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);
begin
pd:=constructor_head;
{ raise internal error for now - constructor is not implemented yet }
internalerror(201012110);
end;
parse_record_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;
@ -787,29 +777,12 @@ implementation
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);
Message(parser_e_no_destructor_in_records);
{ 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^);
if is_classdef and (oo_has_class_destructor in current_structdef.objectoptions) then
Message1(parser_e_only_one_class_destructor_allowed, current_structdef.objrealname^);
oldparse_only:=parse_only;
parse_only:=true;
@ -817,24 +790,18 @@ implementation
pd:=class_destructor_head
else
pd:=destructor_head;
parse_object_proc_directives(pd);
parse_record_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);

40
compiler/symdef.pas
View File

@ -168,6 +168,7 @@ interface
function GetTypeName:string;override;
end;
tprocdef = class;
{ tabstractrecorddef }
tabstractrecorddef= class(tstoreddef)
@ -181,6 +182,7 @@ interface
constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
destructor destroy; override;
function find_procdef_bytype(pt:tproctypeoption): tprocdef;
function GetSymtable(t:tGetSymtable):TSymtable;override;
function is_packed:boolean;
function RttiName: string;
@ -204,7 +206,6 @@ interface
function needs_inittable : boolean;override;
end;
tprocdef = class;
tobjectdef = class;
{ TImplementedInterface }
@ -306,7 +307,6 @@ interface
procedure check_forwards;
procedure insertvmt;
procedure set_parent(c : tobjectdef);
function find_procdef_bytype(pt:tproctypeoption): tprocdef;
function find_destructor: tprocdef;
function implements_any_interfaces: boolean;
{ dispinterface support }
@ -2589,6 +2589,24 @@ implementation
inherited destroy;
end;
function tabstractrecorddef.find_procdef_bytype(pt:tproctypeoption): tprocdef;
var
i: longint;
sym: tsym;
begin
for i:=0 to symtable.SymList.Count-1 do
begin
sym:=tsym(symtable.SymList[i]);
if sym.typ=procsym then
begin
result:=tprocsym(sym).find_procdef_bytype(pt);
if assigned(result) then
exit;
end;
end;
result:=nil;
end;
function tabstractrecorddef.GetSymtable(t:tGetSymtable):TSymtable;
begin
if t=gs_record then
@ -4528,24 +4546,6 @@ implementation
is_related:=false;
end;
function tobjectdef.find_procdef_bytype(pt:tproctypeoption): tprocdef;
var
i: longint;
sym: tsym;
begin
for i:=0 to symtable.SymList.Count-1 do
begin
sym:=tsym(symtable.SymList[i]);
if sym.typ=procsym then
begin
result:=tprocsym(sym).find_procdef_bytype(pt);
if assigned(result) then
exit;
end;
end;
result:=nil;
end;
function tobjectdef.find_destructor: tprocdef;
var
objdef: tobjectdef;