t/compilers/imcc/syn/objects.t

   1 #!perl
   2 # Copyright (C) 2001-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::Config;
  10 use Parrot::Test tests => 13;
  11
  12 ##############################
  13 # ".namespace" sanity
  14
  15 pir_output_is( <<'CODE', <<'OUT', "different namespace declarations");
  16
  17 .namespace ["Foo"]
  18 .namespace [ ]
  19 .namespace []
  20
  21 .sub test :main
  22     print "ok\n"
  23 .end
  24 CODE
  25 ok
  26 OUT
  27
  28 ##############################
  29 # Parrot Calling Conventions
  30
  31 pir_output_is( <<'CODE', <<'OUT', "meth call syntax" );
  32
  33 .sub test :main
  34     .local pmc class
  35     .local pmc obj
  36     newclass class, "Foo"
  37     obj = new "Foo"
  38     obj._meth()
  39     print "done\n"
  40     end
  41 .end
  42
  43 .namespace [ "Foo" ]
  44 .sub _meth :method
  45     print "in meth\n"
  46 .end
  47 CODE
  48 in meth
  49 done
  50 OUT
  51
  52 pir_output_is( <<'CODE', <<'OUT', "meth call syntax m.o(arg)" );
  53 .sub test :main
  54     .local pmc class
  55     .local pmc obj
  56     newclass class, "Foo"
  57     obj = new "Foo"
  58     $P0 = new 'String'
  59     $P0 = "ok\n"
  60     obj._meth($P0)
  61     print "done\n"
  62     end
  63 .end
  64
  65 .namespace [ "Foo" ]
  66 .sub _meth :method
  67     .param pmc s
  68     print "in meth\n"
  69     print s
  70 .end
  71 CODE
  72 in meth
  73 ok
  74 done
  75 OUT
  76
  77 pir_output_is( <<'CODE', <<'OUT', "meth call ret = o.m(arg)" );
  78 .sub test :main
  79     .local pmc class
  80     .local pmc obj
  81     newclass class, "Foo"
  82     obj = new "Foo"
  83     $P0 = new 'String'
  84     $P0 = "ok\n"
  85     $S0 = obj._meth($P0)
  86     print $S0
  87     end
  88 .end
  89
  90 .namespace [ "Foo" ]
  91 .sub _meth :method
  92     .param pmc s
  93     print "in meth\n"
  94     print s
  95     .begin_return
  96     .return "done\n"
  97     .end_return
  98 .end
  99 CODE
 100 in meth
 101 ok
 102 done
 103 OUT
 104
 105 pir_output_is( <<'CODE', <<'OUT', "meth call syntax, string" );
 106 .sub test :main
 107     .local pmc class
 108     .local pmc obj
 109     .local string meth
 110     meth = "_meth"
 111     newclass class, "Foo"
 112     obj = new "Foo"
 113     obj."_meth"()
 114     obj._meth()
 115     set S10, "_meth"
 116     obj.S10()
 117     set $S10, "_meth"
 118     obj.$S10()
 119     print "done\n"
 120     end
 121 .end
 122 .namespace [ "Foo" ]
 123 .sub _meth :method
 124     print "in meth\n"
 125 .end
 126 CODE
 127 in meth
 128 in meth
 129 in meth
 130 in meth
 131 done
 132 OUT
 133
 134 pir_output_is( <<'CODE', <<'OUT', "initializer" );
 135 .sub test :main
 136     newclass P1, "Foo"
 137     subclass P2, P1, "Bar"
 138     subclass P3, P2, "Baz"
 139     P3 = new "Baz"
 140     get_global P0, "_sub"
 141     invokecc P0
 142     print "done\n"
 143     end
 144 .end
 145
 146 .namespace ["Foo"]
 147 .sub init :vtable :method
 148     print "foo_init\n"
 149 .end
 150
 151 .namespace ["Bar"]
 152 .sub init :vtable :method
 153     print "bar_init\n"
 154 .end
 155
 156 .namespace ["Baz"]
 157 .sub init :vtable :method
 158     print "baz_init\n"
 159 .end
 160
 161 .namespace  # main again
 162 .sub _sub
 163     print "in sub\n"
 164 .end
 165 CODE
 166 foo_init
 167 bar_init
 168 baz_init
 169 in sub
 170 done
 171 OUT
 172
 173 pir_output_is( <<'CODE', <<'OUT', "meth call syntax - method, self" );
 174
 175 .sub test :main
 176     .local pmc class
 177     .local pmc obj
 178     newclass class, "Foo"
 179     obj = new "Foo"
 180     obj._meth()
 181     print "done\n"
 182     end
 183 .end
 184
 185 .namespace [ "Foo" ]
 186 .sub _meth :method
 187     print "in meth\n"
 188     isa $I0, self, "Foo"
 189     if $I0, ok
 190     print "not "
 191 ok:
 192     print "ok\n"
 193 .end
 194 CODE
 195 in meth
 196 ok
 197 done
 198 OUT
 199
 200 pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax" );
 201
 202 .sub test :main
 203     .local pmc class
 204     .local pmc obj
 205     newclass class, "Foo"
 206     obj = new "Foo"
 207     .begin_call
 208     .invocant obj
 209     .meth_call "_meth"
 210     .end_call
 211     print "done\n"
 212     end
 213 .end
 214
 215 .namespace [ "Foo" ]
 216 .sub _meth :method
 217     print "in meth\n"
 218 .end
 219 CODE
 220 in meth
 221 done
 222 OUT
 223
 224 pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax, meth var" );
 225
 226 .sub test :main
 227     .local pmc class
 228     .local pmc obj
 229     .local string meth
 230     newclass class, "Foo"
 231     obj = new "Foo"
 232     meth = "_me"
 233     meth = meth . "th"  # test concat to
 234     .begin_call
 235     .invocant obj
 236     .meth_call meth
 237     .end_call
 238     print "done\n"
 239     end
 240 .end
 241
 242 .namespace [ "Foo" ]
 243 .sub _meth :method
 244     print "in meth\n"
 245 .end
 246 CODE
 247 in meth
 248 done
 249 OUT
 250 pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax, args" );
 251
 252 .sub test :main
 253     .local pmc class
 254     .local pmc obj
 255     newclass class, "Foo"
 256     obj = new "Foo"
 257     .begin_call
 258     .arg "hello"
 259     .arg "\n"
 260     .invocant obj
 261     .meth_call "_meth"
 262     .result $S0
 263     .end_call
 264     print $S0
 265     print "done\n"
 266     end
 267 .end
 268
 269 .namespace [ "Foo" ]
 270 .sub _meth :method
 271     .param string p1
 272     .param string p2
 273     print "in meth\n"
 274     print p1
 275     print p2
 276     .begin_return
 277     .return "ok\n"
 278     .end_return
 279 .end
 280 CODE
 281 in meth
 282 hello
 283 ok
 284 done
 285 OUT
 286
 287 pir_output_is( <<'CODE', <<'OUT', "explicit meth call syntax" );
 288
 289 .sub test :main
 290     .local pmc class
 291     .local pmc obj
 292     newclass class, "Foo"
 293     obj = new "Foo"
 294     .begin_call
 295     .invocant obj
 296     .meth_call "_meth"
 297     .end_call
 298     print "done\n"
 299     end
 300 .end
 301
 302 .namespace [ "Foo" ]
 303 .sub _meth :method
 304     print "in meth\n"
 305 .end
 306 CODE
 307 in meth
 308 done
 309 OUT
 310
 311 pir_output_is( <<'CODE', <<'OUT', "meth call syntax - reserved word" );
 312
 313 .sub test :main
 314     .local pmc class
 315     .local pmc obj
 316     newclass class, "Foo"
 317     obj = new "Foo"
 318     obj.open()
 319     print "done\n"
 320     end
 321 .end
 322
 323 .namespace [ "Foo" ]
 324 .sub open :method
 325     print "in meth\n"
 326 .end
 327 CODE
 328 in meth
 329 done
 330 OUT
 331
 332 pir_output_is( <<'CODE', <<'OUT', ":vtable implies self (see RT #47674)" );
 333 .sub 'main' :main
 334     $P1 = newclass "Foo"
 335     $P2 = new "Foo"
 336     $S1 = $P2
 337     print $S1
 338 .end
 339
 340 .namespace [ "Foo" ]
 341
 342 .sub 'get_string' :vtable
 343     self.'bar'()
 344     .return ("stringy thingy\n")
 345 .end
 346
 347 .sub bar :method
 348     print "called bar\n"
 349 .end
 350 CODE
 351 called bar
 352 stringy thingy
 353 OUT
 354
 355 # Local Variables:
 356 #   mode: cperl
 357 #   cperl-indent-level: 4
 358 #   fill-column: 100
 359 # End:
 360 # vim: expandtab shiftwidth=4: