home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / lib / glob-global.t < prev    next >
Text File  |  2000-02-21  |  2KB  |  111 lines
  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 array 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";
  111.