2 # Copyright (C) 2001-2008, The Perl Foundation.
3 # $Id: lexicals-2.t 28939 2008-07-02 08:33:21Z chromatic $
7 use lib qw( . lib ../lib ../../lib );
10 use Parrot::Test tests => 3;
14 t/op/lexicals-2.t - Lexical Ops
18 % prove t/op/lexicals-2.t
22 More elaborate tests of closure and lexical variable operations.
27 pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Patrick's request" );
34 .sub 'foo' :lexid('foo')
42 .sub 'inner' :outer('foo')
60 pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Bob's recursion bug", todo => 'not working after r28763.');
66 .param int recursive_p
67 unless recursive_p goto do_lex
68 print "rpwi: recursive case\n"
71 .lex "(SAVED *SHARP-EQUAL-ALIST*)", $P40
74 .const .Sub $P80 = "(:INTERNAL rpwi 0)"
78 print "rpwi: lex case\n"
83 .sub "(:INTERNAL rpwi 0)" :anon :outer('rpwi')
84 print "[restoring *SHARP-EQUAL-ALIST*]\n"
85 find_lex $P40, "(SAVED *SHARP-EQUAL-ALIST*)"
93 [restoring *SHARP-EQUAL-ALIST*]
97 pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Jonathan's recursive case" );
99 $P0 = new 'ResizablePMCArray'
101 $P1 = new 'ResizablePMCArray'
102 $P2 = new 'ResizablePMCArray'
106 $P3 = new 'ResizablePMCArray'
113 'dump_thing'($P0, '# ')
120 .lex '$prefix', prefix
122 $P0 = find_global 'anon_1'
126 $P2 = find_lex '$thing'
127 $I0 = isa $P2, 'ResizablePMCArray'
128 unless $I0 goto not_ResizablePMCArray
130 $P3 = find_lex '$prefix'
133 $P4 = find_global 'anon_2'
135 $P6 = find_lex '$thing'
137 $P7 = find_lex '$prefix'
142 not_ResizablePMCArray:
143 $P8 = find_lex '$prefix'
145 $P9 = find_lex '$thing'
151 .sub 'anon_1' :outer('dump_thing')
153 .lex '$subthing', subthing
154 $P0 = find_lex '$subthing'
155 $P1 = find_lex '$prefix'
157 $P2 = concat $P1, ' '
158 'dump_thing'($P0, $P2)
161 .sub 'anon_2' :outer('dump_thing')
164 $P0 = find_lex '$recur'
172 .local pmc result, it
173 result = new 'ResizablePMCArray'
176 unless it goto loop_end