|
996
|
1 # test bytecode interpreter - quantum statements
|
|
|
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::Sick '1.-94.-2';
|
|
|
15
|
|
|
16 my @all_tests = (
|
|
|
17 ['Comment 1', undef, '', "*000 ERROR\nV\n", 0,
|
|
|
18 'ERROR WHILE NOT COMMENTING', [BC_QUA], [BC_MSP, BC(0), BC(1), _str('ERROR')],
|
|
|
19 'DO READ OUT #5', [], [BC_ROU, BC(1), BC(5)]],
|
|
|
20 ['Comment 2', undef, '', "*578 Invalid bytecode pattern in NAME: PROBLEM\nV\n", 578,
|
|
|
21 '(Invalid code) WHILE NOT COMMENTING', [BC_QUA],
|
|
|
22 [BC_MSP, BC(578), BC(2), _str('NAME'), _str('PROBLEM')],
|
|
|
23 'DO READ OUT #5', [], [BC_ROU, BC(1), BC(5)]],
|
|
|
24 ['Compiler BUG 1', undef, '', "*774 Compiler error\nV\n", 774,
|
|
|
25 'BUG WHILE NOT BUG', [BC_QUA], [BC_BUG, BC(0)],
|
|
|
26 'DO READ OUT #5', [], [BC_ROU, BC(1), BC(5)]],
|
|
|
27 ['Compiler BUG 2', undef, '', "*775 Unexplainable compiler error\nV\n", 775,
|
|
|
28 'BUG WHILE NOT BUG', [BC_QUA], [BC_BUG, BC(1)],
|
|
|
29 'DO READ OUT #5', [], [BC_ROU, BC(1), BC(5)]],
|
|
|
30 ['WRITE IN 1', undef, 'TWO SIX', [1, "XXVI\n", "I\n"], undef,
|
|
|
31 'DO .2 <- #1', [], [BC_STO, BC(1), BC_SPO, BC(2)],
|
|
|
32 'DO WRITE IN .2 WHILE NOT WRITING IN', [BC_QUA], [BC_WIN, BC(1), BC_SPO, BC(2)],
|
|
|
33 'DO READ OUT .2', [], [BC_ROU, BC(1), BC_SPO, BC(2)]],
|
|
|
34 ['WRITE IN 2', undef, 'ABCD', [1, "ABCD\n", "EFGH\n"], undef,
|
|
|
35 'DO ,2 <- #7', [], [BC_STO, BC(7), BC_TAI, BC(2)],
|
|
|
36 'DO ,2 SUB #1 <- #91', [], [BC_STO, BC(91), BC_SUB, BC(1), BC_TAI, BC(2)],
|
|
|
37 'DO ,2 SUB #2 <- #95', [], [BC_STO, BC(95), BC_SUB, BC(2), BC_TAI, BC(2)],
|
|
|
38 'DO ,2 SUB #3 <- #65', [], [BC_STO, BC(65), BC_SUB, BC(3), BC_TAI, BC(2)],
|
|
|
39 'DO ,2 SUB #3 <- #77', [], [BC_STO, BC(77), BC_SUB, BC(4), BC_TAI, BC(2)],
|
|
|
40 'DO ,2 SUB #4 <- #90', [], [BC_STO, BC(90), BC_SUB, BC(5), BC_TAI, BC(2)],
|
|
|
41 'DO ,2 SUB #5 <- #84', [], [BC_STO, BC(84), BC_SUB, BC(6), BC_TAI, BC(2)],
|
|
|
42 'DO WRITE IN ,2 WHILE NOT WRITING IN', [BC_QUA], [BC_WIN, BC(1), BC_TAI, BC(2)],
|
|
|
43 'DO READ OUT ,2', [], [BC_ROU, BC(1), BC_TAI, BC(2)]],
|
|
|
44 ['REINSTATE LABEL', undef, '', "II\nIV\nIV\n", undef,
|
|
|
45 'DO REINSTATE (1) WHILE ABSTAINING FROM IT', [BC_QUA], [BC_REL, BC(1)],
|
|
|
46 '(1) DO NOT READ OUT #2', [BC_LAB, BC(1), BC_NOT], [BC_ROU, BC(1), BC(2)],
|
|
|
47 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
48 ['REINSTATE GERUND', undef, '', "II\nIV\n", undef,
|
|
|
49 'DO REINSTATE READING OUT WHILE ABSTAINING FROM IT', [BC_QUA], [BC_REG, BC(1), BC_ROU],
|
|
|
50 'DO NOT READ OUT #2', [BC_NOT], [BC_ROU, BC(1), BC(2)],
|
|
|
51 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
52 ['ABSTAIN FROM LABEL', undef, '', "II\nIV\nIV\n", undef,
|
|
|
53 'DO ABSTAIN FROM (1) WHILE REINSTATING IT', [BC_QUA], [BC_ABL, BC(1)],
|
|
|
54 '(1) DO READ OUT #2', [BC_LAB, BC(1)], [BC_ROU, BC(1), BC(2)],
|
|
|
55 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
56 ['ABSTAIN FROM GERUND', undef, '', "II\nIV\n", undef,
|
|
|
57 'DO ABSTAIN FROM READING OUT WHILE REINSTATING IT', [BC_QUA], [BC_ABG, BC(1), BC_ROU],
|
|
|
58 '(1) DO READ OUT #2', [BC_LAB, BC(1)], [BC_ROU, BC(1), BC(2)],
|
|
|
59 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
60 ['ABSTAIN + REINSTATE 1', undef, '', "II\n", undef,
|
|
|
61 'DO ABSTAIN FROM READING OUT', [], [BC_ABG, BC(1), BC_ROU],
|
|
|
62 'DO REINSTATE (1) WHILE ABSTAINING FROM IT', [BC_QUA], [BC_REL, BC(1)],
|
|
|
63 '(1) DO READ OUT #2', [BC_LAB, BC(1)], [BC_ROU, BC(1), BC(2)],
|
|
|
64 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
65 ['ABSTAIN + REINSTATE 2', undef, '', "II\nII\nIV\n", undef,
|
|
|
66 'DO ABSTAIN FROM READING OUT WHILE REINSTATING IT', [BC_QUA], [BC_ABG, BC(1), BC_ROU],
|
|
|
67 'DO REINSTATE (1)', [], [BC_REL, BC(1)],
|
|
|
68 '(1) DO READ OUT #2', [BC_LAB, BC(1)], [BC_ROU, BC(1), BC(2)],
|
|
|
69 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
70 ['ABSTAIN FROM QUANTUM COMPUTING 1', undef, '', "II\n", undef,
|
|
|
71 'DO ABSTAIN FROM QUANTUM COMPUTING', [], [BC_ABG, BC(1), BC_QUA],
|
|
|
72 'DO ABSTAIN FROM READING OUT WHILE REINSTATING IT', [BC_QUA], [BC_ABG, BC(1), BC_ROU],
|
|
|
73 'DO REINSTATE (1) WHILE ABSTAINING FROM IT', [BC_QUA], [BC_REL, BC(1)],
|
|
|
74 '(1) DO READ OUT #2', [BC_LAB, BC(1)], [BC_ROU, BC(1), BC(2)],
|
|
|
75 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
76 ['ABSTAIN FROM QUANTUM COMPUTING 2', undef, '', "IV\n", undef,
|
|
|
77 '(1) DO ABSTAIN FROM QUANTUM COMPUTING', [BC_LAB, BC(1)], [BC_ABG, BC(1), BC_QUA],
|
|
|
78 'DO READ OUT #2', [], [BC_ROU, BC(1), BC(2)],
|
|
|
79 'DO GIVE UP', [], [BC_GUP],
|
|
|
80 'DO COME FROM (1) WHILE NOT COMING FROM THERE', [BC_QUA], [BC_CFL, BC(1)],
|
|
|
81 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
82 ['ABSTAIN FROM QUANTUM COMPUTING 3', undef, '', "II\nIV\nIV\n", undef,
|
|
|
83 '(1) DO ABSTAIN FROM QUANTUM COMPUTING WHILE REINSTATING IT',
|
|
|
84 [BC_LAB, BC(1), BC_QUA], [BC_ABG, BC(1), BC_QUA],
|
|
|
85 'DO READ OUT #2', [], [BC_ROU, BC(1), BC(2)],
|
|
|
86 'DO GIVE UP', [], [BC_GUP],
|
|
|
87 'DO COME FROM (1) WHILE NOT COMING FROM THERE', [BC_QUA], [BC_CFL, BC(1)],
|
|
|
88 'DO READ OUT #4', [], [BC_ROU, BC(1), BC(4)]],
|
|
|
89 ['STASH/RETRIEVE 1', undef, '', [1, "II\n", "*436 Register .1 stashed away too well\n"], 436,
|
|
|
90 'DO .1 <- #2', [], [BC_STO, BC(2), BC_SPO, BC(1)],
|
|
|
91 'DO STASH .1 WHILE NOT STASHING IT', [BC_QUA], [BC_STA, BC(1), BC_SPO, BC(1)],
|
|
|
92 'DO .1 <- #4', [], [BC_STO, BC(4), BC_SPO, BC(1)],
|
|
|
93 'DO RETRIEVE .1', [], [BC_RET, BC(1), BC_SPO, BC(1)],
|
|
|
94 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
95 ['STASH/RETRIEVE 2', undef, '', [1, "A\n", "S\n"], undef,
|
|
|
96 'DO ,1 <- #3', [], [BC_STO, BC(3), BC_TAI, BC(1)],
|
|
|
97 'DO ,1 SUB #1 <- #91', [], [BC_STO, BC(91), BC_SUB, BC(1), BC_TAI, BC(1)],
|
|
|
98 'DO ,1 SUB #2 <- #95', [], [BC_STO, BC(95), BC_SUB, BC(2), BC_TAI, BC(1)],
|
|
|
99 'DO ,1 SUB #3 <- #67', [], [BC_STO, BC(67), BC_SUB, BC(3), BC_TAI, BC(1)],
|
|
|
100 'DO STASH ,1', [], [BC_STA, BC(1), BC_TAI, BC(1)],
|
|
|
101 'DO ,1 SUB #3 <- #69', [], [BC_STO, BC(69), BC_SUB, BC(3), BC_TAI, BC(1)],
|
|
|
102 'DO STASH ,1 WHILE NOT STASHING IT', [BC_QUA], [BC_STA, BC(1), BC_TAI, BC(1)],
|
|
|
103 'DO ,1 SUB #3 <- #70', [], [BC_STO, BC(70), BC_SUB, BC(3), BC_TAI, BC(1)],
|
|
|
104 'DO RETRIEVE ,1', [], [BC_RET, BC(1), BC_TAI, BC(1)],
|
|
|
105 'DO READ OUT ,1', [], [BC_ROU, BC(1), BC_TAI, BC(1)]],
|
|
|
106 ['IGNORE', undef, '', [1, "II\n", "IV\n"], undef,
|
|
|
107 'DO .1 <- #2', [], [BC_STO, BC(2), BC_SPO, BC(1)],
|
|
|
108 'DO IGNORE .1 WHILE REMEMBERING IT', [BC_QUA], [BC_IGN, BC(1), BC_SPO, BC(1)],
|
|
|
109 'DO .1 <- #4', [], [BC_STO, BC(4), BC_SPO, BC(1)],
|
|
|
110 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
111 ['REMEMBER', undef, '', [1, "IV\n", "II\n"], undef,
|
|
|
112 'DO .1 <- #2', [], [BC_STO, BC(2), BC_SPO, BC(1)],
|
|
|
113 'DO REMEMBER .1 WHILE IGNORING IT', [BC_QUA], [BC_REM, BC(1), BC_SPO, BC(1)],
|
|
|
114 'DO .1 <- #4', [], [BC_STO, BC(4), BC_SPO, BC(1)],
|
|
|
115 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
116 ['GIVE UP', undef, '', "II\nIV\n", undef,
|
|
|
117 'DO .1 <- #2', [], [BC_STO, BC(2), BC_SPO, BC(1)],
|
|
|
118 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
119 'DO GIVE UP WHILE CONTINUING TO RUN', [BC_QUA], [BC_GUP],
|
|
|
120 'DO .1 <- #4', [], [BC_STO, BC(4), BC_SPO, BC(1)],
|
|
|
121 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
122 ['ENSLAVE', undef, '', [1, "IV\n", "*511 Register .2 is not a slave\n"], 511,
|
|
|
123 'DO .1 <- #2', [], [BC_STO, BC(2), BC_SPO, BC(1)],
|
|
|
124 'DO ENSLAVE .2 TO .1 WHILE LEAVING IT FREE', [BC_QUA], [BC_ENS, BC_SPO, BC(2), BC_SPO, BC(1)],
|
|
|
125 'DO $.2 <- #4', [], [BC_STO, BC(4), BC_OWN, BC(1), BC_SPO, BC(2)],
|
|
|
126 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
127 ['FREE', undef, '', [1, "IV\n", "*511 Register .2 is not a slave\n"], 511,
|
|
|
128 'DO .1 <- #2', [], [BC_STO, BC(2), BC_SPO, BC(1)],
|
|
|
129 'DO ENSLAVE .2 TO .1', [], [BC_ENS, BC_SPO, BC(2), BC_SPO, BC(1)],
|
|
|
130 'DO FREE .2 FROM .1 WHILE LEAVING IT IN SLAVERY', [BC_QUA], [BC_FRE, BC_SPO, BC(2), BC_SPO, BC(1)],
|
|
|
131 'DO $.2 <- #4', [], [BC_STO, BC(4), BC_OWN, BC(1), BC_SPO, BC(2)],
|
|
|
132 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
133 ['COME FROM LABEL', undef, '', "X\nI\nV\n", undef,
|
|
|
134 '(69) DO .1 <- #1', [BC_LAB, BC(69)], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
135 'DO COME FROM (70)', [], [BC_CFL, BC(70)],
|
|
|
136 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
137 'DO GIVE UP', [], [BC_GUP],
|
|
|
138 'DO COME FROM (69) WHILE NOT COMING FROM THERE', [BC_QUA], [BC_CFL, BC(69)],
|
|
|
139 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
140 '(70) DO .1 <- #5', [BC_LAB, BC(70)], [BC_STO, BC(5), BC_SPO, BC(1)]],
|
|
|
141 ['COME FROM GERUND', undef, '', "X\nI\nV\n", undef,
|
|
|
142 'DO %CF <- #2', [], [BC_STO, BC(2), reg_code('%CF')],
|
|
|
143 'DO .1 <- #1', [], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
144 'DO ABSTAIN FROM (99)', [], [BC_ABL, BC(99)],
|
|
|
145 'DO COME FROM (70)', [], [BC_CFL, BC(70)],
|
|
|
146 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
147 'DO GIVE UP', [], [BC_GUP],
|
|
|
148 'DO COME FROM ABSTAINING WHILE NOT COMING FROM THERE', [BC_QUA], [BC_CFG, BC(2), BC_ABL, BC_ABG],
|
|
|
149 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
150 '(70) DO .1 <- #5', [BC_LAB, BC(70)], [BC_STO, BC(5), BC_SPO, BC(1)]],
|
|
|
151 ['NEXT', undef, '', "X\nI\n", undef,
|
|
|
152 'DO .1 <- #1', [], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
153 'DO (69) NEXT WHILE NOT NEXTING', [BC_QUA], [BC_NXT, BC(69)],
|
|
|
154 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
155 'DO GIVE UP', [], [BC_GUP],
|
|
|
156 '(60) DO READ OUT .1', [BC_LAB, BC(69)], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
157 ['RESUME', undef, '', "I\nX\nV\n", undef,
|
|
|
158 'DO .1 <- #1', [], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
159 'DO (69) NEXT', [], [BC_NXT, BC(69)],
|
|
|
160 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
161 'DO GIVE UP', [], [BC_GUP],
|
|
|
162 '(69) DO READ OUT .1', [BC_LAB, BC(69)], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
163 'DO RESUME #1 WHILE NOT RESUMING', [BC_QUA], [BC_RES, BC(1)],
|
|
|
164 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
165 'DO READ OUT #5', [], [BC_ROU, BC(1), BC(5)]],
|
|
|
166 ['FORGET', undef, '', "XX\nX\nXXX\n", undef,
|
|
|
167 'DO .1 <- #1', [], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
168 'DO (69) NEXT', [], [BC_NXT, BC(69)],
|
|
|
169 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
170 'DO GIVE UP', [], [BC_GUP],
|
|
|
171 '(69) DO (70) NEXT', [BC_LAB, BC(69)], [BC_NXT, BC(70)],
|
|
|
172 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
173 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
174 'DO READ OUT #30', [], [BC_ROU, BC(1), BC(30)],
|
|
|
175 'DO GIVE UP', [], [BC_GUP],
|
|
|
176 '(70) DO READ OUT #20', [BC_LAB, BC(70)], [BC_ROU, BC(1), BC(20)],
|
|
|
177 'DO FORGET #1 WHILE NOT FORGETTING', [BC_QUA], [BC_FOR, BC(1)],
|
|
|
178 'DO RESUME #1', [], [BC_RES, BC(1)]],
|
|
|
179 ['NEXT FROM LABEL', undef, '', "X\nII\nII\n", undef,
|
|
|
180 '(69) DO .1 <- #1', [BC_LAB, BC(69)], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
181 'DO .1 <- #2', [], [BC_STO, BC(2), BC_SPO, BC(1)],
|
|
|
182 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
183 'DO GIVE UP', [], [BC_GUP],
|
|
|
184 'DO NEXT FROM (69) WHILE NOT NEXTING FROM THERE', [BC_QUA], [BC_NXL, BC(69)],
|
|
|
185 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
186 'DO RESUME #1', [], [BC_RES, BC(1)]],
|
|
|
187 ['NEXT FROM GERUND', undef, '', [1, "X\n", "III\n", "V\n"], undef,
|
|
|
188 'DO %CF <- #2', [], [BC_STO, BC(2), reg_code('%CF')],
|
|
|
189 'DO .1 <- #3', [], [BC_STO, BC(3), BC_SPO, BC(1)],
|
|
|
190 'DO ABSTAIN FROM (99)', [], [BC_ABL, BC(99)],
|
|
|
191 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
192 'DO GIVE UP', [], [BC_GUP],
|
|
|
193 'DO NEXT FROM ABSTAINING WHILE NOT NEXTING FROM THERE', [BC_QUA], [BC_NXG, BC(2), BC_ABL, BC_ABG],
|
|
|
194 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
195 'DO .1 <- #5', [], [BC_STO, BC(5), BC_SPO, BC(1)],
|
|
|
196 'DO RESUME #1', [], [BC_RES, BC(1)]],
|
|
|
197 ['STUDY', undef, '', [1, "M\n", "MM\n"], undef,
|
|
|
198 'DO STUDY #1 AT (1000) IN CLASS @2', [], [BC_STU, BC(1), BC(1000), BC_WHP, BC(2)],
|
|
|
199 'DO STUDY #1 AT (2000) IN CLASS @2 WHILE NOT STUDYING IT', [BC_QUA], [BC_STU, BC(1), BC(2000), BC_WHP, BC(2)],
|
|
|
200 'DO READ OUT @2 SUB #1', [], [BC_ROU, BC(1), BC_SUB, BC(1), BC_WHP, BC(2)]],
|
|
|
201 ['ENROL', undef, '', "*603 Class war between \@1 and \@2\nM\n", 603,
|
|
|
202 'DO STUDY #1 AT (1000) IN CLASS @1', [], [BC_STU, BC(1), BC(1000), BC_WHP, BC(1)],
|
|
|
203 'DO STUDY #2 AT (1000) IN CLASS @1', [], [BC_STU, BC(2), BC(1000), BC_WHP, BC(1)],
|
|
|
204 'DO STUDY #1 AT (2000) IN CLASS @2', [], [BC_STU, BC(1), BC(2000), BC_WHP, BC(2)],
|
|
|
205 'DO STUDY #3 AT (2000) IN CLASS @2', [], [BC_STU, BC(3), BC(2000), BC_WHP, BC(2)],
|
|
|
206 'DO ENROL .1 TO LEARN #1 + #2', [], [BC_ENR, BC(2), BC(1), BC(2), BC_SPO, BC(1)],
|
|
|
207 'DO ENROL .1 TO LEARN #1 + #3 WHILE NOT ENROLLING', [BC_QUA], [BC_ENR, BC(2), BC(1), BC(3), BC_SPO, BC(1)],
|
|
|
208 'DO .1 LEARNS #1', [], [BC_LEA, BC(1), BC_SPO, BC(1)],
|
|
|
209 'DO READ OUT @2 SUB #3', [], [BC_ROU, BC(1), BC_SUB, BC(3), BC_WHP, BC(2)],
|
|
|
210 '(1000) DO READ OUT @1 SUB #1', [BC_LAB, BC(1000)], [BC_ROU, BC(1), BC_SUB, BC(1), BC_WHP, BC(1)]],
|
|
|
211 ['LEARNS', undef, '', "M\nII\n", undef,
|
|
|
212 'DO STUDY #1 AT (1000) IN CLASS @1', [], [BC_STU, BC(1), BC(1000), BC_WHP, BC(1)],
|
|
|
213 'DO ENROL .1 TO LEARN #1', [], [BC_ENR, BC(1), BC(1), BC_SPO, BC(1)],
|
|
|
214 'DO .1 LEARNS #1 WHILE NOT LEARNING IT', [BC_QUA], [BC_LEA, BC(1), BC_SPO, BC(1)],
|
|
|
215 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
216 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
217 'DO READ OUT #2', [], [BC_ROU, BC(1), BC(2)],
|
|
|
218 'DO GIVE UP', [], [BC_GUP],
|
|
|
219 '(1000) DO READ OUT @1 SUB #1', [BC_LAB, BC(1000)], [BC_ROU, BC(1), BC_SUB, BC(1), BC_WHP, BC(1)]],
|
|
|
220 ['FINISH LECTURE', undef, '', "M\nV\nII\n", undef,
|
|
|
221 'DO STUDY #1 AT (1000) IN CLASS @1', [], [BC_STU, BC(1), BC(1000), BC_WHP, BC(1)],
|
|
|
222 'DO ENROL .1 TO LEARN #1', [], [BC_ENR, BC(1), BC(1), BC_SPO, BC(1)],
|
|
|
223 'DO .1 LEARNS #1', [], [BC_LEA, BC(1), BC_SPO, BC(1)],
|
|
|
224 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
225 'DO GIVE UP', [], [BC_GUP],
|
|
|
226 '(1000) DO READ OUT @1 SUB #1', [BC_LAB, BC(1000)], [BC_ROU, BC(1), BC_SUB, BC(1), BC_WHP, BC(1)],
|
|
|
227 'DO $@1 <- #5', [], [BC_STO, BC(5), BC_OWN, BC(1), BC_WHP, BC(1)],
|
|
|
228 'DO FINISH LECTURE WHILE CONTINUING IT', [BC_QUA], [BC_FIN],
|
|
|
229 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
230 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
231 'DO READ OUT #2', [], [BC_ROU, BC(1), BC(2)]],
|
|
|
232 ['GRADUATES', undef, '', "*822 Register .1 is not a student\nM\n", 822,
|
|
|
233 'DO STUDY #1 AT (1000) IN CLASS @1', [], [BC_STU, BC(1), BC(1000), BC_WHP, BC(1)],
|
|
|
234 'DO ENROL .1 TO LEARN #1', [], [BC_ENR, BC(1), BC(1), BC_SPO, BC(1)],
|
|
|
235 'DO .1 GRADUATES WHILE REMAINING A STUDENT', [BC_QUA], [BC_GRA, BC_SPO, BC(1)],
|
|
|
236 'DO .1 LEARNS #4', [], [BC_LEA, BC(1), BC_SPO, BC(1)],
|
|
|
237 '(1000) DO READ OUT @1 SUB #1', [BC_LAB, BC(1000)], [BC_ROU, BC(1), BC_SUB, BC(1), BC_WHP, BC(1)]],
|
|
|
238 ['SWAP', undef, '', "XX\nXX\nV\nX\n", undef,
|
|
|
239 'DO .1 <- #1', [], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
240 'DO SWAP RESUME EXPRESSION AND FORGET EXPRESSION WHILE LEAVING THEM UNCHANGED',
|
|
|
241 [BC_QUA], [BC_SWA, BC_RES, BC_FOR],
|
|
|
242 'DO (69) NEXT', [], [BC_NXT, BC(69)],
|
|
|
243 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
244 'DO GIVE UP', [], [BC_GUP],
|
|
|
245 '(69) DO (70) NEXT', [BC_LAB, BC(69)], [BC_NXT, BC(70)],
|
|
|
246 'DO READ OUT #5', [], [BC_ROU, BC(1), BC(5)],
|
|
|
247 'DO GIVE UP', [], [BC_GUP],
|
|
|
248 '(70) DO READ OUT #20', [BC_LAB, BC(70)], [BC_ROU, BC(1), BC(20)],
|
|
|
249 'DO RESUME #1', [], [BC_RES, BC(1)],
|
|
|
250 'DO FORGET #1', [], [BC_FOR, BC(1)]],
|
|
|
251 ['CONVERT', undef, '', "XX\nXX\nX\nV\n", undef,
|
|
|
252 'DO .1 <- #1', [], [BC_STO, BC(1), BC_SPO, BC(1)],
|
|
|
253 'DO CONVERT FORGET EXPRESSION TO RESUME EXPRESSION WHILE LEAVING IT UNCHANGED',
|
|
|
254 [BC_QUA], [BC_CON, BC_FOR, BC_RES],
|
|
|
255 'DO (69) NEXT', [], [BC_NXT, BC(69)],
|
|
|
256 'DO GIVE UP', [], [BC_GUP],
|
|
|
257 '(69) DO (70) NEXT', [BC_LAB, BC(69)], [BC_NXT, BC(70)],
|
|
|
258 'DO READ OUT #10', [], [BC_ROU, BC(1), BC(10)],
|
|
|
259 'DO GIVE UP', [], [BC_GUP],
|
|
|
260 '(70) DO READ OUT #20', [BC_LAB, BC(70)], [BC_ROU, BC(1), BC(20)],
|
|
|
261 'DO FORGET #1', [], [BC_FOR, BC(1)],
|
|
|
262 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
263 'DO NOT GIVE UP', [BC_NOT], [BC_GUP],
|
|
|
264 'DO READ OUT #5', [], [BC_ROU, BC(1), BC(5)]],
|
|
|
265 ['DESTROY', 'sick', '', "II\nII\n*000 DO .1 <- #-8\nII\n", 0,
|
|
|
266 # extend sick to have another name for unary division, then destroy original
|
|
|
267 'DO CREATE ?UNARY ,D, AS [UDV]', [],
|
|
|
268 [BC_CRE, BC(1), _str('UNARY'), BC(1), BC(0), BC(1), _str('D'),
|
|
|
269 BC(1), BC(4), BC(1), BC_UDV],
|
|
|
270 'DO DESTROY ?UNARY ,#45, WHILE NOT DESTROYING IT', [BC_QUA],
|
|
|
271 [BC_DES, BC(1), _str('UNARY'), BC(1), BC(0), BC(1), _str('-')],
|
|
|
272 'DO .1 <- #D8', [], [BC_STO, BC_UDV, BC(8), BC_SPO, BC(1)],
|
|
|
273 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)],
|
|
|
274 'DO .1 <- #-8', [], [BC_STO, BC_UDV, BC(8), BC_SPO, BC(1)],
|
|
|
275 'DO READ OUT .1', [], [BC_ROU, BC(1), BC_SPO, BC(1)]],
|
|
|
276 ['CREATE', '1972', '', [1, "\nII\n", "*000 DO .2 <- #D2\n"], 0,
|
|
|
277 # extend the 1972 compiler with Unary Division and call it D
|
|
|
278 'DO CREATE ?UNARY ,D, AS [UDV] + WHILE NOT CREATING IT', [BC_QUA],
|
|
|
279 [BC_CRE, BC(1), _str('UNARY'), BC(1), BC(0), BC(1), _str('D'),
|
|
|
280 BC(1), BC(4), BC(1), BC_UDV],
|
|
|
281 'DO .2 <- #D2', [], [BC_MSP, BC(0), BC(1), _str('DO .1 <- #D3')],
|
|
|
282 'DO READ OUT .2', [], [BC_ROU, BC(1), BC_SPO, BC(2)]],
|
|
|
283 );
|
|
|
284
|
|
|
285 $| = 1;
|
|
|
286
|
|
|
287 my $maxtest = 0;
|
|
|
288 for my $tester (@all_tests) {
|
|
|
289 my ($name, $load, $in, $out, $splat, @data) = @$tester;
|
|
|
290 $maxtest += 2;
|
|
|
291 $maxtest += $out->[0] - 1 if ref $out;
|
|
|
292 }
|
|
|
293 print "1..$maxtest\n";
|
|
|
294
|
|
|
295 my $testnum = 1;
|
|
|
296 my $rc = new Language::INTERCAL::Rcfile;
|
|
|
297 my $compiler = new Language::INTERCAL::Sick($rc);
|
|
|
298 TESTER:
|
|
|
299 for my $tester (@all_tests) {
|
|
|
300 my ($name, $load, $in, $out, $splat, @data) = @$tester;
|
|
|
301 my ($iter, @out) = ref $out ? @$out : (1, $out);
|
|
|
302 my $obj;
|
|
|
303 if ($load) {
|
|
|
304 eval {
|
|
|
305 $compiler->reset();
|
|
|
306 $compiler->setoption('default_charset', 'ASCII');
|
|
|
307 $compiler->setoption('default_backend', 'Run');
|
|
|
308 $compiler->clearoption('preload');
|
|
|
309 $compiler->setoption('preload', $load);
|
|
|
310 $compiler->setoption('trace', 0);
|
|
|
311 $compiler->source('null.iacc');
|
|
|
312 $compiler->load_objects();
|
|
|
313 $obj = $compiler->get_object('null.iacc')
|
|
|
314 or die "Internal error: no compiler object\n";
|
|
|
315 };
|
|
|
316 if ($@) {
|
|
|
317 print STDERR "FAILED $name: $@";
|
|
|
318 print "not ok ", $testnum++, "\n" for (-1..$iter);
|
|
|
319 next;
|
|
|
320 }
|
|
|
321 } else {
|
|
|
322 $obj = new Language::INTERCAL::Interpreter($rc);
|
|
|
323 }
|
|
|
324 $obj->object->setbug(0, 0);
|
|
|
325 my $source = '';
|
|
|
326 my @code = ();
|
|
|
327 while (@data) {
|
|
|
328 my $ss = (shift @data) . "\n";
|
|
|
329 my $sp = shift @data;
|
|
|
330 my $sc = shift @data;
|
|
|
331 push @code, pack('C*', BC_STS, BC(length $source), BC(length $ss),
|
|
|
332 BC(0), BC(0), @$sp, @$sc);
|
|
|
333 $source .= $ss;
|
|
|
334 }
|
|
|
335 push @code, pack('C*', BC_STS, BC(length $source), BC(11),
|
|
|
336 BC(0), BC(0), BC_GUP);
|
|
|
337 $source .= "DO GIVE UP\n";
|
|
|
338 my $i_data = $in;
|
|
|
339 my $i_fh = Language::INTERCAL::GenericIO->new('STRING', 'w', \$i_data);
|
|
|
340 my $o_data = '';
|
|
|
341 my $o_fh = Language::INTERCAL::GenericIO->new('STRING', 'r', \$o_data);
|
|
|
342 eval {
|
|
|
343 $obj->object->source($source);
|
|
|
344 $obj->object->code(\@code);
|
|
|
345 $obj->setreg('@TRFH', $devnull);
|
|
|
346 $obj->setreg('@OWFH', $i_fh);
|
|
|
347 $obj->setreg('@OSFH', $o_fh);
|
|
|
348 $obj->setreg('@ORFH', $o_fh);
|
|
|
349 $obj->start()->run()->stop();
|
|
|
350 };
|
|
|
351 if ($@) {
|
|
|
352 print "not ok ", $testnum++, "\n" for (0..$iter);
|
|
|
353 print STDERR "Failed $name: $@";
|
|
|
354 next;
|
|
|
355 }
|
|
|
356 my $os = $obj->splat;
|
|
|
357 if (defined $os) {
|
|
|
358 print defined $splat && $os == $splat ? "" : "not ", "ok ", $testnum++, "\n";
|
|
|
359 print STDERR "Failed $name (*$os)\n" unless defined $splat && $os == $splat;
|
|
|
360 } else {
|
|
|
361 print defined $splat ? "not " : "", "ok ", $testnum++, "\n";
|
|
|
362 print STDERR "Failed $name (no splat)\n" if defined $splat;
|
|
|
363 }
|
|
|
364 my %out = map { ($_ => 0) } @out;
|
|
|
365 if (ref $out && $out->[0] == 1) {
|
|
|
366 my $ok = 1;
|
|
|
367 for my $o (@out) {
|
|
|
368 my $i = index($o_data, $o);
|
|
|
369 if ($i < 0) {
|
|
|
370 print STDERR "Failed $name: no $o", $o =~ /\n$/ ? '' : "\n";
|
|
|
371 $ok = 0;
|
|
|
372 } else {
|
|
|
373 substr($o_data, $i, length($o)) = '';
|
|
|
374 }
|
|
|
375 }
|
|
|
376 if ($o_data ne '') {
|
|
|
377 $ok and print STDERR "Failed $name: did not print $o_data", $o_data =~ /\n$/ ? '' : "\n";
|
|
|
378 $ok = 0;
|
|
|
379 }
|
|
|
380 print $ok ? '' : 'not ', "ok ", $testnum++, "\n";
|
|
|
381 } else {
|
|
|
382 print STDERR "Failed $name: no $o_data", $o_data =~ /\n$/ ? '' : "\n" if ! exists $out{$o_data};
|
|
|
383 print exists $out{$o_data} ? '' : 'not ', "ok ", $testnum++, "\n";
|
|
|
384 $out{$o_data}++ if exists $out{$o_data};
|
|
|
385 }
|
|
|
386 next unless ref $out;
|
|
|
387 next if $out->[0] == 1;
|
|
|
388 for (my $inum = 1; $inum < $iter; $inum++) {
|
|
|
389 $i_data = $in;
|
|
|
390 $o_data = '';
|
|
|
391 eval { $obj->start()->run()->stop() };
|
|
|
392 print STDERR "Failed $name: no $o_data", $o_data =~ /\n$/ ? '' : "\n" if ! exists $out{$o_data};
|
|
|
393 print exists $out{$o_data} ? '' : 'not ', "ok ", $testnum++, "\n";
|
|
|
394 $out{$o_data}++ if exists $out{$o_data};
|
|
|
395 }
|
|
|
396 }
|
|
|
397
|
|
|
398 sub _str {
|
|
|
399 my ($str) = @_;
|
|
|
400 return (BC_STR, BC(length $str), unpack('C*', $str));
|
|
|
401 }
|
|
|
402
|
