Index: src/ops/object.ops =================================================================== --- src/ops/object.ops (revision 18455) +++ src/ops/object.ops (working copy) @@ -55,7 +55,7 @@ meth = $2; next = expr NEXT(); method_pmc = VTABLE_find_method(interp, object, meth); - if (!method_pmc) { + if (PMC_IS_NULL(method_pmc)) { real_exception(interp, next, METH_NOT_FOUND, "Method '%Ss' not found", meth); } @@ -91,7 +91,7 @@ meth = $2; next = expr NEXT(); method_pmc = VTABLE_find_method(interp, object, meth); - if (!method_pmc) { + if (PMC_IS_NULL(method_pmc)) { real_exception(interp, next, METH_NOT_FOUND, "Method '%Ss' not found", meth); } Index: src/inter_call.c =================================================================== --- src/inter_call.c (revision 18455) +++ src/inter_call.c (working copy) @@ -312,7 +312,10 @@ : CTX_REG_NUM(st->src.ctx, idx); break; case PARROT_ARG_PMC: - UVal_pmc(st->val) = constant ? st->src.ctx->constants[idx]->u.key + if (st->src.sig & PARROT_ARG_OBJECT) + UVal_pmc(st->val) = CONTEXT(interp->ctx)->current_object; + else + UVal_pmc(st->val) = constant ? st->src.ctx->constants[idx]->u.key : CTX_REG_PMC(st->src.ctx, idx); if (st->src.sig & PARROT_ARG_FLATTEN) { @@ -1499,7 +1502,7 @@ ctx->current_cont = ret_cont; PMC_cont(ret_cont)->from_ctx = ctx; pccinvoke_meth = VTABLE_find_method(interp, pmc, method_name); - if (!pccinvoke_meth) { + if (PMC_IS_NULL(pccinvoke_meth)) { real_exception(interp, NULL, METH_NOT_FOUND, "Method '%Ss' not found", method_name); } else { Index: src/objects.c =================================================================== --- src/objects.c (revision 18455) +++ src/objects.c (working copy) @@ -72,6 +72,13 @@ return -1; } +STRING* +Parrot_get_vtable_name(Interp *interp, INTVAL index) +{ + const char *vtable_name = Parrot_vtable_slot_names[index]; + return string_from_cstring(interp, vtable_name, strlen(vtable_name)); +} + /* =item C Index: src/pmc/classobject.h =================================================================== --- src/pmc/classobject.h (revision 18455) +++ src/pmc/classobject.h (working copy) @@ -41,7 +41,11 @@ /* Fully qualified class name generation; defined in Class, used by Object. */ STRING* Parrot_Class_get_fq_classname(Parrot_Interp interp, Parrot_Class *class_info); +PMC* Parrot_Class_find_vtable_method(Parrot_Interp interp, PMC *self, STRING *meth); +/* Throw an exception if we try to override these. */ +static const char *const cant_override[] = { "init_pmc", "destroy", "mark", "morph", NULL }; + #endif /* PARROT_CLASSOBJECT_GUARD */ Index: src/pmc/class.pmc =================================================================== --- src/pmc/class.pmc (revision 18455) +++ src/pmc/class.pmc (working copy) @@ -112,7 +112,25 @@ return fq_class; } +/* Find a vtable method in the vtable_methods hash */ +PMC* Parrot_Class_find_vtable_method(Parrot_Interp interp, PMC *self, STRING *meth) { + Parrot_Class *_class = PARROT_CLASS(self); + int i; + INTVAL n = VTABLE_elements(interp, _class->all_parents); + /* Walk up MRO, looking for the vtable method */ + for ( i = 0; i < n; i++ ) { + PMC *parent = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i); + Parrot_Class *parent_class = PARROT_CLASS(parent); + + PMC *sub = VTABLE_get_pmc_keyed_str(interp, parent_class->vtable_methods, meth); + if (!PMC_IS_NULL(sub)) + return sub; + } + + return PMCNULL; +} + /* This function builds the attribute index (table to map class name and * attribute name to an index) for the current class. */ static void build_attrib_index(Parrot_Interp interp, PMC *self) { @@ -309,7 +327,26 @@ } } +static void add_vtable_method(Parrot_Interp interp, PMC *self, STRING *name, PMC *sub) +{ + int i; + Parrot_Class *_class = PARROT_CLASS(self); + char* name_c = string_to_cstring(interp, name); + /* Check if it's an un-overridable vtable method */ + for ( i = 0; cant_override[i]; i++ ) { + if ( strcmp(name_c, cant_override[i]) == 0 ) { + string_cstring_free(name_c); + real_exception(interp, NULL, E_NameError, + "Cannot override '%s' vtable method", cant_override[i]); + } + } + + if (!PMC_IS_NULL(sub)) + VTABLE_set_pmc_keyed_str(interp, _class->vtable_methods, name, sub); + string_cstring_free(name_c); +} + /* =back @@ -325,7 +362,6 @@ pmclass Class need_ext { - /* =item C @@ -496,9 +532,24 @@ real_exception(interp, NULL, E_NotImplementedError, "A method of this name already exists. It may have been supplied by a role."); } - else { + else if (!PMC_IS_NULL(sub)) { /* Enter it into the table. */ VTABLE_set_pmc_keyed_str(interp, _class->methods, name, sub); + + /* If method overrides a vtable method, stick it in the + vtable method hash */ + /* XXX this should really only be done from the + add_vtable_method PCCMETHOD */ + if ( PMC_sub(sub)->vtable_index > -1 ) { + INTVAL vtable_index = PMC_sub(sub)->vtable_index; + STRING *vtable_name = Parrot_get_vtable_name(interp, vtable_index); + + /* Chop off underscores */ + vtable_name->strstart += 2; + vtable_name->strlen -= 2; + + add_vtable_method(interp, SELF, vtable_name, sub); + } } } @@ -799,11 +850,11 @@ =cut */ - PCCMETHOD void new(PMC *args :slurpy :named) { + PCCMETHOD void new(PMC *params :slurpy) { Parrot_Class *_class = PARROT_CLASS(SELF); - PMC *obj; - PMC *iter; + PMC *obj, *iter; Parrot_Object *obj_guts = NULL; + INTVAL n; /* If we've not been instantiated before... */ if (!_class->instantiated) { @@ -847,19 +898,75 @@ obj_guts->attrib_store = pmc_new(interp, enum_class_ResizablePMCArray); PMC_data(obj) = obj_guts; - /* Initialize attributes with the supplied values. */ - iter = VTABLE_get_iter(interp, args); - while (VTABLE_get_bool(interp, iter)) { - /* Get name and value. */ - STRING *attr_name = VTABLE_shift_string(interp, iter); - PMC *attr_value = VTABLE_get_pmc_keyed_str(interp, args, attr_name); + /* Call init, if it's overridden. This chunk does a :flat on the params + * slurpy manually, then passes it to the init() override. Adapted from + * PCCINVOKE. */ + INTVAL sig_len = VTABLE_elements(interp, params) + 1; + INTVAL n_regs_used[] = { 0, 0, 0, sig_len }; - /* Set the attribute. */ - VTABLE_set_attr_str(interp, obj, attr_name, attr_value); + opcode_t arg_indexes[sig_len]; + int i; + for ( i = 0; i < sig_len; i++ ) + arg_indexes[i] = i; + opcode_t result_indexes[] = { 0 }; + + /* Fill the args signature with PMCs, since that's all we know + * about the slurpy's contents - they get converted to int, etc + * after the call. */ + PMC* args_sig = pmc_new(interp, enum_class_FixedIntegerArray); + VTABLE_set_integer_native(interp, args_sig, sig_len); + for ( i = 0; i < sig_len; i++ ) + VTABLE_set_integer_keyed_int(interp, args_sig, i, PARROT_ARG_PMC); + + PMC* results_sig = pmc_new(interp, enum_class_FixedIntegerArray); + + PMC* ret_cont = new_ret_continuation_pmc(interp, NULL); + parrot_context_t *ctx = Parrot_push_context(interp, n_regs_used); + + opcode_t* save_current_args = interp->current_args; + PMC* save_args_signature = interp->args_signature; + PMC* save_current_object = interp->current_object; + + /* Flatten the slurpy into register slots. */ + CTX_REG_PMC(ctx, 0) = obj; + for ( i = 1; i < sig_len; i++ ) + CTX_REG_PMC(ctx, i) = VTABLE_get_pmc_keyed_int(interp, params, i-1); + + /* Walk up MRO, looking for the vtable method */ + n = VTABLE_elements(interp, _class->all_parents); + for ( i = 0; i < n; i++ ) { + PMC *parent = VTABLE_get_pmc_keyed_int(interp, + _class->all_parents, i); + Parrot_Class *parent_class = PARROT_CLASS(parent); + + PMC *sub = VTABLE_get_pmc_keyed_str(interp, + parent_class->vtable_methods, CONST_STRING(interp, "init")); + if (!PMC_IS_NULL(sub)) { + interp->current_args = arg_indexes; + interp->args_signature = args_sig; + ctx->current_results = result_indexes; + ctx->results_signature = results_sig; + + interp->current_object = obj; + interp->current_cont = NEED_CONTINUATION; + ctx->current_cont = ret_cont; + PMC_cont(ret_cont)->from_ctx = ctx; + + /* Finally, call the sub */ + Parrot_runops_fromc(INTERP, sub); + } } + PObj_live_CLEAR(args_sig); + PObj_live_CLEAR(results_sig); + Parrot_pop_context(interp); + + interp->current_args = save_current_args; + interp->args_signature = save_args_signature; + interp->current_object = save_current_object; + PCCRETURN(PMC *obj) - } + } /* @@ -871,6 +978,7 @@ =cut */ + PCCMETHOD void attributes() { PMC *ret_attrib_metadata = VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "attributes")); PCCRETURN(PMC *ret_attrib_metadata); @@ -922,6 +1030,20 @@ /* +=item C + +Adds the given sub PMC as a vtable method with the given name. + +=cut + +*/ + PCCMETHOD void add_vtable_method(STRING *name, PMC *sub) + { + add_vtable_method(interp, SELF, name, sub); + } + +/* + =item C Return the parents array PMC. Index: src/pmc/object.pmc =================================================================== --- src/pmc/object.pmc (revision 18455) +++ src/pmc/object.pmc (working copy) @@ -61,7 +61,17 @@ return index; } +static void +vtable_meth_not_found(Interp *interp, PMC *pmc, const char *meth) +{ + Parrot_Object *obj = PARROT_OBJECT(pmc); + STRING *name = PARROT_CLASS(obj->_class)->name; + const char *name_c = string_to_cstring(interp, name); + real_exception(interp, NULL, E_LookupError, + "Can't find vtable method '%s' in class '%s'", meth, name_c); +} + pmclass Object need_ext { /* @@ -211,6 +221,47 @@ /* +=item C + +Invoke the object as a method. + +=cut + +*/ + opcode_t* invoke(void *next) { + STRING *meth = CONST_STRING(interp, "invoke"); + PMC *sub = Parrot_Class_find_vtable_method(interp, PARROT_OBJECT(pmc)->_class, meth); + if (PMC_IS_NULL(sub)) { + vtable_meth_not_found(interp, pmc, "invoke"); + return NULL; + } + else { + /* Since invoke() is a normal method, 'self' must be passed as the + * first argument, but because this looks like a non-method call in + * PIR, the args signature doesn't have it, so we have to get the + * args signature and unshift 'self' onto it. */ + + PMC *old_sig = CONTEXT(interp->ctx)->constants[*(interp->current_args+1)]->u.key; + INTVAL sig_len = VTABLE_elements(interp, old_sig) + 1; + int i; + + PMC *meth_sig = pmc_new(interp, enum_class_FixedIntegerArray); + VTABLE_set_integer_native(interp, meth_sig, sig_len); + + VTABLE_set_integer_keyed_int(interp, meth_sig, 0, PARROT_ARG_PMC | PARROT_ARG_OBJECT); + for ( i = 1; i < sig_len; i++ ) + VTABLE_set_integer_keyed_int(interp, meth_sig, i, VTABLE_get_integer_keyed_int(interp, old_sig, i-1)); + + interp->args_signature = meth_sig; + interp->current_args++; + + INTERP->current_object = SELF; + return VTABLE_invoke(interp, sub, next); + } + } + +/* + =item C Get the class PMC representing the class that this object is an instance of. Index: src/pmc/delegate.pmc =================================================================== --- src/pmc/delegate.pmc (revision 18455) +++ src/pmc/delegate.pmc (working copy) @@ -135,10 +135,24 @@ PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth); if (PMC_IS_NULL(sub)) vtable_meth_not_found(INTERP, SELF, "invoke"); + + PMC *old_sig = CONTEXT(interp->ctx)->constants[*(interp->current_args+1)]->u.key; + INTVAL sig_len = VTABLE_elements(interp, old_sig) + 1; + int i; + + PMC *meth_sig = pmc_new(interp, enum_class_FixedIntegerArray); + VTABLE_set_integer_native(interp, meth_sig, sig_len); + + VTABLE_set_integer_keyed_int(interp, meth_sig, 0, PARROT_ARG_PMC | PARROT_ARG_OBJECT); + for ( i = 1; i < sig_len; i++ ) + VTABLE_set_integer_keyed_int(interp, meth_sig, i, VTABLE_get_integer_keyed_int(interp, old_sig, i-1)); + + interp->args_signature = meth_sig; + interp->current_args++; + INTERP->current_object = SELF; return VTABLE_invoke(interp, sub, next); } - } /* Index: docs/pdds/pdd15_objects.pod =================================================================== --- docs/pdds/pdd15_objects.pod (revision 18455) +++ docs/pdds/pdd15_objects.pod (working copy) @@ -297,7 +297,7 @@ =over 4 -=item new() +=item new(PMC * :optional) Instantiate a new object from the class. Set the instantiated flag on the class. @@ -415,11 +415,13 @@ =item new - $P1 = $P2.new( 'myattrib' => "Foo" ) + $P1 = $P2.new() + $P1 = $P2.new($P3, ...) -Create a new instance object from the class object. It takes an optional, -slurpy, named list of attributes and values to initialize the object. -Passing attribute names that weren't declared in the class is an error. +Create a new instance object from the class object, and walks up the MRO of +the class, calling C on each parent, if they overridde it. Takes a +slurpy list of initializer parameters to pass to C. The slurpy must +match the argument signature of C. =item add_attribute @@ -452,10 +454,24 @@ PMC. If the method already exists (and isn't a Multi) it will replace the method with the new method and throw a warning. -It also takes named parameters to flag whether the method is a vtable -function, and whether it is anonymous (no named entry as a method, only -as a vtable). +=item add_vtable_method + $P1.add_vtable_method($S2, $P3) + +Adds a vtable method to the class, which will override any default +behavior. It takes the name of a vtable method (see L +for a listing) and a method PMC. If the method already exists (and isn't +a Multi) it will replace the method with the new method and throw a +warning. + +Trying to override C, C, C, or C will throw +an exception. + +When overridden, C and C work differently than they do in C. +Though their C counterparts are limited to a fixed number of parameters, +they can accept and return parameters according to the full Parrot calling +conventions. + =item methods $P1 = $P2.methods() Index: lib/Parrot/Pmc2c.pm =================================================================== --- lib/Parrot/Pmc2c.pm (revision 18455) +++ lib/Parrot/Pmc2c.pm (working copy) @@ -40,15 +40,14 @@ C<$self> is a hash reference C-ed from a F<*.dump> file generated by F from a F<*.pmc> file. It is C-ed either into -C, or into one of the other I PMCs: -F, C, C, C or C. +C, or into one of the other I PMCs. C<$opt> is a hash reference. =cut my %special_class_name = - map { ( $_, 1 ) } qw( STMRef Ref default Null delegate SharedRef deleg_pmc ); + map { ( $_, 1 ) } qw( STMRef Ref default Null Object SharedRef delegate deleg_pmc ); sub new { my ( $this, $self, $options ) = @_; @@ -1219,6 +1218,7 @@ require Parrot::Pmc2c::default; require Parrot::Pmc2c::delegate; require Parrot::Pmc2c::deleg_pmc; +require Parrot::Pmc2c::Object; require Parrot::Pmc2c::Null; require Parrot::Pmc2c::Ref; require Parrot::Pmc2c::SharedRef; Index: lib/Parrot/Pmc2c/PCCMETHOD.pm =================================================================== --- lib/Parrot/Pmc2c/PCCMETHOD.pm (revision 18455) +++ lib/Parrot/Pmc2c/PCCMETHOD.pm (working copy) @@ -524,7 +524,7 @@ PMC_cont(ret_cont)->from_ctx = ctx; pccinvoke_meth = VTABLE_find_method(interp, $invocant, $method_name); - if (!pccinvoke_meth) + if (PMC_IS_NULL(pccinvoke_meth)) real_exception(interp, NULL, METH_NOT_FOUND, "Method '%Ss' not found", $method_name); else Index: lib/Parrot/Pmc2c/Object.pm =================================================================== --- lib/Parrot/Pmc2c/Object.pm (revision 0) +++ lib/Parrot/Pmc2c/Object.pm (revision 0) @@ -0,0 +1,158 @@ + +=head1 Parrot::Pmc2c::delegate Instance Methods + +=over 4 + +=cut + +package Parrot::Pmc2c::Object; +use base 'Parrot::Pmc2c'; +use strict; +use warnings; + +=item C + +True for vtables. + +=cut + +sub implements { + my ( $self, $meth ) = @_; + $self->implements_vtable($meth); +} + +=item C + +Used in C to normalize argument types. + +=cut + +sub trans { + my ( $self, $type ) = @_; + + my $char = substr $type, 0, 1; + return $1 if ( $char =~ /([ISP])/ ); + return 'N' if ( $char eq 'F' ); + return 'v' if ( $type eq 'void' ); + return '?'; +} + +=item C + +Returns the method signature for C<$params>. + +=cut + +sub signature { + my ( $self, $params ) = @_; + + my $n = 1; + my @types = grep { $n++ & 1 ? $_ : 0 } split / /, $params; + @types = map { $self->trans($_) } @types; + return join '', @types; +} + +=item C + +Returns the C code for the method body. C<$line> is used to accumulate +the number of lines, C<$out_name> is the name of the output file we are +generating. + +The C PMC redirects all methods to bytecode. + +=back + +=cut + +sub body { + my ( $self, $method, $line, $out_name ) = @_; + + my $meth = $method->{meth}; + + my $func_ret = ''; + my $ret_type = ''; + my $type = $method->{type}; + if ( $type ne 'void' ) { + $func_ret = "return ($type)"; + if ( $type !~ /\*/ ) { + $func_ret = "return "; + $ret_type = "_ret" . lc substr $type, 0, 1; + $ret_type = "_reti" if $ret_type eq '_retu'; + } + } + + my $body; + if ( exists $method->{loc} and $method->{loc} ne 'vtable' ) { + # method is PCCMETHOD, etc - let default handler do it + return $self->SUPER::body( $method, $line, $out_name ); + } + elsif ( $self->SUPER::implements($meth) ) { + # method is implemented - get body and format it + my $n = $self->{has_method}{$meth}; + $method = $self->{methods}[$n]; + + $body = $method->{body}; + $body =~ s/^\t/ /mg; + $body =~ s/^[ ]{4}//mg; + + my $start_idx = index($body, "\n"); + $body = substr $body, $start_idx+1, length($body)-$start_idx-rindex($body, '}')-1; + } + else { + # throw exception + my $null_ret = "return"; + $null_ret .= " ($type)0" if $type ne 'void'; + $body = <decl( $self->{class}, $method, 0 ); + my $parameters = $method->{parameters}; + my $n = 0; + my @args = grep { $n++ & 1 ? $_ : 0 } split / /, $parameters; + my $arg = ''; + $arg = ", " . join( ' ', @args ) if @args; + my $sig = $self->signature($parameters); + $sig = $self->trans( $method->{type} ) . $sig; + + $body = $self->rewrite_vtable_method( $self->{class}, $meth, + $self->{super}{$meth}, $self->{super}, $body ); + Parrot::Pmc2c::PCCMETHOD::rewrite_pccinvoke( $method, \$body ); + + # I think that these will be out by one - NWC + my $l = $self->line_directive( $line, "object.c" ); + + # methods we don't want overridden + my @omit_meths = qw(init init_pmc invoke destroy mark morph); + + if ( scalar grep(/$meth/, @omit_meths) == 0 ) { + $body = <_class, __meth); + if (PMC_IS_NULL(__sub)) { + $body } + else + ${func_ret}Parrot_run_meth_fromc_args$ret_type(interp, __sub, + pmc, __meth, "$sig"$arg); +EOC + } + + return < 11; +use Parrot::Test tests => 10; =head1 NAME @@ -195,7 +195,7 @@ pir_output_is( <<'CODE', <<'OUT', 'RT#41733 - Execution ends after returning from invoke' ); .namespace ['Foo'] -.sub invoke :vtable +.sub invoke :vtable :method say "you invoked me!" .return() .end @@ -214,7 +214,7 @@ pir_output_is( <<'CODE', <<'OUT', 'params/returns from overridden invoke' ); .namespace ['Foo'] -.sub invoke :vtable +.sub invoke :vtable :method .param int a print a print "\n" @@ -234,23 +234,6 @@ 3 OUT -pir_output_like( <<'CODE', <<'OUT', 'RT#41732' ); -.namespace ['Foo'] - -.sub invoke :vtable - .param pmc a - say 'hi' -.end - -.sub main :main - $P0 = newclass "Foo" - $P1 = new "Foo" - $P1() -.end -CODE -/1 params expected/ -OUT - # ' # Local Variables: Index: t/pmc/class.t =================================================================== --- t/pmc/class.t (revision 18455) +++ t/pmc/class.t (working copy) @@ -6,7 +6,7 @@ use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; -use Parrot::Test tests => 15; +use Parrot::Test tests => 17; =head1 NAME @@ -97,41 +97,97 @@ OUT # L -pir_output_is( <<'CODE', <<'OUT', 'new' ); +pir_output_is( <<'CODE', <<'OUT', 'new calls init()' ); .sub 'test' :main - new $P0, .Class - $P1 = $P0.'new'() - $I0 = isa $P1, 'Object' - if $I0 goto ok_1 - print 'not ' - ok_1: - say 'ok 1 - new() with no args returns an object' + .local pmc class, subclass, obj, meth + class = new "Class" + meth = find_global "init_super" + class.'add_vtable_method'("init", meth) - push_eh ok_2 - $P1 = $P0.'new'('abc' => '123' ) - clear_eh - print 'not ' - ok_2: - say 'ok 2 - new() with non-attribute key fails' + subclass = new "Class" + subclass.'add_parent'(class) + meth = find_global "init" + subclass.'add_vtable_method'("init", meth) + obj = subclass.'new'("param") +.end - $P0 = new .Class - $P0.'add_attribute'('foo') - $P0.'add_attribute'('bar') - $P1 = $P0.'new'('foo' => 1, 'bar' => 2) - $P2 = getattribute $P1, 'foo' - say $P2 - $P2 = getattribute $P1, 'bar' - say $P2 - say 'ok 3 - new() with key/value pairs sets attributes' +.sub 'init_super' :vtable('init') :method + .param string par + say "super init" + say par .end + +.sub 'init' :vtable :method + .param string par + say "sub init" + say par +.end CODE -ok 1 - new() with no args returns an object -ok 2 - new() with non-attribute key fails -1 -2 -ok 3 - new() with key/value pairs sets attributes +sub init +param +super init +param OUT +# L +pir_output_is( <<'CODE', <<'OUT', 'vtable method lookup' ); +.sub 'test' :main + .local pmc class, subclass, obj, meth + class = new "Class" + meth = find_global "get_string_super" + class.'add_vtable_method'("get_string", meth) + obj = class.'new'() + say obj + + subclass = new "Class" + subclass.'add_parent'(class) + obj = subclass.'new'() + say obj + + subclass = new "Class" + subclass.'add_parent'(class) + meth = find_global "get_string" + subclass.'add_vtable_method'("get_string", meth) + obj = subclass.'new'() + say obj +.end + +.sub 'get_string_super' :vtable('get_string') :method + .return("superclass get_string()") +.end + +.sub 'get_string' :vtable :method + .return("subclass get_string()") +.end +CODE +superclass get_string() +superclass get_string() +subclass get_string() +OUT + +# L +pir_output_is( <<'CODE', <<'OUT', 'overriding invoke() vtable method' ); +.sub 'test' :main + .local pmc class, obj, meth, ret + class = new "Class" + meth = find_global "invoke" + class.'add_vtable_method'("invoke", meth) + obj = class.'new'() + + ret = obj("param") + say ret +.end + +.sub 'invoke' :vtable :method + .param string par + say par + .return("return val") +.end +CODE +param +return val +OUT + # L pir_output_is( <<'CODE', <<'OUT', 'attributes' ); .sub 'test' :main Index: t/pmc/object-meths.t =================================================================== --- t/pmc/object-meths.t (revision 18455) +++ t/pmc/object-meths.t (working copy) @@ -6,7 +6,7 @@ use warnings; use lib qw( . lib ../lib ../../lib ); use Test::More; -use Parrot::Test tests => 43; +use Parrot::Test tests => 44; =head1 NAME @@ -729,6 +729,28 @@ bar init OUTPUT +pir_output_is( <<'CODE', <<'OUTPUT', "constructor - vtable override" ); +.sub main :main + $P0 = newclass 'Foo' + $P1 = subclass 'Foo', 'Bar' + $P2 = new 'Bar' +.end + +.namespace ['Foo'] +.sub init :vtable :method + print "foo init\n" +.end + +.namespace ['Bar'] +.sub init :vtable :method + print "bar init\n" +.end + +CODE +foo init +bar init +OUTPUT + pir_output_is( <<'CODE', <<'OUTPUT', "same method name in two namespaces" ); .namespace ["A"]