Ticket #321: mmdvtableprob.t

File mmdvtableprob.t, 2.6 KB (added by ronaldws, 5 years ago)
Line 
1#!perl
2# Copyright (C) 2006-2008, The Perl Foundation.
3
4use strict;
5use warnings;
6use lib qw( . lib ../lib ../../lib );
7
8use Test::More;
9use Parrot::Test tests => 3;
10
11# sub op sets up return signature, get_integer returns a value - all OK
12pir_output_is( <<'CODE', <<'OUT', 'get_integer vtable override' );
13.sub main :main
14    .local pmc integer_cl, override_cl, override_obj, i
15
16    get_class integer_cl, 'Integer'
17    subclass override_cl, integer_cl, 'IntegerOverrideGetInteger'
18
19    override_obj = new 'IntegerOverrideGetInteger'
20   
21    $I0 = override_obj
22    print 'override_obj integer reg value: '
23    say $I0
24
25    i = new 'Integer'
26    i = 2
27
28    $P0 = sub override_obj, i
29    print 'subtraction result: '
30    say $P0
31.end
32
33.namespace ['IntegerOverrideGetInteger']
34
35.sub get_integer :vtable :method
36        say 'in get integer'
37        .return (3)
38.end
39CODE
40in get integer
41override_obj integer reg value: 3
42in get integer
43subtraction result: 1
44OUT
45
46# sub op sets up return signature, init does not return value - crash
47pir_output_is( <<'CODE', <<'OUT', 'init vtable override' );
48.sub main :main
49    .local pmc integer_cl, override_cl, override_obj, i
50
51    get_class integer_cl, 'Integer'
52    subclass override_cl, integer_cl, 'IntegerOverrideInit'
53
54    override_obj = new 'IntegerOverrideInit'
55   
56    override_obj = 3
57    print 'override_obj value: '
58    say override_obj
59
60    i = new 'Integer'
61    i = 2
62
63    $P0 = sub override_obj, i
64    print 'subtraction result: '
65    say $P0
66.end
67
68.namespace ['IntegerOverrideInit']
69
70.sub init :vtable :method
71        say 'in init'
72.end
73CODE
74in init
75override_obj value: 3
76in init
77subtraction result: 1
78OUT
79
80# sub op sets up return signature, set_integer_native no return value - crash
81pir_output_is( <<'CODE', <<'OUT', 'set_integer_native vtable override' );
82.sub main :main
83    .local pmc integer_cl, override_cl, override_obj, i
84
85    get_class integer_cl, 'Integer'
86    subclass override_cl, integer_cl, 'IntegerOverrideSIN'
87
88    override_obj = new 'IntegerOverrideSIN'
89   
90    override_obj = 3
91    print 'override_obj value: '
92    say override_obj
93
94    i = new 'Integer'
95    i = 2
96
97    $P0 = sub override_obj, i
98    print 'subtraction result: '
99    say $P0
100.end
101
102.namespace ['IntegerOverrideSIN']
103
104.sub set_integer_native :method :vtable
105    .param int value
106    .local pmc old_get_accessor
107
108    say 'in set_integer_native'
109    old_get_accessor = getattribute self, ['Integer'], 'proxy'
110    old_get_accessor = value
111.end
112
113CODE
114in set_integer_native
115override_obj value: 3
116in set_integer_native
117subtraction result: 1
118OUT
119
120
121# Local Variables:
122#   mode: cperl
123#   cperl-indent-level: 4
124#   fill-column: 100
125# End:
126# vim: expandtab shiftwidth=4: