Ticket #321: mmdvtableprob.t

#!perl
# Copyright (C) 2006-2008, The Perl Foundation.

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );

use Test::More;
use Parrot::Test tests => 3;

# sub op sets up return signature, get_integer returns a value - all OK
pir_output_is( <<'CODE', <<'OUT', 'get_integer vtable override' );
.sub main :main
    .local pmc integer_cl, override_cl, override_obj, i

    get_class integer_cl, 'Integer'
    subclass override_cl, integer_cl, 'IntegerOverrideGetInteger'

    override_obj = new 'IntegerOverrideGetInteger'
   
    $I0 = override_obj 
    print 'override_obj integer reg value: '
    say $I0

    i = new 'Integer'
    i = 2

    $P0 = sub override_obj, i
    print 'subtraction result: '
    say $P0
.end

.namespace ['IntegerOverrideGetInteger']

.sub get_integer :vtable :method
        say 'in get integer'
        .return (3)
.end
CODE
in get integer
override_obj integer reg value: 3
in get integer
subtraction result: 1
OUT

# sub op sets up return signature, init does not return value - crash
pir_output_is( <<'CODE', <<'OUT', 'init vtable override' );
.sub main :main
    .local pmc integer_cl, override_cl, override_obj, i

    get_class integer_cl, 'Integer'
    subclass override_cl, integer_cl, 'IntegerOverrideInit'

    override_obj = new 'IntegerOverrideInit'
   
    override_obj = 3
    print 'override_obj value: '
    say override_obj

    i = new 'Integer'
    i = 2

    $P0 = sub override_obj, i
    print 'subtraction result: '
    say $P0
.end

.namespace ['IntegerOverrideInit']

.sub init :vtable :method
        say 'in init'
.end
CODE
in init
override_obj value: 3
in init
subtraction result: 1
OUT

# sub op sets up return signature, set_integer_native no return value - crash
pir_output_is( <<'CODE', <<'OUT', 'set_integer_native vtable override' );
.sub main :main
    .local pmc integer_cl, override_cl, override_obj, i

    get_class integer_cl, 'Integer'
    subclass override_cl, integer_cl, 'IntegerOverrideSIN'

    override_obj = new 'IntegerOverrideSIN'
   
    override_obj = 3
    print 'override_obj value: '
    say override_obj

    i = new 'Integer'
    i = 2

    $P0 = sub override_obj, i
    print 'subtraction result: '
    say $P0
.end

.namespace ['IntegerOverrideSIN']

.sub set_integer_native :method :vtable
    .param int value
    .local pmc old_get_accessor

    say 'in set_integer_native'
    old_get_accessor = getattribute self, ['Integer'], 'proxy'
    old_get_accessor = value
.end

CODE
in set_integer_native
override_obj value: 3
in set_integer_native
subtraction result: 1
OUT


# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: