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

Added first version of class helper support (not fully working and not fully featured)

Browse Source 
- tokens: added support for "helper" token
- symconst.tobjecttyp: added a new entry "odt_classhelper"
- symdef: added two functions to check whether a "tdef" instance is a class helper in general ("is_classhelper") or an Object Pascal class helper in particular ("is_objectpascal_classhelper")
- symdef.tobjectdef: added a new method "finish_classhelper" which calls "create_class_helper_for_procdef" for every method (maybe this can be used for Objective-C categories as well)
- symdef.tobjectdef.create: "ImplementedInterfaces" must be created for class helpers as well
- symtable.searchsym_in_class: class helper methods must be searched for Object Pascal classes as well (this is currently wrong, as those must be searched before the class symbols, but for a first test it's sufficient)
- ptype.read_named_type: "helper for" currently indicates a class helper ("for" should be checked inside "object_dec" though, as after "helper" there might be a parent class helper)
- pdecobj.parse_parent_classes: parse the name of the extended class and disable sealed check for those
- pdecobj.object_dec: "odt_classhelper" are changed to "odt_class" and "oo_is_classhelper" is added to the object options
- pdecl.types_dec: create class helper symbols by using "finish_classhelper"

git-svn-id: branches/svenbarth/classhelpers@16729 -
This commit is contained in:
svenbarth 2011-01-07 21:38:56 +00:00
parent 05af7e7c0e
commit aed9f0a5f7
7 changed files with 62 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compiler/pdecl.pas
View File

@ -667,6 +667,9 @@ implementation
if is_cppclass(hdef) then
tobjectdef(hdef).finish_cpp_data;
if is_objectpascal_classhelper(hdef) then
tobjectdef(hdef).finish_classhelper;
end;
recorddef :
begin

24
compiler/pdecobj.pas
View File

@ -373,9 +373,11 @@ implementation
{ reads the parent class }
if (token=_LKLAMMER) or
is_objccategory(current_objectdef) then
is_objccategory(current_objectdef) or
is_objectpascal_classhelper(current_objectdef) then
begin
consume(_LKLAMMER);
if not is_objectpascal_classhelper(current_objectdef) then
consume(_LKLAMMER);
{ use single_type instead of id_type for specialize support }
single_type(hdef,false,false);
if (not assigned(hdef)) or
@ -385,7 +387,10 @@ implementation
Message1(type_e_class_type_expected,hdef.typename)
else if is_objccategory(current_objectdef) then
{ a category must specify the class to extend }
Message(type_e_objcclass_type_expected);
Message(type_e_objcclass_type_expected)
else if is_objectpascal_classhelper(current_objectdef) then
{ a class helper must specify the class to extend }
Message(type_e_class_type_expected);
end
else
begin
@ -408,7 +413,8 @@ implementation
Message(parser_e_mix_of_classes_and_objects);
end
else
if oo_is_sealed in childof.objectoptions then
if (oo_is_sealed in childof.objectoptions) and
not is_objectpascal_classhelper(current_objectdef) then
Message1(parser_e_sealed_descendant,childof.typename);
odt_interfacecorba,
odt_interfacecom:
@ -512,7 +518,8 @@ implementation
handleImplementedProtocol(intfchildof);
readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
end;
consume(_RKLAMMER);
if not is_objectpascal_classhelper(current_objectdef) then
consume(_RKLAMMER);
end;
end;
@ -1049,6 +1056,13 @@ implementation
include(current_objectdef.objectoptions,oo_is_classhelper);
end;
{ change classhepers into Delphi type class helpers }
if (objecttype=odt_classhelper) then
begin
current_objectdef.objecttype:=odt_class;
include(current_objectdef.objectoptions,oo_is_classhelper);
end;
{ parse list of options (abstract / sealed) }
parse_object_options;

7
compiler/ptype.pas
View File

@ -1368,6 +1368,13 @@ implementation
else
Message1(type_e_class_or_objcclass_type_expected,hdef.typename);
end
else
if (idtoken=_HELPER) then
begin
consume(_HELPER);
consume(_FOR);
def:=object_dec(odt_classhelper,name,genericdef,genericlist,nil);
end
else
def:=object_dec(odt_class,name,genericdef,genericlist,nil);
end;

3
compiler/symconst.pas
View File

@ -326,7 +326,8 @@ type
odt_dispinterface,
odt_objcclass,
odt_objcprotocol,
odt_objccategory { note that these are changed into odt_class afterwards }
odt_objccategory, { note that these are changed into odt_class afterwards }
odt_classhelper
);
{ Variations in interfaces implementation }

29
compiler/symdef.pas
View File

@ -311,6 +311,7 @@ interface
procedure set_parent(c : tobjectdef);
function find_destructor: tprocdef;
function implements_any_interfaces: boolean;
procedure finish_classhelper;
{ dispinterface support }
function get_next_dispid: longint;
{ enumerator support }
@ -773,12 +774,14 @@ interface
function is_object(def: tdef): boolean;
function is_class(def: tdef): boolean;
function is_cppclass(def: tdef): boolean;
function is_objectpascal_classhelper(def: tdef): boolean;
function is_objcclass(def: tdef): boolean;
function is_objcclassref(def: tdef): boolean;
function is_objcprotocol(def: tdef): boolean;
function is_objccategory(def: tdef): boolean;
function is_objc_class_or_protocol(def: tdef): boolean;
function is_objc_protocol_or_category(def: tdef): boolean;
function is_classhelper(def: tdef): boolean;
function is_class_or_interface(def: tdef): boolean;
function is_class_or_interface_or_objc(def: tdef): boolean;
function is_class_or_interface_or_object(def: tdef): boolean;
@ -4024,7 +4027,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] then
if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_classhelper] then
ImplementedInterfaces:=TFPObjectList.Create(true)
else
ImplementedInterfaces:=nil;
@ -4591,6 +4594,11 @@ implementation
(assigned(childof) and childof.implements_any_interfaces);
end;
procedure tobjectdef.finish_classhelper;
begin
self.symtable.DefList.foreachcall(@create_class_helper_for_procdef,nil);
end;
function tobjectdef.size : aint;
begin
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
@ -5418,6 +5426,19 @@ implementation
end;
function is_objectpascal_classhelper(def: tdef): boolean;
begin
result:=
assigned(def) and
(def.typ=objectdef) and
{ if used as a forward type }
((tobjectdef(def).objecttype=odt_classhelper) or
{ if used as after it has been resolved }
((tobjectdef(def).objecttype=odt_class) and
(oo_is_classhelper in tobjectdef(def).objectoptions)));
end;
function is_objcclassref(def: tdef): boolean;
begin
is_objcclassref:=
@ -5467,6 +5488,12 @@ implementation
(oo_is_classhelper in tobjectdef(def).objectoptions)));
end;
function is_classhelper(def: tdef): boolean;
begin
result:=
is_objectpascal_classhelper(def) or
is_objccategory(def);
end;
function is_class_or_interface(def: tdef): boolean;
begin

2
compiler/symtable.pas
View File

@ -2135,7 +2135,7 @@ implementation
classh:=classh.childof;
end;
end;
if is_objcclass(orgclass) then
if is_objcclass(orgclass) or is_class(orgclass) then
result:=search_class_helper(orgclass,s,srsym,srsymtable)
else
begin

2
compiler/tokens.pas
View File

@ -170,6 +170,7 @@ type
_DOWNTO,
_EXCEPT,
_EXPORT,
_HELPER,
_INLINE,
_LEGACY,
_NESTED,
@ -464,6 +465,7 @@ const
(str:'DOWNTO' ;special:false;keyword:m_all;op:NOTOKEN),
(str:'EXCEPT' ;special:false;keyword:m_except;op:NOTOKEN),
(str:'EXPORT' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'HELPER' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'INLINE' ;special:false;keyword:m_none;op:NOTOKEN),
(str:'LEGACY' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS }
(str:'NESTED' ;special:false;keyword:m_none;op:NOTOKEN),