The problem is that a Sub is not a ParrotObject, so it has nowhere to
store attributes.  That's why attr_str_2_num throws "Can't set
non-core object attribs": it can't safely use PMC_data unless you've
passed a ParrotObject.  I've attached a patch that implements a basic
attribute storage system for TclProc (just a hash).  They're not
really attributes, though; they act like properties in ParrotObjects,
since TclProc has no corresponding class in which to store them
permanently (get_class returns the PMC itself).  This should be all
that's necessary; a TclProc would probably only require a few
attributes, and you can set their default values in the init() vtable
method.  Another solution is to have TclProc be an actual ParrotObject
wrapper around Sub, and redirect all vtable methods to the sub.


On 2/25/07, via RT Will Coleda <[EMAIL PROTECTED]> wrote:
# New Ticket Created by  Will Coleda
# Please include the string:  [perl #41614]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=41614 >


In Tcl, I've tried to add an attribute to a TclProc PMC (a thin
wrapper around .Sub) in my sandbox.

First, I have to override several methods in TclProc (copying them from

=item C<PMC* get_attr(INTVAL idx)>
=item C<PMC* get_attr_str(STRING *name)>
=item C<void set_attr(INTVAL idx, PMC *val)>
=item C<void set_attr_str(STRING *name, PMC *val)>

to avoid errors like:

set_attr_str() not implemented in class 'TclProc'

Once these are implemented, code like:

   setattribute $P1, 'source',     $P9

generates the exception:

  Can't set non-core object attribs

If I try to add the attribute before setting, it's worse:

   $P8 = getclass "TclProc"
   addattribute $P8, 'source'

  src/objects.c:1452: failed assertion `(class)->pmc_ext'





--
Will "Coke" Coleda
[EMAIL PROTECTED]



--- languages/tcl/src/pmc/tclproc.pmc	2007-02-20 15:38:33.000000000 +0000
+++ languages/tcl/src/pmc/tclproc.pmc	2007-02-25 19:40:19.000000000 +0000
@@ -11,8 +11,20 @@
     group   tcl_group
     hll     Tcl
     maps    Sub
+    need_ext
 {
+    void init() {
+      PMC_data(SELF) = pmc_new(interp, enum_class_Hash);
+      SUPER();
+    }
 
+    void set_attr_str(STRING* name, PMC* value) {
+        VTABLE_set_pmc_keyed_str(INTERP, (PMC *)PMC_data(SELF), name, value);
+    }
+
+    PMC* get_attr_str(STRING* name) {
+        return VTABLE_get_pmc_keyed_str(INTERP, (PMC *)PMC_data(SELF), name);
+    }
 }
 
 /*

Reply via email to