Hello together!
I have taken the time to implement a first version of Delphi's class
helpers. Thanks to Jonas' code for Objective C categories it was a
rather easy to get that working.
I have yet to test the compatibility of this implementation with Delphi
and this is where the FPC community comes in. I'd like you (@all list
readers) - if possible - to test this extension with tasks you'd use
them in and also to test what behaves differently from Delphi if you
have a current Delphi version available (I believe you need Delphi 2007
or newer for this).
Especially at the core devs, but maybe also for other interested persons
I have the following questions regarding the implementation of this feature:
- should class helpers have access to protected fields of the extended
class? I propose not or this would beat the complete idea of "sealed" (I
also believe that Delphi doesn't allow it as well)
- should class helpers be able to be instantiated or even referenced in
any way? (including forward declarations)
- should class helpers be allowed to override/reintroduce methods?
- should class helpers be able to extend other class helpers (as class
helpers are implemented as child classes of the extended class this
might currently be possible)?
- should class helpers be able to implement interfaces?
- can/should "message" methods be forbidden?
- should abstract methods be forbidden?
- should a class helper for class X hide a method which was introduced
in a subclass of X?
- can class helpers extend generic classes?
- can class helpers BE generic?
I have attached the patch which implements the class helper syntax in
the trunk compiler. Please note that this might not be the final
version, so please do not rely on the syntax and especially the behavior.
Class helpers adhere to the following syntax (I'm still thinking whether
I should slap Borland/Codegear for that...)
type
[ClassName] = class helper for [ExtendedClass]
class procedure SomeClassMethod;
procedure SomeMethod;
(...)
end;
The methods are implemented like in a normal class, but "Self" refers to
an instance of the extended class in normal methods and to the class
itself if used inside a class method (of course other methods
implemented by the class helper are available as well... basically a
class helper is a child class of the extended class).
The methods implemented by class helpers are automatically available if
the class helper is available in the current scope. The methods are
called as if they belong to the extended class:
var
c: [ExtendedClass];
begin
// class methods
[ExtendedClass].SomeClassMethod;
c := [ExtendedClass].Create;
c.SomeClassMethod;
c.SomeMethod;
end;
For the case you are still looking for a usecase: On the Lazarus mailing
list was posted such one by ugaciaka in this mail:
http://lists.lazarus.freepascal.org/pipermail/lazarus/2010-December/058368.html
A possible answer for his first question would be the following
(untested and maybe also properties would work...):
type
TCheckListBoxHelper = class helper for TCheckListBox
function GetCheckedCount: Integer;
end;
function TCheckListBoxHelper.GetCheckedCount: Integer;
var
i: Integer;
begin
Result := 0;
// Count and Checked belong to the extended TCheckListBox
for i := 0 to Count - 1 do
if Checked[i] then
Inc(Result);
end;
(...)
// somewhere in a piece of code that has access to a TCheckListBox instance
c := SomeCheckListBox.GetCheckedCount;
Please feel free to comment, criticise, test and discuss this feature
and more especially its implementation.
Regards,
Sven
Index: pdecl.pas
===================================================================
--- pdecl.pas (revision 16602)
+++ pdecl.pas (working copy)
@@ -667,6 +667,9 @@
if is_cppclass(hdef) then
tobjectdef(hdef).finish_cpp_data;
+
+ if is_classhelper(hdef) then
+ tobjectdef(hdef).finish_classhelper;
end;
recorddef :
begin
Index: pdecobj.pas
===================================================================
--- pdecobj.pas (revision 16602)
+++ pdecobj.pas (working copy)
@@ -373,9 +373,11 @@
{ reads the parent class }
if (token=_LKLAMMER) or
- is_objccategory(current_objectdef) then
+ is_objccategory(current_objectdef) or
+ is_classhelper(current_objectdef) then
begin
- consume(_LKLAMMER);
+ if not is_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 @@
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_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 @@
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_classhelper(current_objectdef) then
Message1(parser_e_sealed_descendant,childof.typename);
odt_interfacecorba,
odt_interfacecom:
@@ -512,7 +518,8 @@
handleImplementedProtocol(intfchildof);
readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
end;
- consume(_RKLAMMER);
+ if not is_classhelper(current_objectdef) then
+ consume(_RKLAMMER);
end;
end;
@@ -1049,6 +1056,13 @@
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;
Index: ptype.pas
===================================================================
--- ptype.pas (revision 16602)
+++ ptype.pas (working copy)
@@ -1342,6 +1342,13 @@
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;
_CPPCLASS :
Index: symconst.pas
===================================================================
--- symconst.pas (revision 16602)
+++ symconst.pas (working copy)
@@ -326,7 +326,8 @@
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 }
Index: symdef.pas
===================================================================
--- symdef.pas (revision 16602)
+++ symdef.pas (working copy)
@@ -321,6 +321,7 @@
procedure register_maybe_created_object_type;
procedure register_created_classref_type;
procedure register_vmt_call(index:longint);
+ procedure finish_classhelper;
{ ObjC & C++ }
procedure make_all_methods_external;
{ ObjC }
@@ -771,6 +772,7 @@
function is_dispinterface(def: tdef): boolean;
function is_object(def: tdef): boolean;
function is_class(def: tdef): boolean;
+ function is_classhelper(def: tdef): boolean;
function is_cppclass(def: tdef): boolean;
function is_objcclass(def: tdef): boolean;
function is_objcclassref(def: tdef): boolean;
@@ -4018,7 +4020,7 @@
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;
@@ -4931,7 +4933,12 @@
current_module.wpoinfo.addcalledvmtentry(self,index);
end;
+ procedure tobjectdef.finish_classhelper;
+ begin
+
self.symtable.DefList.foreachcall(@create_class_helper_for_procdef,nil);
+ end;
+
procedure make_procdef_external(data: tobject; arg: pointer);
var
def: tdef absolute data;
@@ -5384,6 +5391,17 @@
(tobjectdef(def).objecttype=odt_class);
end;
+ function is_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_object(def: tdef): boolean;
begin
Index: symtable.pas
===================================================================
--- symtable.pas (revision 16602)
+++ symtable.pas (working copy)
@@ -2114,7 +2114,7 @@
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
Index: tokens.pas
===================================================================
--- tokens.pas (revision 16602)
+++ tokens.pas (working copy)
@@ -162,6 +162,7 @@
_DOWNTO,
_EXCEPT,
_EXPORT,
+ _HELPER,
_INLINE,
_LEGACY,
_NESTED,
@@ -425,6 +426,7 @@
(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),
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
