t/pmc/continuation.t

   1 #!./parrot
   2 # Copyright (C) 2006-2010, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/pmc/continuation.t - test Continuation PMC
   8
   9 =head1 SYNOPSIS
  10
  11     % prove t/pmc/continuation.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests the Continuation PMC.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21     plan(4)
  22
  23     test_new()
  24     invoke_with_init()
  25     returns_tt1511()
  26     returns_tt1528()
  27 .end
  28
  29 .sub test_new
  30     $P0 = new ['Continuation']
  31     ok(1, "new Continuation didn't explode")
  32 .end
  33
  34 .sub invoke_with_init
  35     $P0 = new ['Continuation']
  36     set_addr $P0, L1
  37     $P0()
  38     ok(0, "didn't call continuation")
  39     goto end
  40 L1:
  41     ok(1, "called continuation")
  42     goto end
  43 end:
  44 .end
  45
  46 .sub 'choose'
  47     .param int do_tailcall
  48     .param pmc options :slurpy
  49     .local pmc cc
  50     .local pmc chosen
  51     .local pmc paths
  52
  53     if options goto got_options
  54     'fail'()
  55   got_options:
  56     chosen = shift options
  57
  58     cc = new 'Continuation'
  59     set_addr cc, recurse
  60     paths = get_global '!paths'
  61     push paths, cc
  62
  63     $P0  = get_global '!results'
  64     push $P0, chosen
  65     .return (chosen)
  66
  67   recurse:
  68     if do_tailcall goto tail
  69     $P0 = 'choose'(do_tailcall, options :flat)
  70     .return($P0)
  71   tail:
  72     .tailcall 'choose'(do_tailcall, options :flat)
  73 .end
  74
  75 .sub 'fail'
  76     .local pmc cc
  77     .local pmc paths
  78
  79     paths = get_global '!paths'
  80
  81     if paths goto got_paths
  82     cc = get_global '!topcc'
  83     goto call_cc
  84   got_paths:
  85     cc = shift paths
  86
  87   call_cc:
  88     cc()
  89 .end
  90
  91 .sub 'blob'
  92     .param int do_tailcall
  93
  94     .local pmc city
  95     .local pmc store
  96     .local pmc bx
  97     .local pmc paths
  98
  99     paths = new 'ResizablePMCArray'
 100     set_global '!paths', paths
 101
 102     city = 'choose'(do_tailcall, "la", "ny", "bos")
 103     $P0  = get_global '!results'
 104     push $P0, city
 105     push $P0, ' '
 106
 107     'fail'()
 108 .end
 109
 110 .sub 'returns_tt1511'
 111     .local pmc cc
 112
 113     # Install top-level cc in global.
 114     cc = new 'Continuation'
 115     set_addr cc, final_failure
 116     set_global '!topcc', cc
 117
 118     $P0 = new 'ResizableStringArray'
 119     set_global '!results', $P0
 120
 121     'blob'(1)
 122   final_failure:
 123     $S0 = join '', $P0
 124     is('lala nyny bosbos ', $S0, 'Results processed correctly')
 125 .end
 126
 127 .sub 'returns_tt1528'
 128     .local pmc cc
 129
 130     # Install top-level cc in global.
 131     cc = new 'Continuation'
 132     set_addr cc, final_failure
 133     set_global '!topcc', cc
 134
 135     $P0 = new 'ResizableStringArray'
 136     set_global '!results', $P0
 137
 138     'blob'(0)
 139   final_failure:
 140     $S0 = join '', $P0
 141     is('lala nyny bosbos ', $S0, 'Results processed correctly - without .tailcall')
 142 .end
 143
 144 # end of tests.
 145
 146 # Local Variables:
 147 #   mode: pir
 148 #   fill-column: 100
 149 # End:
 150 # vim: expandtab shiftwidth=4 ft=pir: