t/lib/glob-global.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     if ($^O eq 'MacOS') {
   6         @INC = qw(: ::lib ::macos:lib);
   7     } else {
   8         @INC = '.';
   9         push @INC, '../lib';
  10     }
  11     require Config; import Config;
  12     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
  13         print "1..0\n";
  14         exit 0;
  15     }
  16     print "1..10\n";
  17 }
  18 END {
  19     print "not ok 1\n" unless $loaded;
  20 }
  21
  22 BEGIN {
  23     *CORE::GLOBAL::glob = sub { "Just another Perl hacker," };
  24 }
  25
  26 BEGIN {
  27     if ("Just another Perl hacker," ne (<*>)[0]) {
  28         die <<EOMessage;
  29 Your version of perl ($]) doesn't seem to allow extensions to override
  30 the core glob operator.
  31 EOMessage
  32     }
  33 }
  34
  35 use File::Glob ':globally';
  36 $loaded = 1;
  37 print "ok 1\n";
  38
  39 $_ = $^O eq "MacOS" ? ":lib:*.t" : "lib/*.t";
  40 my @r = glob;
  41 print "not " if $_ ne ($^O eq "MacOS" ? ":lib:*.t" : "lib/*.t");
  42 print "ok 2\n";
  43
  44 # we should have at least basic.t, global.t, taint.t
  45 print "# |@r|\nnot " if @r < 3;
  46 print "ok 3\n";
  47
  48 # check if <*/*> works
  49 if ($^O eq "MacOS") {
  50     @r = <:*:*.t>;
  51 } else {
  52     @r = <*/*.t>;
  53 }
  54 # at least t/global.t t/basic.t, t/taint.t
  55 print "not " if @r < 3;
  56 print "ok 4\n";
  57 my $r = scalar @r;
  58
  59 # check if scalar context works
  60 @r = ();
  61 if ($^O eq "MacOS") {
  62     while (defined($_ = <:*:*.t>)) {
  63         #print "# $_\n";
  64         push @r, $_;
  65     }
  66 } else {
  67     while (defined($_ = <*/*.t>)) {
  68         #print "# $_\n";
  69         push @r, $_;
  70     }
  71 }
  72 print "not " if @r != $r;
  73 print "ok 5\n";
  74
  75 # check if list context works
  76 @r = ();
  77 if ($^O eq "MacOS") {
  78     for (<:*:*.t>) {
  79         #print "# $_\n";
  80         push @r, $_;
  81     }
  82 } else {
  83     for (<*/*.t>) {
  84         #print "# $_\n";
  85         push @r, $_;
  86     }
  87 }
  88 print "not " if @r != $r;
  89 print "ok 6\n";
  90
  91 # test if implicit assign to $_ in while() works
  92 @r = ();
  93 if ($^O eq "MacOS") {
  94     while (<:*:*.t>) {
  95         #print "# $_\n";
  96         push @r, $_;
  97     }
  98 } else {
  99     while (<*/*.t>) {
 100         #print "# $_\n";
 101         push @r, $_;
 102     }
 103 }
 104 print "not " if @r != $r;
 105 print "ok 7\n";
 106
 107 # test if explicit glob() gets assign magic too
 108 my @s = ();
 109 while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
 110     #print "# $_\n";
 111     push @s, $_;
 112 }
 113 print "not " if "@r" ne "@s";
 114 print "ok 8\n";
 115
 116 # how about in a different package, like?
 117 package Foo;
 118 use File::Glob ':globally';
 119 @s = ();
 120 while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
 121     #print "# $_\n";
 122     push @s, $_;
 123 }
 124 print "not " if "@r" ne "@s";
 125 print "ok 9\n";
 126
 127 # test if different glob ops maintain independent contexts
 128 @s = ();
 129 my $i = 0;
 130 if ($^O eq "MacOS") {
 131     while (<:*:*.t>) {
 132         #print "# $_ <";
 133         push @s, $_;
 134         while (<:bas*:*.t>) {
 135             #print " $_";
 136             $i++;
 137         }
 138         #print " >\n";
 139     }
 140 } else {
 141     while (<*/*.t>) {
 142         #print "# $_ <";
 143         push @s, $_;
 144         while (<bas*/*.t>) {
 145             #print " $_";
 146             $i++;
 147         }
 148         #print " >\n";
 149     }
 150 }
 151 print "not " if "@r" ne "@s" or not $i;
 152 print "ok 10\n";