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