t/pmc/parrotobject.t

   1 #!perl
   2 # Copyright (C) 2006-2008, The Perl Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More;
   9 use Parrot::Test tests => 11;
  10
  11 =head1 NAME
  12
  13 t/pmc/parrotobject.t - test the Object PMC
  14
  15
  16 =head1 SYNOPSIS
  17
  18     % prove t/pmc/parrotobject.t
  19
  20 =head1 DESCRIPTION
  21
  22 Tests the Object PMC.
  23
  24 =cut
  25
  26 pir_error_output_like( <<'CODE', <<'OUT', 'new' );
  27 .sub 'test' :main
  28     new P0, 'Object'
  29     print "ok 1\n"
  30 .end
  31 CODE
  32 /Object must be created by a class./
  33 OUT
  34
  35 # '
  36
  37 pir_output_is( <<'CODE', <<'OUT', ':vtable override' );
  38 .sub main :main
  39    $P0 = newclass [ "Test" ]
  40    $P1 = new [ "Test" ]
  41    $I1 = $P1[11]
  42    print $I1
  43    print "\n"
  44 .end
  45
  46 .namespace [ "Test" ]
  47
  48 .sub get_integer_keyed_int :method :vtable
  49    .param int key
  50    .return(42)
  51 .end
  52 CODE
  53 42
  54 OUT
  55
  56 # '
  57
  58 pir_output_is( <<'CODE', <<'OUT', ':vtable("...") override' );
  59 .sub main :main
  60     $P0 = newclass [ "Test" ]
  61     $P1 = new [ "Test" ]
  62     $S1 = $P1[11]
  63     print $S1
  64     print "\n"
  65 .end
  66
  67 .namespace [ "Test" ]
  68
  69 .sub monkey :method :vtable("get_string_keyed_int")
  70     .param int key
  71     .return("monkey")
  72 .end
  73 CODE
  74 monkey
  75 OUT
  76
  77 # '
  78
  79 pir_error_output_like( <<'CODE', <<'OUT', ':vtable with bad name' );
  80 .namespace [ "Test" ]
  81
  82 .sub monkey :method :vtable("not_in_the_vtable")
  83     .param int key
  84     .return("monkey")
  85 .end
  86 CODE
  87 /'not_in_the_vtable' is not a v-table method, but was used with :vtable/
  88 OUT
  89
  90 # '
  91
  92 pir_output_is( <<'CODE', <<'OUT', ':vtable and init' );
  93 .sub main :main
  94    $P0 = newclass [ "Test" ]
  95    $P1 = new [ "Test" ]
  96    print "ok\n"
  97 .end
  98
  99 .namespace [ "Test" ]
 100
 101 .sub init :method :vtable
 102    print "init\n"
 103 .end
 104 CODE
 105 init
 106 ok
 107 OUT
 108
 109 # '
 110
 111 pir_output_is( <<'CODE', <<'OUT', ':vtable inheritance' );
 112 .sub main :main
 113    $P0 = newclass [ "Test" ]
 114    $P1 = newclass [ "Test2" ]
 115    addparent $P1, $P0
 116    $P2 = new [ "Test2" ]
 117    $P3 = clone $P2
 118    print "ok\n"
 119 .end
 120
 121 .namespace [ "Test" ]
 122
 123 .sub clone :method :vtable
 124    print "cloned\n"
 125 .end
 126
 127 .namespace [ "Test2" ]
 128 CODE
 129 cloned
 130 ok
 131 OUT
 132
 133 # '
 134
 135 # :vtable inheritance; RT #40626
 136 pir_output_is( <<'CODE', <<'OUT', ':vtable inheritance from core classes' );
 137 .sub main :main
 138     $P0 = subclass 'Hash', 'Foo'
 139     $P0 = subclass 'Hash', 'Bar'
 140
 141     $P1 = new 'Foo'
 142     $S1 = $P1
 143     say $S1
 144
 145     $P1 = new 'Bar'
 146     $S1 = $P1
 147     say $S1
 148 .end
 149
 150
 151 .namespace [ 'Foo' ]
 152
 153 .sub 'get_string' :vtable :method
 154     .return('Foo::get_string')
 155 .end
 156
 157
 158 .namespace [ 'Bar' ]
 159
 160 .sub 'get_string' :vtable :method
 161     .return('Bar::get_string')
 162 .end
 163 CODE
 164 Foo::get_string
 165 Bar::get_string
 166 OUT
 167
 168 # assign opcode in inherited classes
 169 pir_output_is(
 170     <<'CODE', <<'OUT', 'assign opcode in inherited classes' );
 171 .sub main :main
 172     $P1 = new 'ResizablePMCArray'
 173     push $P1, 3
 174     $P2 = new 'ResizablePMCArray'
 175     assign $P2, $P1
 176     $I0 = elements $P2
 177     print $I0
 178     print "\n"
 179
 180     $P99 = subclass 'ResizablePMCArray', 'Perl6List'
 181     $P1 = new 'Perl6List'
 182     push $P1, 3
 183     $P2 = new 'Perl6List'
 184     assign $P2, $P1
 185     $I0 = elements $P2
 186     print $I0
 187     print "\n"
 188 .end
 189 CODE
 190 1
 191 1
 192 OUT
 193
 194 pir_output_is( <<'CODE', <<'OUT', 'RT#41733 - Execution ends after returning from invoke' );
 195 .namespace ['Foo']
 196
 197 .sub invoke :vtable
 198 say "you invoked me!"
 199 .return()
 200 .end
 201
 202 .sub main :main
 203 $P0 = newclass "Foo"
 204 $P1 = new "Foo"
 205 $P1()
 206 say "got here"
 207 .end
 208 CODE
 209 you invoked me!
 210 got here
 211 OUT
 212
 213 pir_output_is( <<'CODE', <<'OUT', 'params/returns from overridden invoke' );
 214 .namespace ['Foo']
 215
 216 .sub invoke :vtable
 217   .param int a
 218   print a
 219   print "\n"
 220   inc a
 221   .return(a)
 222 .end
 223
 224 .sub main :main
 225   $P0 = newclass "Foo"
 226   $P1 = new "Foo"
 227   $I0 = $P1(2)
 228   print $I0
 229   print "\n"
 230 .end
 231 CODE
 232 2
 233 3
 234 OUT
 235
 236 pir_error_output_like( <<'CODE', <<'OUT', 'RT#41732' );
 237 .namespace ['Foo']
 238
 239 .sub invoke :vtable
 240   .param pmc a
 241   say 'hi'
 242 .end
 243
 244 .sub main :main
 245     $P0 = newclass "Foo"
 246     $P1 = new "Foo"
 247     $P1()
 248 .end
 249 CODE
 250 /1 params expected/
 251 OUT
 252
 253 # '
 254
 255 # Local Variables:
 256 #   mode: cperl
 257 #   cperl-indent-level: 4
 258 #   fill-column: 100
 259 # End:
 260 # vim: expandtab shiftwidth=4: