|
996
|
1 # test bytecode interpreter - registers
|
|
|
2
|
|
|
3 # Copyright (c) 2006-2008 Claudio Calvelli, all rights reserved.
|
|
|
4
|
|
|
5 # CLC-INTERCAL is copyrighted software. However, permission to use, modify,
|
|
|
6 # and distribute it is granted provided that the conditions set out in the
|
|
|
7 # licence agreement are met. See files README and COPYING in the distribution.
|
|
|
8
|
|
|
9 use Language::INTERCAL::GenericIO '1.-94.-2', qw($devnull);
|
|
|
10 use Language::INTERCAL::Interpreter '1.-94.-2';
|
|
|
11 use Language::INTERCAL::Rcfile '1.-94.-2';
|
|
|
12 use Language::INTERCAL::ByteCode '1.-94.-2', qw(:BC reg_code);
|
|
|
13 use Language::INTERCAL::Splats '1.-94.-2', qw(:SP);
|
|
|
14 use Language::INTERCAL::ReadNumbers '1.-94.-2', qw(roman_type);
|
|
|
15 use Language::INTERCAL::ArrayIO '1.-94.-2', qw(iotype);
|
|
|
16 use Language::INTERCAL::Charset '1.-94.-2', qw(charset);
|
|
|
17
|
|
|
18 my @all_tests = (
|
|
|
19 ["Spot 1", { '.1' => 1234 }, { '.1' => 5678 }, undef, undef,
|
|
|
20 [BC_STO, BC(5678), BC_SPO, BC(1)]],
|
|
|
21 ["Spot 2", { }, { }, undef, SP_NOARRAY,
|
|
|
22 [BC_STO, BC(666), BC_SUB, BC(6), BC_SPO, BC(1)]],
|
|
|
23 ["Spot 3", { }, { }, undef, SP_NUMBER,
|
|
|
24 [BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), BC_SPO, BC(1)]],
|
|
|
25 ["Two Spot 1", { ':1' => 1234 }, { ':1' => 5678 }, undef, undef,
|
|
|
26 [BC_STO, BC(5678), BC_TSP, BC(1)]],
|
|
|
27 ["Two spot 2", { }, { }, undef, SP_NOARRAY,
|
|
|
28 [BC_STO, BC(666), BC_SUB, BC(6), BC_TSP, BC(1)]],
|
|
|
29 ["Two spot 3", { }, { }, undef, SP_NUMBER,
|
|
|
30 [BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), BC_TSP, BC(1)]],
|
|
|
31 ["Tail 1", { }, { }, undef, SP_NODIM,
|
|
|
32 [BC_STO, BC(666), BC_SUB, BC(6), BC_TAI, BC(1)]],
|
|
|
33 ["Tail 2", { }, { ',1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
|
|
|
34 [BC_STO, BC(6), BC_TAI, BC(1)],
|
|
|
35 [BC_STO, BC(8), BC_SUB, BC(1), BC_TAI, BC(1)],
|
|
|
36 [BC_STO, BC(9), BC_SUB, BC(2), BC_TAI, BC(1)],
|
|
|
37 [BC_STO, BC(12), BC_SUB, BC(3), BC_TAI, BC(1)],
|
|
|
38 [BC_STO, BC(1), BC_SUB, BC(4), BC_TAI, BC(1)],
|
|
|
39 [BC_STO, BC(69), BC_SUB, BC(5), BC_TAI, BC(1)],
|
|
|
40 [BC_STO, BC(666), BC_SUB, BC(6), BC_TAI, BC(1)]],
|
|
|
41 ["Tail 3", { }, { ',1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
|
|
|
42 [BC_STO, BC_MUL, BC(2), BC(2), BC(3), BC_TAI, BC(1)],
|
|
|
43 [BC_STO, BC(8), BC_SUB, BC(1), BC_SUB, BC(1), BC_TAI, BC(1)],
|
|
|
44 [BC_STO, BC(9), BC_SUB, BC(2), BC_SUB, BC(1), BC_TAI, BC(1)],
|
|
|
45 [BC_STO, BC(12), BC_SUB, BC(3), BC_SUB, BC(1), BC_TAI, BC(1)],
|
|
|
46 [BC_STO, BC(1), BC_SUB, BC(1), BC_SUB, BC(2), BC_TAI, BC(1)],
|
|
|
47 [BC_STO, BC(69), BC_SUB, BC(2), BC_SUB, BC(2), BC_TAI, BC(1)],
|
|
|
48 [BC_STO, BC(666), BC_SUB, BC(3), BC_SUB, BC(2), BC_TAI, BC(1)]],
|
|
|
49 ["Hybrid 1", { }, { }, undef, SP_NODIM,
|
|
|
50 [BC_STO, BC(666), BC_SUB, BC(6), BC_HYB, BC(1)]],
|
|
|
51 ["Hybrid 2", { }, { ';1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
|
|
|
52 [BC_STO, BC(6), BC_HYB, BC(1)],
|
|
|
53 [BC_STO, BC(8), BC_SUB, BC(1), BC_HYB, BC(1)],
|
|
|
54 [BC_STO, BC(9), BC_SUB, BC(2), BC_HYB, BC(1)],
|
|
|
55 [BC_STO, BC(12), BC_SUB, BC(3), BC_HYB, BC(1)],
|
|
|
56 [BC_STO, BC(1), BC_SUB, BC(4), BC_HYB, BC(1)],
|
|
|
57 [BC_STO, BC(69), BC_SUB, BC(5), BC_HYB, BC(1)],
|
|
|
58 [BC_STO, BC(666), BC_SUB, BC(6), BC_HYB, BC(1)]],
|
|
|
59 ["Hybrid 3", { }, { ';1' => [8, 9, 12, 1, 69, 666] }, undef, undef,
|
|
|
60 [BC_STO, BC_MUL, BC(2), BC(2), BC(3), BC_HYB, BC(1)],
|
|
|
61 [BC_STO, BC(8), BC_SUB, BC(1), BC_SUB, BC(1), BC_HYB, BC(1)],
|
|
|
62 [BC_STO, BC(9), BC_SUB, BC(2), BC_SUB, BC(1), BC_HYB, BC(1)],
|
|
|
63 [BC_STO, BC(12), BC_SUB, BC(3), BC_SUB, BC(1), BC_HYB, BC(1)],
|
|
|
64 [BC_STO, BC(1), BC_SUB, BC(1), BC_SUB, BC(2), BC_HYB, BC(1)],
|
|
|
65 [BC_STO, BC(69), BC_SUB, BC(2), BC_SUB, BC(2), BC_HYB, BC(1)],
|
|
|
66 [BC_STO, BC(666), BC_SUB, BC(3), BC_SUB, BC(2), BC_HYB, BC(1)]],
|
|
|
67 ["%WT 0", { }, { '%WT' => 0 }, undef, undef,
|
|
|
68 [BC_STO, BC(0), reg_code('%WT')]],
|
|
|
69 ["%WT 1", { }, { '%WT' => 1 }, undef, undef,
|
|
|
70 [BC_STO, BC(1), reg_code('%WT')]],
|
|
|
71 ["%WT 2", { }, { }, undef, SP_NOASSIGN,
|
|
|
72 [BC_STO, BC(2), reg_code('%WT')]],
|
|
|
73 ["%RT CLC", { }, { '%RT' => roman_type('CLC') }, undef, undef,
|
|
|
74 [BC_STO, _str('CLC'), reg_code('%RT')]],
|
|
|
75 ["%RT UNDERLINE", { }, { '%RT' => roman_type('UNDERLINE') }, undef, undef,
|
|
|
76 [BC_STO, _str('UNDERLINE'), reg_code('%RT')]],
|
|
|
77 ["%RT ARCHAIC", { }, { '%RT' => roman_type('ARCHAIC') }, undef, undef,
|
|
|
78 [BC_STO, _str('ARCHAIC'), reg_code('%RT')]],
|
|
|
79 ["%RT MEDIAEVAL", { }, { '%RT' => roman_type('MEDIAEVAL') }, undef, undef,
|
|
|
80 [BC_STO, _str('MEDIAEVAL'), reg_code('%RT')]],
|
|
|
81 ["%RT MODERN", { }, { '%RT' => roman_type('MODERN') }, undef, undef,
|
|
|
82 [BC_STO, _str('MODERN'), reg_code('%RT')]],
|
|
|
83 ["%RT TRADITIONAL", { }, { '%RT' => roman_type('TRADITIONAL') }, undef, undef,
|
|
|
84 [BC_STO, _str('TRADITIONAL'), reg_code('%RT')]],
|
|
|
85 ["%RT WIMPMODE", { }, { '%RT' => roman_type('WIMPMODE') }, undef, undef,
|
|
|
86 [BC_STO, _str('WIMPMODE'), reg_code('%RT')]],
|
|
|
87 ["%RT INVALID", { }, { }, undef, SP_ROMAN,
|
|
|
88 [BC_STO, _str('INVALID'), reg_code('%RT')]],
|
|
|
89 ["%IO CLC", { }, { '%IO' => iotype('CLC') }, undef, undef,
|
|
|
90 [BC_STO, _str('CLC'), reg_code('%IO')]],
|
|
|
91 ["%IO C", { }, { '%IO' => iotype('C') }, undef, undef,
|
|
|
92 [BC_STO, _str('C'), reg_code('%IO')]],
|
|
|
93 ["%IO 1972", { }, { '%IO' => iotype('1972') }, undef, undef,
|
|
|
94 [BC_STO, _str('1972'), reg_code('%IO')]],
|
|
|
95 ["%IO INVALID", { }, { }, undef, SP_IOTYPE,
|
|
|
96 [BC_STO, _str('INVALID'), reg_code('%IO')]],
|
|
|
97 ["%BA 1", { }, { }, undef, SP_BASE,
|
|
|
98 [BC_STO, BC(1), reg_code('%BA')]],
|
|
|
99 ["%BA 2", { }, { '%BA' => 2 }, undef, undef,
|
|
|
100 [BC_STO, BC(2), reg_code('%BA')]],
|
|
|
101 ["%BA 3", { }, { '%BA' => 3 }, undef, undef,
|
|
|
102 [BC_STO, BC(3), reg_code('%BA')]],
|
|
|
103 ["%BA 4", { }, { '%BA' => 4 }, undef, undef,
|
|
|
104 [BC_STO, BC(4), reg_code('%BA')]],
|
|
|
105 ["%BA 5", { }, { '%BA' => 5 }, undef, undef,
|
|
|
106 [BC_STO, BC(5), reg_code('%BA')]],
|
|
|
107 ["%BA 6", { }, { '%BA' => 6 }, undef, undef,
|
|
|
108 [BC_STO, BC(6), reg_code('%BA')]],
|
|
|
109 ["%BA 7", { }, { '%BA' => 7 }, undef, undef,
|
|
|
110 [BC_STO, BC(7), reg_code('%BA')]],
|
|
|
111 ["%BA 8", { }, { }, undef, SP_BASE,
|
|
|
112 [BC_STO, BC(8), reg_code('%BA')]],
|
|
|
113 ["%CF 0", { }, { '%CF' => 0 }, undef, undef,
|
|
|
114 [BC_STO, BC(0), reg_code('%CF')]],
|
|
|
115 ["%CF 1", { }, { '%CF' => 1 }, undef, undef,
|
|
|
116 [BC_STO, BC(1), reg_code('%CF')]],
|
|
|
117 ["%CF 2", { }, { '%CF' => 2 }, undef, undef,
|
|
|
118 [BC_STO, BC(2), reg_code('%CF')]],
|
|
|
119 ["%CF 3", { }, { '%CF' => 3 }, undef, undef,
|
|
|
120 [BC_STO, BC(3), reg_code('%CF')]],
|
|
|
121 ["%CF 4", { }, { }, undef, SP_NOASSIGN,
|
|
|
122 [BC_STO, BC(4), reg_code('%CF')]],
|
|
|
123 ["%CR ASCII", { }, { '%CR' => charset('ASCII') }, undef, undef,
|
|
|
124 [BC_STO, _str('ASCII'), reg_code('%CR')]],
|
|
|
125 ["%CR Baudot", { }, { '%CR' => charset('Baudot') }, undef, undef,
|
|
|
126 [BC_STO, _str('Baudot'), reg_code('%CR')]],
|
|
|
127 ["%CR EBCDIC", { }, { '%CR' => charset('EBCDIC') }, undef, undef,
|
|
|
128 [BC_STO, _str('EBCDIC'), reg_code('%CR')]],
|
|
|
129 ["%CR Hollerith", { }, { '%CR' => charset('Hollerith') }, undef, undef,
|
|
|
130 [BC_STO, _str('Hollerith'), reg_code('%CR')]],
|
|
|
131 ["%CR INVALID", { }, { }, undef, SP_CHARSET,
|
|
|
132 [BC_STO, _str('INVALID'), reg_code('%CR')]],
|
|
|
133 ["%CW ASCII", { }, { '%CW' => charset('ASCII') }, undef, undef,
|
|
|
134 [BC_STO, _str('ASCII'), reg_code('%CW')]],
|
|
|
135 ["%CW Baudot", { }, { '%CW' => charset('Baudot') }, undef, undef,
|
|
|
136 [BC_STO, _str('Baudot'), reg_code('%CW')]],
|
|
|
137 ["%CW EBCDIC", { }, { '%CW' => charset('EBCDIC') }, undef, undef,
|
|
|
138 [BC_STO, _str('EBCDIC'), reg_code('%CW')]],
|
|
|
139 ["%CW Hollerith", { }, { '%CW' => charset('Hollerith') }, undef, undef,
|
|
|
140 [BC_STO, _str('Hollerith'), reg_code('%CW')]],
|
|
|
141 ["%CW INVALID", { }, { }, undef, SP_CHARSET,
|
|
|
142 [BC_STO, _str('INVALID'), reg_code('%CW')]],
|
|
|
143 ["%OS 1", { '%OS' => 1234 }, { '%OS' => 5678 }, undef, undef,
|
|
|
144 [BC_STO, BC(5678), reg_code('%OS')]],
|
|
|
145 ["%OS 2", { }, { }, undef, SP_NOARRAY,
|
|
|
146 [BC_STO, BC(666), BC_SUB, BC(6), reg_code('%OS')]],
|
|
|
147 ["%OS 3", { }, { }, undef, SP_NUMBER,
|
|
|
148 [BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), reg_code('%OS')]],
|
|
|
149 ["%TM 0", { }, { '%TM' => 0 }, undef, undef,
|
|
|
150 [BC_STO, BC(0), reg_code('%TM')]],
|
|
|
151 ["%TM 1", { }, { '%TM' => 1 }, undef, undef,
|
|
|
152 [BC_STO, BC(1), reg_code('%TM')]],
|
|
|
153 ["%TM 2", { }, { }, undef, SP_NOASSIGN,
|
|
|
154 [BC_STO, BC(2), reg_code('%TM')]],
|
|
|
155 ["%AR 1", { '%AR' => 1234 }, { '%AR' => 5678 }, undef, undef,
|
|
|
156 [BC_STO, BC(5678), reg_code('%AR')]],
|
|
|
157 ["%AR 2", { }, { }, undef, SP_NOARRAY,
|
|
|
158 [BC_STO, BC(666), BC_SUB, BC(6), reg_code('%AR')]],
|
|
|
159 ["%AR 3", { }, { }, undef, SP_NUMBER,
|
|
|
160 [BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), reg_code('%AR')]],
|
|
|
161 ["%AW 1", { '%AW' => 1234 }, { '%AW' => 5678 }, undef, undef,
|
|
|
162 [BC_STO, BC(5678), reg_code('%AW')]],
|
|
|
163 ["%AW 2", { }, { }, undef, SP_NOARRAY,
|
|
|
164 [BC_STO, BC(666), BC_SUB, BC(6), reg_code('%AW')]],
|
|
|
165 ["%AW 3", { }, { }, undef, SP_NUMBER,
|
|
|
166 [BC_STO, BC_MUL, BC(3), BC(1), BC(2), BC(3), reg_code('%AW')]],
|
|
|
167 ["%JS", { }, { '%JS' => 3 }, undef, SP_COMMENT, # *000 because it causes recompile
|
|
|
168 [BC_STO, _str('JUNK'), reg_code('%JS')]],
|
|
|
169 ["%SS", { }, { '%SS' => 4 }, undef, undef,
|
|
|
170 [BC_STO, _str('SPACE'), reg_code('%SS')]],
|
|
|
171 ["%PS", { }, { '%PS' => 1 }, undef, SP_COMMENT, # *000 because it causes recompile
|
|
|
172 [BC_STO, _str('CONSTANT'), reg_code('%PS')]],
|
|
|
173 ["%FS", { }, { '%FS' => 2 }, undef, undef,
|
|
|
174 [BC_STO, _str('SYMBOL'), reg_code('%FS')]],
|
|
|
175 ["%ES", { }, { '%ES' => 1 }, undef, undef,
|
|
|
176 [BC_STO, _str('CONSTANT'), reg_code('%ES')]],
|
|
|
177 ["%IS", { }, { '%IS' => 2 }, undef, SP_COMMENT, # *000 because it causes recompile
|
|
|
178 [BC_STO, _str('SYMBOL'), reg_code('%IS')]],
|
|
|
179 ["%DM 0", { }, { '%DM' => 0 }, undef, undef,
|
|
|
180 [BC_STO, BC(0), reg_code('%DM')]],
|
|
|
181 ["%DM 1", { }, { '%DM' => 1 }, undef, undef,
|
|
|
182 [BC_STO, BC(1), reg_code('%DM')]],
|
|
|
183 ["%DM 2", { }, { }, undef, SP_NOASSIGN,
|
|
|
184 [BC_STO, BC(2), reg_code('%DM')]],
|
|
|
185 ["^AV", { }, { '^AV' => 'The wee cute INTERCAL compiler produced ugly Perl' }, undef, undef,
|
|
|
186 [BC_STO, _str('The wee cute INTERCAL compiler produced ugly Perl'), reg_code('^AV')]],
|
|
|
187 ["^EV", { }, { '^EV' => 'The big ugly gcc produced even uglier objects' }, undef, undef,
|
|
|
188 [BC_STO, _str('The big ugly gcc produced even uglier objects'), reg_code('^EV')]],
|
|
|
189 ["Indirect 1", { }, { '.1' => 5678 }, undef, undef,
|
|
|
190 [BC_STO, BC(5678), BC_TYP, BC_SPO, BC(2), BC(1)]],
|
|
|
191 ["Indirect 2", { }, { '.1' => 5678 }, undef, undef,
|
|
|
192 [BC_STO, BC(5678), BC_SPO, BC_NUM, BC_CHO, BC(1)]],
|
|
|
193 ["Indirect 3", { }, { '.1' => 5678 }, undef, undef,
|
|
|
194 [BC_STO, BC(5678), BC_TYP, BC_SPO, BC(3), BC_NUM, BC_CHO, BC(1)]],
|
|
|
195 ["Overload Register 1", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 1234, '.3' => 5678 }, undef, undef,
|
|
|
196 [BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)]],
|
|
|
197 ["Overload Register 2", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 5678 }, undef, undef,
|
|
|
198 [BC_STO, BC_OVR, BC_SPO, BC(2), BC_SPO, BC(2), BC_SPO, BC(3)]],
|
|
|
199 ["Overload Register 3", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 5678 }, undef, undef,
|
|
|
200 [BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
|
|
|
201 [BC_STO, BC(9), BC_SPO, BC(2)]],
|
|
|
202 ["Overload Register 4", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 5678 }, undef, undef,
|
|
|
203 [BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
|
|
|
204 [BC_STO, BC(9), BC_SPO, BC(1)]],
|
|
|
205 ["Overload Register 5", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 5678 }, undef, undef,
|
|
|
206 [BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
|
|
|
207 [BC_STO, BC_OVR, BC_SPO, BC(2), BC_SPO, BC(2), BC_SPO, BC(3)]],
|
|
|
208 ["Overload Register 6", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 5678 }, undef, undef,
|
|
|
209 [BC_STO, BC_OVR, BC_SPO, BC(1), BC_SPO, BC(2), BC_SPO, BC(3)],
|
|
|
210 [BC_STO, BC_ROR, BC_SPO, BC(2), BC_SPO, BC(3)]],
|
|
|
211 ["Overload Register 7", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '@2' => 1234 }, undef, undef,
|
|
|
212 [BC_STO, BC_OVR, BC_SPO, BC(1), BC_WHP, BC(2), BC_WHP, BC(3)]],
|
|
|
213 ["Overload Many 1", { '.1' => 1234, '.2' => 5678 },
|
|
|
214 { '.1' => 1234, '.2' => 1234, '.3' => 6, ';1' => 1234, ',2' => 1234 }, undef, undef,
|
|
|
215 [BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)]],
|
|
|
216 ["Overload Many 2", { '.1' => 1234, '.2' => 5678 }, { '.1' => 5678, '.2' => 5678, '.3' => 6 }, undef, undef,
|
|
|
217 [BC_STO, BC_OVM, BC_SPO, BC(2), BC(6), BC_SPO, BC(3)]],
|
|
|
218 ["Overload Many 3", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 6 }, undef, undef,
|
|
|
219 [BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
|
|
|
220 [BC_STO, BC(9), BC_SPO, BC(2)]],
|
|
|
221 ["Overload Many 4", { '.1' => 1234, '.2' => 5678 }, { '.1' => 9, '.2' => 9, '.3' => 6 }, undef, undef,
|
|
|
222 [BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
|
|
|
223 [BC_STO, BC(9), BC_SPO, BC(1)]],
|
|
|
224 ["Overload Many 5", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 6 }, undef, undef,
|
|
|
225 [BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
|
|
|
226 [BC_STO, BC_OVM, BC_OWN, BC(1), BC_WHP, BC(0), BC(6), BC_SPO, BC(3)]],
|
|
|
227 ["Overload Many 6", { '.1' => 1234, '.2' => 5678 }, { '.1' => 1234, '.2' => 5678, '.3' => 6 }, undef, undef,
|
|
|
228 [BC_STO, BC_OVM, BC_SPO, BC(1), BC(6), BC_SPO, BC(3)],
|
|
|
229 [BC_STO, BC_ROM, BC(6), BC_SPO, BC(3)]],
|
|
|
230 ["Owner 1", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
|
|
|
231 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(1)],
|
|
|
232 [BC_ENS, BC_SPO, BC(6), BC_SPO, BC(2)],
|
|
|
233 [BC_STO, BC_OWN, BC(1), BC_SPO, BC(5), BC_SPO, BC(3)],
|
|
|
234 [BC_STO, BC_OWN, BC(1), BC_SPO, BC(6), BC_SPO, BC(4)]],
|
|
|
235 ["Owner 2", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
|
|
|
236 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(3)],
|
|
|
237 [BC_ENS, BC_SPO, BC(6), BC_SPO, BC(4)],
|
|
|
238 [BC_STO, BC_SPO, BC(1), BC_OWN, BC(1), BC_SPO, BC(5)],
|
|
|
239 [BC_STO, BC_SPO, BC(2), BC_OWN, BC(1), BC_SPO, BC(6)]],
|
|
|
240 ["Owner 3", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
|
|
|
241 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(1)],
|
|
|
242 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(2)],
|
|
|
243 [BC_STO, BC_OWN, BC(2), BC_SPO, BC(5), BC_SPO, BC(3)],
|
|
|
244 [BC_STO, BC_OWN, BC(1), BC_SPO, BC(5), BC_SPO, BC(4)]],
|
|
|
245 ["Owner 4", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
|
|
|
246 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(3)],
|
|
|
247 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(4)],
|
|
|
248 [BC_STO, BC_SPO, BC(1), BC_OWN, BC(2), BC_SPO, BC(5)],
|
|
|
249 [BC_STO, BC_SPO, BC(2), BC_OWN, BC(1), BC_SPO, BC(5)]],
|
|
|
250 ["Owner 5", { '.1' => 1234, '.2' => 5678 }, { '.3' => 5678, '.4' => 5678 }, undef, undef,
|
|
|
251 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(1)],
|
|
|
252 [BC_ENS, BC_SPO, BC(1), BC_SPO, BC(2)],
|
|
|
253 [BC_STO, BC_OWN, BC(1), BC_OWN, BC(1), BC_SPO, BC(5), BC_SPO, BC(3)],
|
|
|
254 [BC_STO, BC_OWN, BC(1), BC_SPO, BC(1), BC_SPO, BC(4)]],
|
|
|
255 ["Owner 6", { '.1' => 1234, '.2' => 5678 }, { '.3' => 1234, '.4' => 5678 }, undef, undef,
|
|
|
256 [BC_ENS, BC_SPO, BC(5), BC_SPO, BC(3)],
|
|
|
257 [BC_ENS, BC_SPO, BC(3), BC_SPO, BC(4)],
|
|
|
258 [BC_STO, BC_SPO, BC(1), BC_OWN, BC(1), BC_SPO, BC(5)],
|
|
|
259 [BC_STO, BC_SPO, BC(2), BC_OWN, BC(1), BC_OWN, BC(1), BC_SPO, BC(5)]],
|
|
|
260 );
|
|
|
261
|
|
|
262 $| = 1;
|
|
|
263
|
|
|
264 my $maxtest = 0;
|
|
|
265 for my $counter (@all_tests) {
|
|
|
266 my $nt = 3;
|
|
|
267 for my $r (values %{$counter->[2]}) {
|
|
|
268 $nt ++;
|
|
|
269 $nt += scalar @$r if ref $r;
|
|
|
270 }
|
|
|
271 $counter->[3] = $nt;
|
|
|
272 $maxtest += $nt;
|
|
|
273 }
|
|
|
274 print "1..$maxtest\n";
|
|
|
275
|
|
|
276 my $testnum = 1;
|
|
|
277 my $rc = new Language::INTERCAL::Rcfile;
|
|
|
278 for my $tester (@all_tests) {
|
|
|
279 my ($name, $in, $out, $nt, $splat, @code) = @$tester;
|
|
|
280 my $obj = new Language::INTERCAL::Interpreter($rc);
|
|
|
281 $obj->object->setbug(0, 0);
|
|
|
282 my $cp = 0;
|
|
|
283 my @c = map {
|
|
|
284 pack('C*', BC_STS, BC($cp++), BC(1), BC(0), BC(0), @$_);
|
|
|
285 } (@code, [BC_GUP]);
|
|
|
286 eval {
|
|
|
287 $obj->object->source('x');
|
|
|
288 $obj->object->code(\@c);
|
|
|
289 };
|
|
|
290 if (@$) {
|
|
|
291 print "not ok ", $testnum++, "\n" for (1..$nt);
|
|
|
292 next;
|
|
|
293 }
|
|
|
294 print "ok ", $testnum++, "\n";
|
|
|
295 eval {
|
|
|
296 for my $r (keys %$in) {
|
|
|
297 $obj->setreg($r, $in->{$r});
|
|
|
298 }
|
|
|
299 $obj->setreg('@OSFH', $devnull);
|
|
|
300 $obj->setreg('@TRFH', $devnull);
|
|
|
301 };
|
|
|
302 if (@$) {
|
|
|
303 print "not ok ", $testnum++, "\n" for (2..$nt);
|
|
|
304 print STDERR "Failed $name\n";
|
|
|
305 next;
|
|
|
306 }
|
|
|
307 print "ok ", $testnum++, "\n";
|
|
|
308 eval {
|
|
|
309 $obj->start()->run()->stop();
|
|
|
310 };
|
|
|
311 if (@$) {
|
|
|
312 print "not ok ", $testnum++, "\n" for (3..$nt);
|
|
|
313 print STDERR "Failed $name\n";
|
|
|
314 next;
|
|
|
315 }
|
|
|
316 my $os = $obj->splat;
|
|
|
317 if (defined $os) {
|
|
|
318 print defined $splat && $os == $splat ? "" : "not ", "ok ", $testnum++, "\n";
|
|
|
319 print STDERR "Failed $name (*$os)\n" unless defined $splat && $os == $splat;
|
|
|
320 } else {
|
|
|
321 print defined $splat ? "not " : "", "ok ", $testnum++, "\n";
|
|
|
322 print STDERR "Failed $name (no splat)\n" if defined $splat;
|
|
|
323 }
|
|
|
324 for my $r (sort keys %$out) {
|
|
|
325 my $v = eval { $obj->getreg($r) };
|
|
|
326 my $e = $out->{$r};
|
|
|
327 if ($@) {
|
|
|
328 print STDERR "Failed $name\n";
|
|
|
329 print "not ok ", $testnum++, "\n";
|
|
|
330 if (ref $e) {
|
|
|
331 print "not ok ", $testnum++, "\n" for @$e;
|
|
|
332 }
|
|
|
333 next;
|
|
|
334 }
|
|
|
335 if (ref $e) {
|
|
|
336 my @v = eval { map { $_->number } $v->as_list };
|
|
|
337 if (@v != @$e) {
|
|
|
338 print STDERR "Failed $name\n";
|
|
|
339 print "not ok ", $testnum++, "\n";
|
|
|
340 print "not ok ", $testnum++, "\n" for @$e;
|
|
|
341 next;
|
|
|
342 }
|
|
|
343 print "ok ", $testnum++, "\n";
|
|
|
344 for (my $i = 0; $i < @v; $i++) {
|
|
|
345 print $v[$i] == $e->[$i] ? '' : "not ", "ok ", $testnum++, "\n";
|
|
|
346 print STDERR "Failed $name\n" if $v[$i] != $e->[$i];
|
|
|
347 }
|
|
|
348 } else {
|
|
|
349 my $ok;
|
|
|
350 if ($e =~ /^\d+$/) {
|
|
|
351 my $n = eval { $v->number } || 0;
|
|
|
352 $ok = $e == $n;
|
|
|
353 } else {
|
|
|
354 my $n = pack('C*', eval { map { $_->number } $v->as_list });
|
|
|
355 $ok = $e eq $n;
|
|
|
356 }
|
|
|
357 print $ok ? '' : 'not ', "ok ", $testnum++, "\n";
|
|
|
358 print STDERR "Failed $name\n" unless $ok;
|
|
|
359 }
|
|
|
360 }
|
|
|
361 }
|
|
|
362
|
|
|
363 sub _str {
|
|
|
364 my ($str) = @_;
|
|
|
365 return (BC_STR, BC(length $str), unpack('C*', $str));
|
|
|
366 }
|
|
|
367
|
