ext/File-Glob/t/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" ? ":op:*.t" : "op/*.t";
  40 my @r = glob;
  41 print "not " if $_ ne ($^O eq "MacOS" ? ":op:*.t" : "op/*.t");
  42 print "ok 2\n";
  43
  44 print "# |@r|\nnot " if @r < 3;
  45 print "ok 3\n";
  46
  47 # check if <*/*> works
  48 if ($^O eq "MacOS") {
  49     @r = <:*:*.t>;
  50 } else {
  51     @r = <*/*.t>;
  52 }
  53 # at least t/global.t t/basic.t, t/taint.t
  54 print "not " if @r < 3;
  55 print "ok 4\n";
  56 my $r = scalar @r;
  57
  58 # check if scalar context works
  59 @r = ();
  60 if ($^O eq "MacOS") {
  61     while (defined($_ = <:*:*.t>)) {
  62         #print "# $_\n";
  63         push @r, $_;
  64     }
  65 } else {
  66     while (defined($_ = <*/*.t>)) {
  67         #print "# $_\n";
  68         push @r, $_;
  69     }
  70 }
  71 print "not " if @r != $r;
  72 print "ok 5\n";
  73
  74 # check if list context works
  75 @r = ();
  76 if ($^O eq "MacOS") {
  77     for (<:*:*.t>) {
  78         #print "# $_\n";
  79         push @r, $_;
  80     }
  81 } else {
  82     for (<*/*.t>) {
  83         #print "# $_\n";
  84         push @r, $_;
  85     }
  86 }
  87 print "not " if @r != $r;
  88 print "ok 6\n";
  89
  90 # test if implicit assign to $_ in while() works
  91 @r = ();
  92 if ($^O eq "MacOS") {
  93     while (<:*:*.t>) {
  94         #print "# $_\n";
  95         push @r, $_;
  96     }
  97 } else {
  98     while (<*/*.t>) {
  99         #print "# $_\n";
 100         push @r, $_;
 101     }
 102 }
 103 print "not " if @r != $r;
 104 print "ok 7\n";
 105
 106 # test if explicit glob() gets assign magic too
 107 my @s = ();
 108 while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
 109     #print "# $_\n";
 110     push @s, $_;
 111 }
 112 print "not " if "@r" ne "@s";
 113 print "ok 8\n";
 114
 115 # how about in a different package, like?
 116 package Foo;
 117 use File::Glob ':globally';
 118 @s = ();
 119 while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) {
 120     #print "# $_\n";
 121     push @s, $_;
 122 }
 123 print "not " if "@r" ne "@s";
 124 print "ok 9\n";
 125
 126 # test if different glob ops maintain independent contexts
 127 @s = ();
 128 my $i = 0;
 129 if ($^O eq "MacOS") {
 130     while (<:*:*.t>) {
 131         #print "# $_ <";
 132         push @s, $_;
 133         while (<:bas*:*.t>) {
 134             #print " $_";
 135             $i++;
 136         }
 137         #print " >\n";
 138     }
 139 } else {
 140     while (<*/*.t>) {
 141         #print "# $_ <";
 142         push @s, $_;
 143         while (<bas*/*.t>) {
 144             #print " $_";
 145             $i++;
 146         }
 147         #print " >\n";
 148     }
 149 }
 150 print "not " if "@r" ne "@s" or not $i;
 151 print "ok 10\n";