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

compiler: start implementation of class constructors/destructors: parsing is ready but at the moment neither class constructors nor destructors are called - this is to be implemented

Browse Source 
git-svn-id: trunk@15109 -
This commit is contained in:
paul 2010-04-03 09:14:12 +00:00
parent e20f907b5c
commit 24d8a7d833
14 changed files with 411 additions and 265 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/msg/errore.msg
View File

@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
#
# Parser
#
# 03287 is the last used one
# 03291 is the last used one
#
% \section{Parser messages}
% This section lists all parser messages. The parser takes care of the
@ -1296,6 +1296,16 @@ parser_e_string_const_too_long=03286_E_String constant too long while ansistring
parser_e_invalid_univ_para=03287_E_Type cannot be used as univ parameter because its size is unknown at compile time: "$1"
% \var{univ} parameters are compatible with all values of the same size, but this
% cannot be checked in case a parameter's size is unknown at compile time.
parser_e_only_one_class_constructor_allowed=03288_E_Only one class constructor can be declared in class: "$1"
% You are trying to declare more than one class constructor but only one class constructor can be declared.
parser_e_only_one_class_destructor_allowed=03289_E_Only one class destructor can be declared in class: "$1"
% You are trying to declare more than one class destructor but only one class destructor can be declared.
parser_e_no_paras_for_class_constructor=03290_E_Class constructors can't have parameters
% You are declaring a class constructor with a parameter list. Class constructor methods
% cannot have parameters.
parser_e_no_paras_for_class_destructor=03291_E_Class destructors can't have parameters
% You are declaring a class destructor with a parameter list. Class destructor methods
% cannot have parameters.
% \end{description}
#
# Type Checking

8
compiler/msgidx.inc
View File

@ -376,6 +376,10 @@ const
parser_e_more_array_elements_expected=03285;
parser_e_string_const_too_long=03286;
parser_e_invalid_univ_para=03287;
parser_e_only_one_class_constructor_allowed=03288;
parser_e_only_one_class_destructor_allowed=03289;
parser_e_no_paras_for_class_constructor=03290;
parser_e_no_paras_for_class_destructor=03291;
type_e_mismatch=04000;
type_e_incompatible_types=04001;
type_e_not_equal_types=04002;
@ -854,9 +858,9 @@ const
option_info=11024;
option_help_pages=11025;
MsgTxtSize = 56081;
MsgTxtSize = 56309;
MsgIdxMax : array[1..20] of longint=(
24,88,288,96,80,51,110,22,202,63,
24,88,292,96,80,51,110,22,202,63,
49,20,1,1,1,1,1,1,1,1
);

383
compiler/msgtxt.inc
View File

File diff suppressed because it is too large Load Diff

2
compiler/ncal.pas
View File

@ -2890,7 +2890,7 @@ implementation
{ When this is method the methodpointer must be available }
if (right=nil) and
(procdefinition.owner.symtabletype=ObjectSymtable) and
not([po_staticmethod,po_classmethod] <= procdefinition.procoptions) then
not procdefinition.no_self_node then
internalerror(200305061);
end;

2
compiler/ncgrtti.pas
View File

@ -705,6 +705,8 @@ implementation
case def.proctypeoption of
potype_constructor: methodkind:=mkConstructor;
potype_destructor: methodkind:=mkDestructor;
potype_class_constructor: methodkind:=mkClassConstructor;
potype_class_destructor: methodkind:=mkClassDestructor;
potype_procedure:
if po_classmethod in def.procoptions then
methodkind:=mkClassProcedure

83
compiler/pdecobj.pas
View File

@ -50,6 +50,29 @@ implementation
current_procinfo = 'error';
function class_constructor_head:tprocdef;
var
pd : tprocdef;
begin
result:=nil;
consume(_CONSTRUCTOR);
{ must be at same level as in implementation }
parse_proc_head(current_objectdef,potype_class_constructor,pd);
if not assigned(pd) then
begin
consume(_SEMICOLON);
exit;
end;
pd.calcparas;
if (pd.maxparacount>0) then
Message(parser_e_no_paras_for_class_constructor);
consume(_SEMICOLON);
include(current_objectdef.objectoptions,oo_has_class_constructor);
{ no return value }
pd.returndef:=voidtype;
result:=pd;
end;
function constructor_head:tprocdef;
var
pd : tprocdef;
@ -140,6 +163,28 @@ implementation
end;
function class_destructor_head:tprocdef;
var
pd : tprocdef;
begin
result:=nil;
consume(_DESTRUCTOR);
parse_proc_head(current_objectdef,potype_class_destructor,pd);
if not assigned(pd) then
begin
consume(_SEMICOLON);
exit;
end;
pd.calcparas;
if (pd.maxparacount>0) then
Message(parser_e_no_paras_for_class_destructor);
consume(_SEMICOLON);
include(current_objectdef.objectoptions,oo_has_class_destructor);
{ no return value }
pd.returndef:=voidtype;
result:=pd;
end;
function destructor_head:tprocdef;
var
pd : tprocdef;
@ -155,6 +200,7 @@ implementation
if (cs_constructor_name in current_settings.globalswitches) and
(pd.procsym.name<>'DONE') then
Message(parser_e_destructorname_must_be_done);
pd.calcparas;
if not(pd.maxparacount=0) and
(m_fpc in current_settings.modeswitches) then
Message(parser_e_no_paras_for_destructor);
@ -702,8 +748,9 @@ implementation
{ read class method }
if try_to_consume(_CLASS) then
begin
{ class method only allowed for procedures and functions }
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR]) then
{ 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_objectdef) then
@ -773,7 +820,7 @@ implementation
not(oo_can_have_published in current_objectdef.objectoptions) then
Message(parser_e_cant_have_published);
if not(current_objectdef.symtable.currentvisibility in [vis_public,vis_published]) then
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
@ -783,9 +830,16 @@ implementation
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;
pd:=constructor_head;
if is_classdef then
pd:=class_constructor_head
else
pd:=constructor_head;
parse_object_proc_directives(pd);
handle_calling_convention(pd);
@ -800,6 +854,7 @@ implementation
parse_only:=oldparse_only;
fields_allowed:=false;
is_classdef:=false;
end;
_DESTRUCTOR :
begin
@ -807,23 +862,32 @@ implementation
not(oo_can_have_published in current_objectdef.objectoptions) then
Message(parser_e_cant_have_published);
if has_destructor then
Message(parser_n_only_one_destructor);
has_destructor:=true;
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 (current_objectdef.symtable.currentvisibility<>vis_public) then
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;
pd:=destructor_head;
if is_classdef then
pd:=class_destructor_head
else
pd:=destructor_head;
parse_object_proc_directives(pd);
handle_calling_convention(pd);
@ -839,6 +903,7 @@ implementation
parse_only:=oldparse_only;
fields_allowed:=false;
is_classdef:=false;
end;
_END :
begin

93
compiler/pdecsub.pas
View File

@ -202,8 +202,7 @@ implementation
(pd.parast.symtablelevel=normal_function_level) then
begin
{ static class methods have no hidden self/vmt pointer }
if (po_staticmethod in pd.procoptions) and
(po_classmethod in pd.procoptions) then
if pd.no_self_node then
exit;
storepos:=current_tokenpos;
@ -722,7 +721,7 @@ implementation
pd:=nil;
aprocsym:=nil;
if (potype=potype_operator) then
if potype=potype_operator then
begin
sp:=overloaded_names[optoken];
orgsp:=sp;
@ -800,6 +799,8 @@ implementation
(ttypesym(srsym).typedef.typ=objectdef) then
begin
aclass:=tobjectdef(ttypesym(srsym).typedef);
if (token<>_POINT) and (potype in [potype_class_constructor,potype_class_destructor]) then
sp := lower(sp);
srsym:=tsym(aclass.symtable.Find(sp));
if assigned(srsym) then
begin
@ -839,7 +840,8 @@ implementation
begin
{ check for constructor/destructor which is not allowed here }
if (not parse_only) and
(potype in [potype_constructor,potype_destructor]) then
(potype in [potype_constructor,potype_destructor,
potype_class_constructor,potype_class_destructor]) then
Message(parser_e_constructors_always_objects);
repeat
@ -897,13 +899,16 @@ implementation
operation }
if (potype=potype_operator) then
begin
Aprocsym:=Tprocsym(symtablestack.top.Find(sp));
if Aprocsym=nil then
Aprocsym:=tprocsym.create('$'+sp);
aprocsym:=Tprocsym(symtablestack.top.Find(sp));
if aprocsym=nil then
aprocsym:=tprocsym.create('$'+sp);
end
else
else
if (potype in [potype_class_constructor,potype_class_destructor]) then
aprocsym:=tprocsym.create('$'+lower(sp))
else
aprocsym:=tprocsym.create(orgsp);
symtablestack.top.insert(aprocsym);
symtablestack.top.insert(aprocsym);
end;
{ to get the correct symtablelevel we must ignore ObjectSymtables }
@ -1105,8 +1110,12 @@ implementation
_CONSTRUCTOR :
begin
consume(_CONSTRUCTOR);
parse_proc_head(aclass,potype_constructor,pd);
if assigned(pd) and
if isclassmethod then
parse_proc_head(aclass,potype_class_constructor,pd)
else
parse_proc_head(aclass,potype_constructor,pd);
if not isclassmethod and
assigned(pd) and
assigned(pd._class) then
begin
{ Set return type, class constructors return the
@ -1119,13 +1128,18 @@ implementation
{$else CPU64bitaddr}
pd.returndef:=bool32type;
{$endif CPU64bitaddr}
end;
end
else
pd.returndef:=voidtype;
end;
_DESTRUCTOR :
begin
consume(_DESTRUCTOR);
parse_proc_head(aclass,potype_destructor,pd);
if isclassmethod then
parse_proc_head(aclass,potype_class_destructor,pd)
else
parse_proc_head(aclass,potype_destructor,pd);
if assigned(pd) then
pd.returndef:=voidtype;
end;
@ -1849,7 +1863,7 @@ const
pocall : pocall_cdecl;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_assembler,po_external]
),(
idtok:_CDECL;
@ -1858,7 +1872,7 @@ const
pocall : pocall_cdecl;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_assembler,po_external]
),(
idtok:_DISPID;
@ -1867,7 +1881,7 @@ const
pocall : pocall_none;
pooption : [po_dispid];
mutexclpocall : [pocall_internproc];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_interrupt,po_external,po_inline]
),(
idtok:_DYNAMIC;
@ -1876,7 +1890,7 @@ const
pocall : pocall_none;
pooption : [po_virtualmethod];
mutexclpocall : [pocall_internproc];
mutexclpotype : [];
mutexclpotype : [potype_class_constructor,potype_class_destructor];
mutexclpo : [po_exports,po_interrupt,po_external,po_overridingmethod,po_inline]
),(
idtok:_EXPORT;
@ -1885,7 +1899,7 @@ const
pocall : pocall_none;
pooption : [po_exports,po_global];
mutexclpocall : [pocall_internproc];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external,po_interrupt,po_inline]
),(
idtok:_EXTERNAL;
@ -1895,7 +1909,7 @@ const
pooption : [po_external];
mutexclpocall : [pocall_internproc,pocall_syscall];
{ allowed for external cpp classes }
mutexclpotype : [{potype_constructor,potype_destructor}];
mutexclpotype : [{potype_constructor,potype_destructor}potype_class_constructor,potype_class_destructor];
mutexclpo : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
),(
idtok:_FAR;
@ -1949,7 +1963,7 @@ const
pocall : pocall_none;
pooption : [po_inline];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_exports,po_external,po_interrupt,po_virtualmethod]
),(
idtok:_INTERNCONST;
@ -1967,7 +1981,7 @@ const
pocall : pocall_internproc;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_virtualmethod]
),(
idtok:_INTERRUPT;
@ -1977,7 +1991,7 @@ const
pooption : [po_interrupt];
mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,pocall_stdcall,
pocall_pascal,pocall_far16,pocall_oldfpccall];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external,po_inline]
),(
idtok:_IOCHECK;
@ -2004,7 +2018,7 @@ const
pocall : pocall_none;
pooption : []; { can be po_msgstr or po_msgint }
mutexclpocall : [pocall_internproc];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_interrupt,po_external,po_inline]
),(
idtok:_MWPASCAL;
@ -2058,7 +2072,7 @@ const
pocall : pocall_pascal;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external]
),(
idtok:_PUBLIC;
@ -2076,7 +2090,7 @@ const
pocall : pocall_register;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external]
),(
idtok:_REINTRODUCE;
@ -2094,7 +2108,7 @@ const
pocall : pocall_safecall;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external]
),(
idtok:_SOFTFLOAT;
@ -2103,7 +2117,7 @@ const
pocall : pocall_softfloat;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
{ it's available with po_external because the libgcc floating point routines on the arm
uses this calling convention }
mutexclpo : []
@ -2114,7 +2128,7 @@ const
pocall : pocall_none;
pooption : [po_staticmethod];
mutexclpocall : [pocall_internproc];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external,po_interrupt,po_exports]
),(
idtok:_STDCALL;
@ -2123,7 +2137,7 @@ const
pocall : pocall_stdcall;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external]
),(
idtok:_SYSCALL;
@ -2135,7 +2149,7 @@ const
pocall : pocall_syscall;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external,po_assembler,po_interrupt,po_exports]
),(
idtok:_VIRTUAL;
@ -2144,7 +2158,7 @@ const
pocall : pocall_none;
pooption : [po_virtualmethod];
mutexclpocall : [pocall_internproc];
mutexclpotype : [];
mutexclpotype : [potype_class_constructor,potype_class_destructor];
mutexclpo : [po_external,po_interrupt,po_exports,po_overridingmethod,po_inline]
),(
idtok:_CPPDECL;
@ -2153,7 +2167,7 @@ const
pocall : pocall_cppdecl;
pooption : [];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_assembler,po_external,po_virtualmethod]
),(
idtok:_VARARGS;
@ -2172,7 +2186,7 @@ const
pocall : pocall_none;
pooption : [po_compilerproc];
mutexclpocall : [];
mutexclpotype : [potype_constructor,potype_destructor];
mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor];
mutexclpo : [po_interrupt]
),(
idtok:_WEAKEXTERNAL;
@ -2185,7 +2199,7 @@ const
pooption : [po_external,po_weakexternal];
mutexclpocall : [pocall_internproc,pocall_syscall];
{ allowed for external cpp classes }
mutexclpotype : [{potype_constructor,potype_destructor}];
mutexclpotype : [{potype_constructor,potype_destructor}potype_class_constructor,potype_class_destructor];
mutexclpo : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
),(
idtok:_ENUMERATOR;
@ -2639,6 +2653,17 @@ const
include(pd.procoptions,po_global);
end;
{ Class constructors and destructor are static class methods in real. }
{ There are many places in the compiler where either class or static }
{ method flag changes the behavior. It is simplier to add them to }
{ the class constructors/destructors options than to fix all the }
{ occurencies. (Paul) }
if pd.proctypeoption in [potype_class_constructor,potype_class_destructor] then
begin
include(pd.procoptions,po_classmethod);
include(pd.procoptions,po_staticmethod);
end;
while token in [_ID,_LECKKLAMMER] do
begin
if try_to_consume(_LECKKLAMMER) then

2
compiler/pdecvar.pas
View File

@ -492,7 +492,7 @@ implementation
p.propaccesslist[palt_read].procdef:=Tprocsym(sym).Find_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]);
if not assigned(p.propaccesslist[palt_read].procdef) or
{ because of cpo_ignorehidden we need to compare if it is a static class method and we have a class property }
((sp_static in p.symoptions) <> ([po_classmethod,po_staticmethod]<=tprocdef(p.propaccesslist[palt_read].procdef).procoptions)) then
((sp_static in p.symoptions) <> tprocdef(p.propaccesslist[palt_read].procdef).no_self_node) then
Message(parser_e_ill_property_access_sym);
end;
fieldvarsym :

