* t/op/lexicals-2.t (added), MANIFEST:
[parrot.git] / t / op / lexicals-2.t
blob89abe03dbee0e661c03ab8db9f1616e50cf4a889
1 #!perl
2 # Copyright (C) 2001-2008, The Perl Foundation.
3 # $Id: lexicals-2.t 28939 2008-07-02 08:33:21Z chromatic $
5 use strict;
6 use warnings;
7 use lib qw( . lib ../lib ../../lib );
9 use Test::More;
10 use Parrot::Test tests => 3;
12 =head1 NAME
14 t/op/lexicals-2.t - Lexical Ops
16 =head1 SYNOPSIS
18     % prove t/op/lexicals-2.t
20 =head1 DESCRIPTION
22 More elaborate tests of closure and lexical variable operations.
23 See PDD20.
25 =cut
27 pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398:  Patrick's request" );
28 .sub 'main' :main
29         foo('try 1')
30         foo('try 2')
31         foo('try 3')
32 .end
34 .sub 'foo' :lexid('foo')
35         .param pmc x
36         .lex '$x', x
37         print "outer foo "
38         say x
39         'inner'()
40 .end
42 .sub 'inner' :outer('foo')
43         .local pmc x
44         x = find_lex '$x'
45         print "inner foo "
46         say x
47         $P0 = new 'String'
48         $P0 = 'BOGUS!'
49         store_lex '$x', $P0
50 .end
51 CODE
52 outer foo try 1
53 inner foo try 1
54 outer foo try 2
55 inner foo try 2
56 outer foo try 3
57 inner foo try 3
58 OUTPUT
60 pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Bob's recursion bug", todo => 'not working after r28763.');
61 .sub main :main
62         rpwi(0)
63 .end
65 .sub rpwi
66         .param int recursive_p
67         unless recursive_p goto do_lex
68         print "rpwi:  recursive case\n"
69         .return ()
70 do_lex:
71         .lex "(SAVED *SHARP-EQUAL-ALIST*)", $P40
72         $P40 = new 'Integer'
73         $P40 = 99
74         .const .Sub $P80 = "(:INTERNAL rpwi 0)"
75         newclosure $P81, $P80
76         ## $P81 = clone $P80
77         ## pushaction $P81
78         print "rpwi:  lex case\n"
79         rpwi(1)
80         $P81()
81 .end
83 .sub "(:INTERNAL rpwi 0)" :anon :outer('rpwi')
84         print "[restoring *SHARP-EQUAL-ALIST*]\n"
85         find_lex $P40, "(SAVED *SHARP-EQUAL-ALIST*)"
86         print "[got "
87         print $P40
88         print "]\n"
89 .end
90 CODE
91 rpwi:  lex case
92 rpwi:  recursive case
93 [restoring *SHARP-EQUAL-ALIST*]
94 [got 99]
95 OUTPUT
97 pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Jonathan's recursive case" );
98 .sub 'main' :main
99     $P0 = new 'ResizablePMCArray'
100     push $P0, 'a'
101     $P1 = new 'ResizablePMCArray'
102     $P2 = new 'ResizablePMCArray'
103     push $P2, 'simple'
104     push $P1, $P2
105     push $P1, 'test'
106     $P3 = new 'ResizablePMCArray'
107     push $P3, 'for'
108     push $P3, 'a'
109     push $P3, 'simple'
110     push $P1, $P3
111     push $P0, $P1
112     push $P0, 'script'
113     'dump_thing'($P0, '# ')
114 .end
116 .sub 'dump_thing'
117     .param pmc thing
118     .param pmc prefix
119     .lex '$thing', thing
120     .lex '$prefix', prefix
122     $P0 = find_global 'anon_1'
123     $P1 = newclosure $P0
124     .lex '$recur', $P1
125     
126     $P2 = find_lex '$thing'
127     $I0 = isa $P2, 'ResizablePMCArray'
128     unless $I0 goto not_ResizablePMCArray
130     $P3 = find_lex '$prefix'
131     print $P3
132     print "[\n"
133     $P4 = find_global 'anon_2'
134     $P5 = newclosure $P4
135     $P6 = find_lex '$thing'
136     'map'($P5, $P6)
137     $P7 = find_lex '$prefix'
138     print $P7
139     print "]\n"
140     goto end_if
142   not_ResizablePMCArray:
143     $P8 = find_lex '$prefix'
144     print $P8
145     $P9 = find_lex '$thing'
146     print $P9
147     print "\n"
148   end_if:
149 .end
151 .sub 'anon_1' :outer('dump_thing')
152     .param pmc subthing
153     .lex '$subthing', subthing
154     $P0 = find_lex '$subthing'
155     $P1 = find_lex '$prefix'
156     $P2 = new 'String'
157     $P2 = concat $P1, '    '
158    'dump_thing'($P0, $P2)
159 .end
161 .sub 'anon_2' :outer('dump_thing')
162     .param pmc topic
163     .lex "$_", topic
164     $P0 = find_lex '$recur'
165     $P1 = find_lex '$_'
166     $P0($P1)
167 .end
169 .sub 'map'
170     .param pmc block
171     .param pmc array
172     .local pmc result, it
173     result = new 'ResizablePMCArray'
174     it = iter array
175     loop:
176     unless it goto loop_end
177     $P0 = shift it
178     $P0 = block($P0)
179     push result, $P0
180     goto loop
181     loop_end:
182     .return (result)
183 .end
184 CODE
185 # [
186 #     a
187 #     [
188 #         [
189 #             simple
190 #         ]
191 #         test
192 #         [
193 #             for
194 #             a
195 #             simple
196 #         ]
197 #     ]
198 #     script
199 # ]
200 OUTPUT