← Back to branch summary

~ubuntu-branches/ubuntu/trusty/clc-intercal/trusty-proposed

« back to all changes in this revision

Viewing changes to t/27array.t

  • Committer: Bazaar Package Importer
  • Author(s): Mark Brown
  • Date: 2006-10-08 13:30:54 UTC
  • mfrom: (1.1.1 upstream) (3.1.1 dapper)
  • Revision ID: james.westby@ubuntu.com-20061008133054-fto70u71yoyltr3m
Tags: 1:1.0~2pre1.-94.-4.1-1
* New upstream release.
* Change to dh_installman.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/27array.t
1
 
# this program creates a multiplication table, then reads pairs of numbers
2
 
# from its standard input (until it receives a zero) and output the product of
3
 
# each pair. The loops make use of computed COME FROM in some interesting way.
4
 
 
5
 
use Language::INTERCAL;
6
 
use Language::INTERCAL::Runtime::Library;
7
 
 
8
 
my @range = (0..99);
9
 
 
10
 
print "1..", 6 * (2 + @range), "\n";
11
 
 
12
 
my %range = map { ($_, 1 + int(rand 65535)) } @range;
13
 
my @data = map { (1 + ($_ % 10), 1 + int($_ / 10), $range{$_}) } @range;
14
 
push @data, 0;
15
 
 
16
 
for (my $i = 0; $i < 10000; $i++) {
17
 
    my $a = rand(scalar @range);
18
 
    my $b = rand(scalar @range);
19
 
    @range[$a, $b] = @range[$b, $a];
20
 
}
21
 
push @data, map { (1 + ($_ % 10), 1 + int($_ / 10)) } @range;
22
 
push @data, 0;
23
 
@range = map { $range{$_} } @range;
24
 
 
25
 
my @stdin;
26
 
my @stdout;
27
 
 
28
 
my $prog = '
29
 
@@@@��@^�@L`@{��@��@{��
30
 
@@@@������@����@����@M�]
31
 
@@@@��@�����@��@K�
32
 
@@@@��@K�@L`@K��@�@{�����
33
 
@@@@��@K�@L`@K��@�@{��
34
 
@@@@��@K�@L`@K��@�@{�
35
 
@@@@��@K�@L`@K��@�@{�
36
 
M�]@��@z�@L`@K�@J@{�
37
 
M�]@������@��@���@�����
38
 
@@@@������@����@����@z�
39
 
@@@@��@�����@��@K�
40
 
@@@@��@�����@��@z�
41
 
M�]@��@^�@���@K�@K�@L`@z�
42
 
@@@@������@����@����@M�]
43
 
@@@@������@����@����@M�]
44
 
@@@@��@�����@��@K�
45
 
@@@@��@K�@L`@K��@�@{�����
46
 
@@@@��@K�@L`@K��@�@{��
47
 
@@@@��@K�@L`@K��@�@{�
48
 
@@@@��@K�@L`@K��@�@{�
49
 
@@@@��@z�@L`@K�@J@{�
50
 
@@@@��@K�@L`@z�@�@{�
51
 
M�]@��@z�@L`@K�@J@{�
52
 
M�]@������@��@���@�����
53
 
@@@@������@����@����@z�
54
 
@@@@��@z�@L`@{�
55
 
@@@@��@�����@��@K�
56
 
@@@@��@z�@L`@^�@���@K�@K�
57
 
M�]@��@����@���@z�
58
 
@@@@������@����@����@M�]
59
 
@@@@������@����@��
60
 
';
61
 
 
62
 
fiddle Language::INTERCAL 'bug=0', 'ubug=0';
63
 
 
64
 
my $testnum = 1;
65
 
my $count;
66
 
 
67
 
compile Language::INTERCAL 'prog', $prog;
68
 
@stdin = @data;
69
 
@stdout = ();
70
 
eval { prog(\&stdin, \@stdout) };
71
 
print STDERR $@;
72
 
print $@ ? "not " : "", "ok ", $testnum++, "\n";
73
 
print @stdout == @range ? "" : "not ", "ok ", $testnum++, "\n";
74
 
@stdin = @range;
75
 
while (@stdout && @stdin) {
76
 
    my $out = shift @stdout;
77
 
    my $in = shift @stdin;
78
 
    print $out eq roman($in, 0) . "\n" ? '' : 'not ', "ok ", $testnum++, "\n";
79
 
}
80
 
while (@stdin) {
81
 
    shift @stdin;
82
 
    print "not ok ", $testnum++, "\n";
83
 
}
84
 
 
85
 
compile Language::INTERCAL 'prog_o', $prog, 'opt';
86
 
@stdin = @data;
87
 
@stdout = ();
88
 
eval { prog_o(\&stdin, \@stdout) };
89
 
print STDERR $@;
90
 
print $@ ? "not " : "", "ok ", $testnum++, "\n";
91
 
print @stdout == @range ? "" : "not ", "ok ", $testnum++, "\n";
92
 
@stdin = @range;
93
 
while (@stdout && @stdin) {
94
 
    my $out = shift @stdout;
95
 
    my $in = shift @stdin;
96
 
    print $out eq roman($in, 0) . "\n" ? '' : 'not ', "ok ", $testnum++, "\n";
97
 
}
98
 
while (@stdin) {
99
 
    shift @stdin;
100
 
    print "not ok ", $testnum++, "\n";
101
 
}
102
 
 
103
 
compile Language::INTERCAL 'prog_q', $prog, 'quantum';
104
 
@stdin = @data;
105
 
@stdout = ();
106
 
eval { prog_q(\&stdin, \@stdout) };
107
 
print STDERR $@;
108
 
print $@ ? "not " : "", "ok ", $testnum++, "\n";
109
 
print @stdout == @range ? "" : "not ", "ok ", $testnum++, "\n";
110
 
@stdin = @range;
111
 
while (@stdout && @stdin) {
112
 
    my $out = shift @stdout;
113
 
    my $in = shift @stdin;
114
 
    print $out eq roman($in, 0) . "\n" ? '' : 'not ', "ok ", $testnum++, "\n";
115
 
}
116
 
while (@stdin) {
117
 
    shift @stdin;
118
 
    print "not ok ", $testnum++, "\n";
119
 
}
120
 
 
121
 
compile Language::INTERCAL 'prog_p', $prog, 'post';
122
 
@stdin = @data;
123
 
@stdout = ();
124
 
eval { prog_p(\&stdin, \@stdout) };
125
 
print STDERR $@;
126
 
print $@ ? "not " : "", "ok ", $testnum++, "\n";
127
 
print @stdout == @range ? "" : "not ", "ok ", $testnum++, "\n";
128
 
@stdin = @range;
129
 
while (@stdout && @stdin) {
130
 
    my $out = shift @stdout;
131
 
    my $in = shift @stdin;
132
 
    print $out eq roman($in, 0) . "\n" ? '' : 'not ', "ok ", $testnum++, "\n";
133
 
}
134
 
while (@stdin) {
135
 
    shift @stdin;
136
 
    print "not ok ", $testnum++, "\n";
137
 
}
138
 
 
139
 
compile Language::INTERCAL 'prog_qp', $prog, 'quantum', 'post';
140
 
@stdin = @data;
141
 
@stdout = ();
142
 
eval { prog_qp(\&stdin, \@stdout) };
143
 
print STDERR $@;
144
 
print $@ ? "not " : "", "ok ", $testnum++, "\n";
145
 
print @stdout == @range ? "" : "not ", "ok ", $testnum++, "\n";
146
 
@stdin = @range;
147
 
while (@stdout && @stdin) {
148
 
    my $out = shift @stdout;
149
 
    my $in = shift @stdin;
150
 
    print $out eq roman($in, 0) . "\n" ? '' : 'not ', "ok ", $testnum++, "\n";
151
 
}
152
 
while (@stdin) {
153
 
    shift @stdin;
154
 
    print "not ok ", $testnum++, "\n";
155
 
}
156
 
 
157
 
compile Language::INTERCAL 'prog_d', $prog, 'dbhook';
158
 
@stdin = @data;
159
 
@stdout = ();
160
 
_run_db(prog_d(\&stdin, \@stdout));
161
 
print STDERR $@;
162
 
print $@ ? "not " : "", "ok ", $testnum++, "\n";
163
 
print @stdout == @range ? "" : "not ", "ok ", $testnum++, "\n";
164
 
@stdin = @range;
165
 
while (@stdout && @stdin) {
166
 
    my $out = shift @stdout;
167
 
    my $in = shift @stdin;
168
 
    print $out eq roman($in, 0) . "\n" ? '' : 'not ', "ok ", $testnum++, "\n";
169
 
}
170
 
while (@stdin) {
171
 
    shift @stdin;
172
 
    print "not ok ", $testnum++, "\n";
173
 
}
174
 
 
175
 
sub stdin {
176
 
    join('@', map { ['����',
177
 
                     '���',
178
 
                     '���',
179
 
                     '�����',
180
 
                     '����',
181
 
                     '����',
182
 
                     '���',
183
 
                     '�����',
184
 
                     '�����',
185
 
                     '����' ]->[$_] } split(/ *?/, shift @stdin));
186
 
}
187