lib/Env/env.t

   1 #!./perl
   2
   3 $| = 1;
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @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 };