10
compiler/pexpr.pas
View File

@ -845,8 +845,8 @@ implementation
end;
ObjectSymtable :
begin
if (assigned(current_procinfo) and ([po_staticmethod,po_classmethod] <= current_procinfo.procdef.procoptions)) then
{ We are calling from the static class method which has no self node }
{ We are calling from the static class method which has no self node }
if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef._class))
else
p1:=load_self_node;
@ -1259,7 +1259,7 @@ implementation
if assigned(p1) and
(
is_self_node(p1) or
(assigned(current_procinfo) and ([po_staticmethod,po_classmethod] <= current_procinfo.procdef.procoptions) and
(assigned(current_procinfo) and (current_procinfo.procdef.no_self_node) and
(current_procinfo.procdef._class = classh))) then
Message(parser_e_only_class_members)
else
@ -1458,7 +1458,7 @@ implementation
if only method from which it was called is
not class static }
if (srsymtable.symtabletype=ObjectSymtable) then
if (assigned(current_procinfo) and ([po_staticmethod,po_classmethod] <= current_procinfo.procdef.procoptions)) then
if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef._class))
else
p1:=load_self_node;
@ -1637,7 +1637,7 @@ implementation
if is_member_read(srsym,srsymtable,p1,hdef) then
begin
if (srsymtable.symtabletype=ObjectSymtable) then
if (assigned(current_procinfo) and ([po_staticmethod,po_classmethod] <= current_procinfo.procdef.procoptions)) then
if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then
{ no self node in static class methods }
p1:=cloadvmtaddrnode.create(ctypenode.create(hdef))
else

