home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / dosglob.t < prev    next >
Text File  |  1999-07-20  |  2KB  |  113 lines
  1. #!./perl
  2.  
  3. #
  4. # test glob() in File::DosGlob
  5. #
  6.  
  7. BEGIN {
  8.     chdir 't' if -d 't';
  9.     unshift @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
  113.