t/pmc/coroutine.t

   1 #! perl
   2 # Copyright (C) 2001-2005, 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/coroutines.t - Coroutines
  14
  15 =head1 SYNOPSIS
  16
  17     % prove t/pmc/coroutines.t
  18
  19 =head1 DESCRIPTION
  20
  21 Tests the C<Coroutine> PMC.
  22
  23 =cut
  24
  25 pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine 1" );
  26 .include "interpinfo.pasm"
  27 .pcc_sub _main:
  28     .const .Sub P0 = "_coro"
  29     new P10, 'Integer'
  30     set P10, 2
  31     set_global "i", P10
  32 lp:
  33     invokecc P0
  34     print "back "
  35     print P10
  36     print "\n"
  37     if P10, lp
  38     print "done\n"
  39     end
  40 .pcc_sub _coro:
  41 loop:
  42     get_global P11, "i"
  43     dec P11
  44     yield
  45     branch loop
  46 CODE
  47 back 1
  48 back 0
  49 done
  50 OUTPUT
  51
  52 pir_output_is( <<'CODE', <<'OUTPUT', "Coroutines - M. Wallace yield example" );
  53
  54 .sub __main__
  55     .local pmc return
  56     .local pmc counter
  57     .const .Sub itr = "_iterator"
  58
  59     .local pmc zero
  60     zero = new 'Integer'
  61     zero = 0
  62
  63     new return, 'Continuation'
  64     set_addr return, return_here
  65     loop:
  66         .begin_call
  67             .call itr, return
  68             .result counter
  69         .end_call
  70
  71         print counter
  72         print " "
  73
  74         zero = 0
  75         print zero
  76         print "\n"
  77     goto loop
  78 return_here:
  79     .get_results ()
  80     end
  81 .end
  82
  83 .sub _iterator
  84     .local pmc x
  85     x = new 'Integer'
  86     x = 0
  87     iloop:
  88         .begin_yield
  89         .return x
  90         .end_yield
  91         x = x + 1
  92     if x <= 10 goto iloop
  93     returncc
  94 .end
  95 CODE
  96 0 0
  97 1 0
  98 2 0
  99 3 0
 100 4 0
 101 5 0
 102 6 0
 103 7 0
 104 8 0
 105 9 0
 106 10 0
 107 OUTPUT
 108
 109 pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in main" );
 110 .include "interpinfo.pasm"
 111 _main:
 112     .const .Sub P0 = "_coro"
 113     push_eh _catchm
 114     new P16, 'Integer'
 115     set P16, 2
 116     set_global "i", P16
 117 lp:
 118     invokecc P0
 119     print "back "
 120     print P16
 121     print "\n"
 122     null S0
 123     get_global P17, S0
 124     if P16, lp
 125     print "done\n"
 126     end
 127 _catchm:
 128     get_results '0, 0' , P5, S0
 129     print "catch main\n"
 130     end
 131
 132 .pcc_sub _coro:
 133     push_eh _catchc
 134 corolp:
 135     get_global P17, "i"
 136     dec P17
 137     yield
 138     branch corolp
 139 _catchc:
 140     get_results '0, 0' , P5, S0
 141     print "catch coro\n"
 142     end
 143 CODE
 144 back 1
 145 catch main
 146 OUTPUT
 147
 148 pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in coro" );
 149 .include "interpinfo.pasm"
 150 _main:
 151     .const .Sub P0 = "_coro"
 152     push_eh _catchm
 153     new P16, 'Integer'
 154     set P16, 2
 155     set_global "i", P16
 156 lp:
 157     invokecc P0
 158     print "back "
 159     print P16
 160     print "\n"
 161     if P16, lp
 162     print "done\n"
 163     end
 164 _catchm:
 165     get_results '0, 0' , P5, S0
 166     print "catch main\n"
 167     end
 168
 169 .pcc_sub _coro:
 170     push_eh _catchc
 171 corolp:
 172     get_global P17, "i"
 173     dec P17
 174     yield
 175     null S0
 176     get_global P17, S0
 177     branch corolp
 178 _catchc:
 179     get_results '0, 0' , P5, S0
 180     print "catch coro\n"
 181     end
 182 CODE
 183 back 1
 184 catch coro
 185 OUTPUT
 186
 187 pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in coro no handler" );
 188 .include "interpinfo.pasm"
 189 _main:
 190     .const .Sub P0 = "_coro"
 191     push_eh _catchm
 192     new P16, 'Integer'
 193     set P16, 2
 194     set_global "i", P16
 195 lp:
 196     invokecc P0
 197     print "back "
 198     print P16
 199     print "\n"
 200     if P16, lp
 201     print "done\n"
 202     end
 203 _catchm:
 204     get_results '0, 0' , P5, S0
 205     print "catch main\n"
 206     end
 207 .pcc_sub _coro:
 208 corolp:
 209     get_global P17, "i"
 210     dec P17
 211     yield
 212     null S0
 213     get_global P17, S0
 214     branch corolp
 215 _catchc:
 216     print "catch coro\n"
 217     end
 218 CODE
 219 back 1
 220 catch main
 221 OUTPUT
 222
 223 pasm_output_is( <<'CODE', <<'OUTPUT', "Coroutine - exception in coro rethrow" );
 224 .include "interpinfo.pasm"
 225 _main:
 226     .const .Sub P0 = "_coro"
 227     push_eh _catchm
 228     new P16, 'Integer'
 229     set P16, 2
 230     set_global "i", P16
 231 lp:
 232     invokecc P0
 233     print "back "
 234     print P16
 235     print "\n"
 236     if P16, lp
 237     print "done\n"
 238     end
 239 _catchm:
 240     get_results '0, 0' , P5, S0
 241     print "catch main\n"
 242     end
 243
 244 .pcc_sub _coro:
 245     push_eh _catchc
 246 corolp:
 247     get_global P17, "i"
 248     dec P17
 249     yield
 250     null S0
 251     get_global P17, S0
 252     branch corolp
 253 _catchc:
 254     get_results '0, 0' , P5, S0
 255     print "catch coro\n"
 256     rethrow P5
 257     end
 258 CODE
 259 back 1
 260 catch coro
 261 catch main
 262 OUTPUT
 263
 264 pir_output_is( <<'CODE', 'Coroutine', "Coro new - type" );
 265
 266 .sub main :main
 267     .local pmc c
 268     c = global "coro"
 269     typeof S0, c
 270     print S0
 271 .end
 272 .sub coro
 273     .local pmc x
 274     x = new 'Integer'
 275     x = 0
 276     iloop:
 277         .yield (x)
 278         x = x + 1
 279     if x <= 4 goto iloop
 280 .end
 281 CODE
 282
 283 pir_output_is( <<'CODE', '01234', "Coro new - yield" );
 284
 285 .sub main :main
 286     .local pmc c
 287     c = global "coro"
 288 loop:
 289     .begin_call
 290     .call c
 291     .result   $P0 :optional
 292     .result   $I0 :opt_flag
 293     .end_call
 294     unless $I0,  ex
 295     print $P0
 296     goto loop
 297 ex:
 298 .end
 299 .sub coro
 300     .local pmc x
 301     x = new 'Integer'
 302     x = 0
 303     iloop:
 304         .yield (x)
 305         x = x + 1
 306     if x <= 4 goto iloop
 307 .end
 308 CODE
 309
 310 pir_output_like(
 311     <<'CODE', <<'OUTPUT', "Call an exited coroutine", todo => 'goes one iteration too far.' );
 312 .sub main :main
 313     .local pmc c
 314     c = global "coro"
 315 loop:
 316     $P0 = c()
 317     print $P0
 318     goto loop
 319 .end
 320 .sub coro
 321     .local pmc x
 322     x = new 'Integer'
 323     x = 0
 324     iloop:
 325         .yield (x)
 326         x = x + 1
 327     if x <= 4 goto iloop
 328 .end
 329 CODE
 330 /\A01234Cannot resume dead coroutine/
 331 OUTPUT
 332
 333 pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
 334
 335 .sub _main
 336     .local pmc pmc1
 337     pmc1 = new 'Coroutine'
 338     .local int bool1
 339     does bool1, pmc1, "scalar"      # XXX WTF
 340     print bool1
 341     print "\n"
 342     does bool1, pmc1, "no_interface"
 343     print bool1
 344     print "\n"
 345     end
 346 .end
 347 CODE
 348 1
 349 0
 350 OUTPUT
 351
 352 pir_output_is( <<'CODE', <<'OUTPUT', "re-entering coro from another sub" );
 353
 354 .sub main :main
 355     .local int z
 356     .const .Sub corou = "_coroufn"
 357     corou("from main")
 358     z = 0
 359   loop:
 360     unless z < 4 goto end
 361     met(corou)
 362     inc z
 363     goto loop
 364   end:
 365 .end
 366
 367 .sub met
 368     .param pmc corou
 369     corou()
 370 .end
 371
 372 .sub _coroufn
 373     .param string x
 374     .local int j
 375     print "coroutine: first call "
 376     print x
 377     print "\n"
 378     j = 0
 379   coroufn_1:
 380     inc j
 381     print "yield #"
 382     print j
 383     print "\n"
 384     .yield()
 385     goto coroufn_1
 386 .end
 387 CODE
 388 coroutine: first call from main
 389 yield #1
 390 yield #2
 391 yield #3
 392 yield #4
 393 yield #5
 394 OUTPUT
 395
 396 # Local Variables:
 397 #   mode: cperl
 398 #   cperl-indent-level: 4
 399 #   fill-column: 100
 400 # End:
 401 # vim: expandtab shiftwidth=4: