Commit | Line | Data |
2675e62c |
1 | #!./perl |
2 | |
3 | $| = 1; |
4 | |
5 | BEGIN { |
6 | chdir 't' if -d 't'; |
7 | unshift @INC, '../lib'; |
8 | } |
9 | |
10 | if ($^O eq 'VMS') { |
11 | print "1..11\n"; |
12 | foreach (1..11) { print "ok $_ # skipped for VMS\n"; } |
13 | exit 0; |
14 | } |
15 | |
16 | use Env qw(@FOO); |
17 | use vars qw(@BAR); |
18 | |
19 | sub array_equal |
20 | { |
21 | my ($a, $b) = @_; |
22 | return 0 unless scalar(@$a) == scalar(@$b); |
23 | for my $i (0..scalar(@$a) - 1) { |
24 | return 0 unless $a->[$i] eq $b->[$i]; |
25 | } |
26 | return 1; |
27 | } |
28 | |
29 | sub test |
30 | { |
31 | my ($desc, $code) = @_; |
32 | |
33 | &$code; |
34 | |
35 | print "# $desc...\n"; |
36 | print "# FOO = (", join(", ", @FOO), ")\n"; |
37 | print "# BAR = (", join(", ", @BAR), ")\n"; |
38 | |
39 | if (defined $check) { print "not " unless &$check; } |
40 | else { print "not " unless array_equal(\@FOO, \@BAR); } |
41 | |
42 | print "ok ", ++$i, "\n"; |
43 | } |
44 | |
45 | print "1..11\n"; |
46 | |
47 | test "Assignment", sub { |
48 | @FOO = qw(a B c); |
49 | @BAR = qw(a B c); |
50 | }; |
51 | |
52 | test "Storing", sub { |
53 | $FOO[1] = 'b'; |
54 | $BAR[1] = 'b'; |
55 | }; |
56 | |
57 | test "Truncation", sub { |
58 | $#FOO = 0; |
59 | $#BAR = 0; |
60 | }; |
61 | |
62 | test "Push", sub { |
63 | push @FOO, 'b', 'c'; |
64 | push @BAR, 'b', 'c'; |
65 | }; |
66 | |
67 | test "Pop", sub { |
68 | pop @FOO; |
69 | pop @BAR; |
70 | }; |
71 | |
72 | test "Shift", sub { |
73 | shift @FOO; |
74 | shift @BAR; |
75 | }; |
76 | |
77 | test "Push", sub { |
78 | push @FOO, 'c'; |
79 | push @BAR, 'c'; |
80 | }; |
81 | |
82 | test "Unshift", sub { |
83 | unshift @FOO, 'a'; |
84 | unshift @BAR, 'a'; |
85 | }; |
86 | |
87 | test "Reverse", sub { |
88 | @FOO = reverse @FOO; |
89 | @BAR = reverse @BAR; |
90 | }; |
91 | |
92 | test "Sort", sub { |
93 | @FOO = sort @FOO; |
94 | @BAR = sort @BAR; |
95 | }; |
96 | |
97 | test "Splice", sub { |
98 | splice @FOO, 1, 1, 'B'; |
99 | splice @BAR, 1, 1, 'B'; |
100 | }; |