5
compiler/psub.pas
View File

@ -1801,8 +1801,9 @@ implementation
is_classdef:=false;
if try_to_consume(_CLASS) then
begin
{ class method only allowed for procedures and functions }
if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR]) then
{ 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_objectdef) then

26
compiler/symconst.pas
View File

@ -81,12 +81,18 @@ const
ftCurr = 4;
ftFloat128 = 5;
mkProcedure= 0;
mkFunction = 1;
mkConstructor = 2;
mkDestructor = 3;
mkClassProcedure= 4;
mkClassFunction = 5;
mkProcedure = 0;
mkFunction = 1;
mkConstructor = 2;
mkDestructor = 3;
mkClassProcedure = 4;
mkClassFunction = 5;
mkClassConstructor = 6;
mkClassDestructor = 7;
// delphi has the next too:
//mkOperatorOverload = 8;
//mkSafeProcedure = 9;
//mkSafeFunction = 10;
pfvar = 1;
pfConst = 2;
@ -227,7 +233,9 @@ type
potype_destructor, { Procedure is a destructor }
potype_operator, { Procedure defines an operator }
potype_procedure,
potype_function
potype_function,
potype_class_constructor, { class constructor }
potype_class_destructor { class destructor }
);
tproctypeoptions=set of tproctypeoption;
@ -344,7 +352,9 @@ type
oo_has_enumerator_current,
oo_is_external, { the class is externally implemented (objcclass, cppclass) }
oo_is_anonymous, { the class is only formally defined in this module (objcclass x = class; external;) }
oo_is_classhelper { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
oo_is_classhelper, { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
oo_has_class_constructor, { the object/class has a class constructor }
oo_has_class_destructor { the object/class has a class destructor }
);
tobjectoptions=set of tobjectoption;

16
compiler/symdef.pas
View File

@ -394,6 +394,8 @@ interface
function getvardef:longint;override;
end;
{ tabstractprocdef }
tabstractprocdef = class(tstoreddef)
{ saves a definition to the return type }
returndef : tdef;
@ -422,6 +424,7 @@ interface
function typename_paras(showhidden:boolean): string;
function is_methodpointer:boolean;virtual;
function is_addressonly:boolean;virtual;
function no_self_node:boolean;
private
procedure count_para(p:TObject;arg:pointer);
procedure insert_para(p:TObject;arg:pointer);
@ -469,6 +472,8 @@ interface
end;
{$endif oldregvars}
{ tprocdef }
tprocdef = class(tabstractprocdef)
private
_mangledname : pshortstring;
@ -3008,6 +3013,12 @@ implementation
result:=true;
end;
function tabstractprocdef.no_self_node: boolean;
begin
Result:=([po_staticmethod,po_classmethod]<=procoptions)or
(proctypeoption in [potype_class_constructor,potype_class_destructor]);
end;
{***************************************************************************
TPROCDEF
@ -3309,6 +3320,10 @@ implementation
s:='constructor '+s;
potype_destructor:
s:='destructor '+s;
potype_class_constructor:
s:='class constructor '+s;
potype_class_destructor:
s:='class destructor '+s;
else
if assigned(returndef) and
not(is_void(returndef)) then
@ -3336,7 +3351,6 @@ implementation
(owner.symtabletype<>ObjectSymtable);
end;
function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
begin
case t of

31
compiler/utils/ppudump.pp
View File

@ -1086,7 +1086,9 @@ type
potype_destructor, { Procedure is a destructor }
potype_operator, { Procedure defines an operator }
potype_procedure,
potype_function
potype_function,
potype_class_constructor, { class constructor }
potype_class_destructor { class destructor }
);
tproctypeoptions=set of tproctypeoption;
tprocoption=(po_none,
@ -1182,14 +1184,16 @@ const
'MWPascal'
);
proctypeopt : array[1..ord(high(tproctypeoption))] of tproctypeopt=(
(mask:potype_proginit; str:'ProgInit'),
(mask:potype_unitinit; str:'UnitInit'),
(mask:potype_unitfinalize;str:'UnitFinalize'),
(mask:potype_constructor; str:'Constructor'),
(mask:potype_destructor; str:'Destructor'),
(mask:potype_operator; str:'Operator'),
(mask:potype_procedure; str:'Procedure'),
(mask:potype_function; str:'Function')
(mask:potype_proginit; str:'ProgInit'),
(mask:potype_unitinit; str:'UnitInit'),
(mask:potype_unitfinalize; str:'UnitFinalize'),
(mask:potype_constructor; str:'Constructor'),
(mask:potype_destructor; str:'Destructor'),
(mask:potype_operator; str:'Operator'),
(mask:potype_procedure; str:'Procedure'),
(mask:potype_function; str:'Function'),
(mask:potype_class_constructor; str:'Class Constructor'),
(mask:potype_class_destructor; str:'Class Destructor')
);
procopt : array[1..ord(high(tprocoption))] of tprocopt=(
(mask:po_classmethod; str:'ClassMethod'),
@ -1407,7 +1411,9 @@ type
oo_has_enumerator_current,
oo_is_external, { the class is externally implemented (objcclass, cppclass) }
oo_is_anonymous, { the class is only formally defined in this module (objcclass x = class; external;) }
oo_is_classhelper { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
oo_is_classhelper, { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
oo_has_class_constructor, { the object/class has a class constructor }
oo_has_class_destructor { the object/class has a class destructor }
);
tobjectoptions=set of tobjectoption;
tsymopt=record
@ -1436,7 +1442,10 @@ const
(mask:oo_has_enumerator_current; str:'HasEnumeratorCurrent'),
(mask:oo_is_external; str:'External'),
(mask:oo_is_anonymous; str:'Anonymous'),
(mask:oo_is_classhelper; str:'Class Helper/Category'));
(mask:oo_is_classhelper; str:'Class Helper/Category'),
(mask:oo_has_class_constructor; str:'HasClassConstructor'),
(mask:oo_has_class_destructor; str:'HasClassDestructor')
);
var
symoptions : tobjectoptions;
i : longint;

3
rtl/objpas/typinfo.pp
View File

@ -50,7 +50,8 @@ unit typinfo;
TFloatType = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr);
{$endif}
TMethodKind = (mkProcedure,mkFunction,mkConstructor,mkDestructor,
mkClassProcedure, mkClassFunction);
mkClassProcedure, mkClassFunction, mkClassConstructor,
mkClassDestructor);
TParamFlag = (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
TParamFlags = set of TParamFlag;
TIntfFlag = (ifHasGuid,ifDispInterface,ifDispatch,ifHasStrGUID);