This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add $Config('scriptdir'} on VMS
[perl5.git] / lib / Env / env.t
CommitLineData
2675e62c
GS
1#!./perl
2
3$| = 1;
4
5BEGIN {
6 chdir 't' if -d 't';
20822f61 7 @INC = '../lib';
2675e62c
GS
8}
9
10if ($^O eq 'VMS') {
11 print "1..11\n";
12 foreach (1..11) { print "ok $_ # skipped for VMS\n"; }
13 exit 0;
14}
15
16use Env qw(@FOO);
17use vars qw(@BAR);
18
19sub 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
29sub 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
45print "1..11\n";
46
47test "Assignment", sub {
48 @FOO = qw(a B c);
49 @BAR = qw(a B c);
50};
51
52test "Storing", sub {
53 $FOO[1] = 'b';
54 $BAR[1] = 'b';
55};
56
57test "Truncation", sub {
58 $#FOO = 0;
59 $#BAR = 0;
60};
61
62test "Push", sub {
63 push @FOO, 'b', 'c';
64 push @BAR, 'b', 'c';
65};
66
67test "Pop", sub {
68 pop @FOO;
69 pop @BAR;
70};
71
72test "Shift", sub {
73 shift @FOO;
74 shift @BAR;
75};
76
77test "Push", sub {
78 push @FOO, 'c';
79 push @BAR, 'c';
80};
81
82test "Unshift", sub {
83 unshift @FOO, 'a';
84 unshift @BAR, 'a';
85};
86
87test "Reverse", sub {
88 @FOO = reverse @FOO;
89 @BAR = reverse @BAR;
90};
91
92test "Sort", sub {
93 @FOO = sort @FOO;
94 @BAR = sort @BAR;
95};
96
97test "Splice", sub {
98 splice @FOO, 1, 1, 'B';
99 splice @BAR, 1, 1, 'B';
100};