t/lib/glob-global.t

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