lib/File/DosGlob.t

   1 #!./perl
   2
   3 #
   4 # test glob() in File::DosGlob
   5 #
   6
   7 BEGIN {
   8     chdir 't' if -d 't';
   9     @INC = '../lib';
  10 }
  11
  12 print "1..10\n";
  13
  14 # override it in main::
  15 use File::DosGlob 'glob';
  16
  17 # test if $_ takes as the default
  18 $_ = "op/a*.t";
  19 my @r = glob;
  20 print "not " if $_ ne 'op/a*.t';
  21 print "ok 1\n";
  22 print "# |@r|\nnot " if @r < 9;
  23 print "ok 2\n";
  24
  25 # check if <*/*> works
  26 @r = <*/a*.t>;
  27 # atleast {argv,abbrev,anydbm,autoloader,append,arith,array,assignwarn,auto}.t
  28 print "not " if @r < 9;
  29 print "ok 3\n";
  30 my $r = scalar @r;
  31
  32 # check if scalar context works
  33 @r = ();
  34 while (defined($_ = <*/a*.t>)) {
  35     print "# $_\n";
  36     push @r, $_;
  37 }
  38 print "not " if @r != $r;
  39 print "ok 4\n";
  40
  41 # check if list context works
  42 @r = ();
  43 for (<*/a*.t>) {
  44     print "# $_\n";
  45     push @r, $_;
  46 }
  47 print "not " if @r != $r;
  48 print "ok 5\n";
  49
  50 # test if implicit assign to $_ in while() works
  51 @r = ();
  52 while (<*/a*.t>) {
  53     print "# $_\n";
  54     push @r, $_;
  55 }
  56 print "not " if @r != $r;
  57 print "ok 6\n";
  58
  59 # test if explicit glob() gets assign magic too
  60 my @s = ();
  61 while (glob '*/a*.t') {
  62     print "# $_\n";
  63     push @s, $_;
  64 }
  65 print "not " if "@r" ne "@s";
  66 print "ok 7\n";
  67
  68 # how about in a different package, like?
  69 package Foo;
  70 use File::DosGlob 'glob';
  71 @s = ();
  72 while (glob '*/a*.t') {
  73     print "# $_\n";
  74     push @s, $_;
  75 }
  76 print "not " if "@r" ne "@s";
  77 print "ok 8\n";
  78
  79 # test if different glob ops maintain independent contexts
  80 @s = ();
  81 while (<*/a*.t>) {
  82     my $i = 0;
  83     print "# $_ <";
  84     push @s, $_;
  85     while (<*/b*.t>) {
  86         print " $_";
  87         $i++;
  88     }
  89     print " >\n";
  90 }
  91 print "not " if "@r" ne "@s";
  92 print "ok 9\n";
  93
  94 # how about a global override, hm?
  95 eval <<'EOT';
  96 use File::DosGlob 'GLOBAL_glob';
  97 package Bar;
  98 @s = ();
  99 while (<*/a*.t>) {
 100     my $i = 0;
 101     print "# $_ <";
 102     push @s, $_;
 103     while (glob '*/b*.t') {
 104         print " $_";
 105         $i++;
 106     }
 107     print " >\n";
 108 }
 109 print "not " if "@r" ne "@s";
 110 print "ok 10\n";
 111 EOT