ext/File/Glob/t/basic.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     if ($^O eq 'MacOS') {
   6         @INC = qw(: ::lib ::macos:lib);
   7     } else {
   8         @INC = '.';
   9         push @INC, '../lib';
  10     }
  11     require Config; import Config;
  12     if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) {
  13         print "1..0\n";
  14         exit 0;
  15     }
  16     print "1..12\n";
  17 }
  18 END {
  19     print "not ok 1\n" unless $loaded;
  20 }
  21 use File::Glob ':glob';
  22 use Cwd ();
  23 $loaded = 1;
  24 print "ok 1\n";
  25
  26 sub array {
  27     return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n";
  28 }
  29
  30 # look for the contents of the current directory
  31 $ENV{PATH} = "/bin";
  32 delete @ENV{BASH_ENV, CDPATH, ENV, IFS};
  33 @correct = ();
  34 if (opendir(D, $^O eq "MacOS" ? ":" : ".")) {
  35    @correct = grep { !/^\./ } sort readdir(D);
  36    closedir D;
  37 }
  38 @a = File::Glob::glob("*", 0);
  39 @a = sort @a;
  40 if ("@a" ne "@correct" || GLOB_ERROR) {
  41     print "# |@a| ne |@correct|\nnot ";
  42 }
  43 print "ok 2\n";
  44
  45 # look up the user's home directory
  46 # should return a list with one item, and not set ERROR
  47 if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS' && $^O ne 'os2'
  48     && $^O ne 'beos') {
  49   eval {
  50     ($name, $home) = (getpwuid($>))[0,7];
  51     1;
  52   } and do {
  53     if (defined $home && defined $name && -d $home) {
  54         @a = bsd_glob("~$name", GLOB_TILDE);
  55         if ((scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR)) {
  56             print "not ";
  57         }
  58     }
  59   };
  60 }
  61 print "ok 3\n";
  62
  63 # check backslashing
  64 # should return a list with one item, and not set ERROR
  65 @a = bsd_glob('TEST', GLOB_QUOTE);
  66 if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) {
  67     local $/ = "][";
  68     print "# [@a]\n";
  69     print "not ";
  70 }
  71 print "ok 4\n";
  72
  73 # check nonexistent checks
  74 # should return an empty list
  75 # XXX since errfunc is NULL on win32, this test is not valid there
  76 @a = bsd_glob("asdfasdf", 0);
  77 if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) {
  78     print "# |@a|\nnot ";
  79 }
  80 print "ok 5\n";
  81
  82 # check bad protections
  83 # should return an empty list, and set ERROR
  84 if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS'
  85     or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>)
  86 {
  87     print "ok 6 # skipped\n";
  88 }
  89 else {
  90     $dir = "pteerslo";
  91     mkdir $dir, 0;
  92     @a = bsd_glob("$dir/*", GLOB_ERR);
  93     #print "\@a = ", array(@a);
  94     rmdir $dir;
  95     if (scalar(@a) != 0 || GLOB_ERROR == 0) {
  96         if ($^O eq 'vos') {
  97             print "not ok 6 # TODO hit VOS bug posix-956\n";
  98         } else {
  99             print "not ok 6\n";
 100         }
 101     }
 102     else {
 103         print "ok 6\n";
 104     }
 105 }
 106
 107 # check for csh style globbing
 108 @a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC);
 109 unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') {
 110     print "not ";
 111 }
 112 print "ok 7\n";
 113
 114 @a = bsd_glob(
 115     '{TES*,doesntexist*,a,b}',
 116     GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0)
 117 );
 118
 119 # Working on t/TEST often causes this test to fail because it sees Emacs temp
 120 # and RCS files.  Filter them out, and .pm files too, and patch temp files.
 121 @a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a;
 122 @a = (grep !/test.pl/, @a) if $^O eq 'VMS';
 123
 124 print "# @a\n";
 125
 126 unless (@a == 3
 127         and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST')
 128         and $a[1] eq 'a'
 129         and $a[2] eq 'b')
 130 {
 131     print "not ok 8 # @a\n";
 132 } else {
 133     print "ok 8\n";
 134 }
 135
 136 # "~" should expand to $ENV{HOME}
 137 $ENV{HOME} = "sweet home";
 138 @a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC);
 139 unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) {
 140     print "not ";
 141 }
 142 print "ok 9\n";
 143
 144 # GLOB_ALPHASORT (default) should sort alphabetically regardless of case
 145 mkdir "pteerslo", 0777;
 146 chdir "pteerslo";
 147
 148 @f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl);
 149 @f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl);
 150 if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER
 151     @f_names = sort(@f_names);
 152 }
 153 if ($^O eq 'VMS') { # VMS is happily caseignorant
 154     @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl);
 155     @f_names = @f_alpha;
 156 }
 157
 158 for (@f_names) {
 159     open T, "> $_";
 160     close T;
 161 }
 162
 163 $pat = "*.pl";
 164
 165 $ok = 1;
 166 @g_names = bsd_glob($pat, 0);
 167 print "# f_names = @f_names\n";
 168 print "# g_names = @g_names\n";
 169 for (@f_names) {
 170     $ok = 0 unless $_ eq shift @g_names;
 171 }
 172 print $ok ? "ok 10\n" : "not ok 10\n";
 173
 174 $ok = 1;
 175 @g_alpha = bsd_glob($pat);
 176 print "# f_alpha = @f_alpha\n";
 177 print "# g_alpha = @g_alpha\n";
 178 for (@f_alpha) {
 179     $ok = 0 unless $_ eq shift @g_alpha;
 180 }
 181 print $ok ? "ok 11\n" : "not ok 11\n";
 182
 183 unlink @f_names;
 184 chdir "..";
 185 rmdir "pteerslo";
 186
 187 # this can panic if PL_glob_index gets passed as flags to bsd_glob
 188 <*>; <*>;
 189 print "ok 12\n";