t/lib/glob-basic.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @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..9\n";
  12 }
  13 END {
  14     print "not ok 1\n" unless $loaded;
  15 }
  16 use File::Glob ':glob';
  17 use Cwd ();
  18 $loaded = 1;
  19 print "ok 1\n";
  20
  21 sub array {
  22     return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
  23 }
  24
  25 # look for the contents of the current directory
  26 $ENV{PATH} = "/bin";
  27 delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
  28 @correct = ();
  29 if (opendir(D, ".")) {
  30    @correct = grep { !/^\./ } sort readdir(D);
  31    closedir D;
  32 }
  33 @a = File::Glob::glob("*", 0);
  34 @a = sort @a;
  35 if ("@a" ne "@correct" || GLOB_ERROR) {
  36     print "# |@a| ne |@correct|\nnot ";
  37 }
  38 print "ok 2\n";
  39
  40 # look up the user's home directory
  41 # should return a list with one item, and not set ERROR
  42 if ($^O ne 'MSWin32' && $^O ne 'VMS') {
  43   eval {
  44     ($name, $home) = (getpwuid($>))[0,7];
  45     1;
  46   } and do {
  47     @a = bsd_glob("~$name", GLOB_TILDE);
  48     if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) {
  49         print "not ";
  50     }
  51   };
  52 }
  53 print "ok 3\n";
  54
  55 # check backslashing
  56 # should return a list with one item, and not set ERROR
  57 @a = bsd_glob('TEST', GLOB_QUOTE);
  58 if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
  59     local $/ = "][";
  60     print "# [@a]\n";
  61     print "not ";
  62 }
  63 print "ok 4\n";
  64
  65 # check nonexistent checks
  66 # should return an empty list
  67 # XXX since errfunc is NULL on win32, this test is not valid there
  68 @a = bsd_glob("asdfasdf", 0);
  69 if ($^O ne 'MSWin32' and scalar @a != 0) {
  70     print "# |@a|\nnot ";
  71 }
  72 print "ok 5\n";
  73
  74 # check bad protections
  75 # should return an empty list, and set ERROR
  76 if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'os2' or $^O eq 'VMS'
  77     or $^O eq 'cygwin' or Cwd::cwd() =~ m#^/afs#s or not $>)
  78 {
  79     print "ok 6 # skipped\n";
  80 }
  81 else {
  82     $dir = "PtEeRsLt.dir";
  83     mkdir $dir, 0;
  84     @a = bsd_glob("$dir/*", GLOB_ERR);
  85     #print "\@a = ", array(@a);
  86     rmdir $dir;
  87     if (scalar(@a) != 0 || GLOB_ERROR == 0) {
  88         print "not ";
  89     }
  90     print "ok 6\n";
  91 }
  92
  93 # check for csh style globbing
  94 @a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
  95 unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
  96     print "not ";
  97 }
  98 print "ok 7\n";
  99
 100 @a = bsd_glob(
 101     '{TES*,doesntexist*,a,b}',
 102     GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
 103 );
 104
 105 # Working on t/TEST often causes this test to fail because it sees Emacs temp
 106 # and RCS files.  Filter them out, and .pm files too, and patch temp files.
 107 @a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
 108
 109 print "# @a\n";
 110
 111 unless (@a == 3
 112         and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
 113         and $a[1] eq 'a'
 114         and $a[2] eq 'b')
 115 {
 116     print "not ";
 117 }
 118 print "ok 8\n";
 119
 120 # "~" should expand to $ENV{HOME}
 121 $ENV{HOME} = "sweet home";
 122 @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
 123 unless (@a == 1 and $a[0] eq $ENV{HOME}) {
 124     print "not ";
 125 }
 126 print "ok 9\n";