diff options
author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2001-06-21 17:11:35 +0000 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2001-06-21 17:11:35 +0000 |
commit | 5629c67553f30a19f4842982925a3d994d46684c (patch) | |
tree | c2ca594d67589836be20cf530453a3669c688066 /lib/File | |
parent | 1244b64003dd8dbc75cb8ee237b478b3077523f0 (diff) | |
download | perl-5629c67553f30a19f4842982925a3d994d46684c.tar.gz |
Integrate mainline
p4raw-id: //depot/perlio@10794
Diffstat (limited to 'lib/File')
-rwxr-xr-x | lib/File/Find/find.t | 2 | ||||
-rwxr-xr-x | lib/File/Glob/basic.t | 175 | ||||
-rwxr-xr-x | lib/File/Glob/case.t | 60 | ||||
-rwxr-xr-x | lib/File/Glob/global.t | 151 | ||||
-rwxr-xr-x | lib/File/Glob/taint.t | 31 | ||||
-rwxr-xr-x | lib/File/Temp/t/mktemp.t (renamed from lib/File/Temp/mktemp.t) | 0 | ||||
-rwxr-xr-x | lib/File/Temp/t/posix.t (renamed from lib/File/Temp/posix.t) | 0 | ||||
-rwxr-xr-x | lib/File/Temp/t/security.t (renamed from lib/File/Temp/security.t) | 0 | ||||
-rwxr-xr-x | lib/File/Temp/t/tempfile.t (renamed from lib/File/Temp/tempfile.t) | 0 |
9 files changed, 1 insertions, 418 deletions
diff --git a/lib/File/Find/find.t b/lib/File/Find/find.t index cdd9290770..e82aefd5e2 100755 --- a/lib/File/Find/find.t +++ b/lib/File/Find/find.t @@ -20,7 +20,7 @@ else { print "1..78\n"; } use File::Find; use File::Spec; -if ($^O eq 'MSWin32') +if ($^O eq 'MSWin32' || $^O eq 'cygwin') { # This is a hack - at present File::Find does not produce native names on Win32 # So force File::Spec to use Unix names. diff --git a/lib/File/Glob/basic.t b/lib/File/Glob/basic.t deleted file mode 100755 index 3c931e7e01..0000000000 --- a/lib/File/Glob/basic.t +++ /dev/null @@ -1,175 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - if ($^O eq 'MacOS') { - @INC = qw(: ::lib ::macos:lib); - } else { - @INC = '.'; - push @INC, '../lib'; - } - require Config; import Config; - if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { - print "1..0\n"; - exit 0; - } - print "1..11\n"; -} -END { - print "not ok 1\n" unless $loaded; -} -use File::Glob ':glob'; -use Cwd (); -$loaded = 1; -print "ok 1\n"; - -sub array { - return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n"; -} - -# look for the contents of the current directory -$ENV{PATH} = "/bin"; -delete @ENV{BASH_ENV, CDPATH, ENV, IFS}; -@correct = (); -if (opendir(D, $^O eq "MacOS" ? ":" : ".")) { - @correct = grep { !/^\./ } sort readdir(D); - closedir D; -} -@a = File::Glob::glob("*", 0); -@a = sort @a; -if ("@a" ne "@correct" || GLOB_ERROR) { - print "# |@a| ne |@correct|\nnot "; -} -print "ok 2\n"; - -# look up the user's home directory -# should return a list with one item, and not set ERROR -if ($^O ne 'MSWin32' && $^O ne 'NetWare' && $^O ne 'VMS' && $^O ne 'os2') { - eval { - ($name, $home) = (getpwuid($>))[0,7]; - 1; - } and do { - @a = bsd_glob("~$name", GLOB_TILDE); - if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) { - print "not "; - } - }; -} -print "ok 3\n"; - -# check backslashing -# should return a list with one item, and not set ERROR -@a = bsd_glob('TEST', GLOB_QUOTE); -if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) { - local $/ = "]["; - print "# [@a]\n"; - print "not "; -} -print "ok 4\n"; - -# check nonexistent checks -# should return an empty list -# XXX since errfunc is NULL on win32, this test is not valid there -@a = bsd_glob("asdfasdf", 0); -if (($^O ne 'MSWin32' && $^O ne 'NetWare') and scalar @a != 0) { - print "# |@a|\nnot "; -} -print "ok 5\n"; - -# check bad protections -# should return an empty list, and set ERROR -if ($^O eq 'mpeix' or $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'os2' or $^O eq 'VMS' - or $^O eq 'cygwin' or Cwd::cwd() =~ m#^$Config{'afsroot'}#s or not $>) -{ - print "ok 6 # skipped\n"; -} -else { - $dir = "pteerslt"; - mkdir $dir, 0; - @a = bsd_glob("$dir/*", GLOB_ERR); - #print "\@a = ", array(@a); - rmdir $dir; - if (scalar(@a) != 0 || GLOB_ERROR == 0) { - print "not "; - } - print "ok 6\n"; -} - -# check for csh style globbing -@a = bsd_glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC); -unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') { - print "not "; -} -print "ok 7\n"; - -@a = bsd_glob( - '{TES*,doesntexist*,a,b}', - GLOB_BRACE | GLOB_NOMAGIC | ($^O eq 'VMS' ? GLOB_NOCASE : 0) -); - -# Working on t/TEST often causes this test to fail because it sees Emacs temp -# and RCS files. Filter them out, and .pm files too, and patch temp files. -@a = grep !/(,v$|~$|\.(pm|ori?g|rej)$)/, @a; - -print "# @a\n"; - -unless (@a == 3 - and $a[0] eq ($^O eq 'VMS'? 'test.' : 'TEST') - and $a[1] eq 'a' - and $a[2] eq 'b') -{ - print "not ok 8 # @a"; -} else { - print "ok 8\n"; -} - -# "~" should expand to $ENV{HOME} -$ENV{HOME} = "sweet home"; -@a = bsd_glob('~', GLOB_TILDE | GLOB_NOMAGIC); -unless ($^O eq "MacOS" || (@a == 1 and $a[0] eq $ENV{HOME})) { - print "not "; -} -print "ok 9\n"; - -# GLOB_ALPHASORT (default) should sort alphabetically regardless of case -mkdir "pteerslt", 0777; -chdir "pteerslt"; - -@f_names = qw(Ax.pl Bx.pl Cx.pl aY.pl bY.pl cY.pl); -@f_alpha = qw(Ax.pl aY.pl Bx.pl bY.pl Cx.pl cY.pl); -if ('a' lt 'A') { # EBCDIC char sets sort lower case before UPPER - @f_names = sort(@f_names); -} -if ($^O eq 'VMS') { # VMS is happily caseignorant - @f_alpha = qw(ax.pl ay.pl bx.pl by.pl cx.pl cy.pl); - @f_names = @f_alpha; -} - -for (@f_names) { - open T, "> $_"; - close T; -} - -$pat = "*.pl"; - -$ok = 1; -@g_names = bsd_glob($pat, 0); -print "# f_names = @f_names\n"; -print "# g_names = @g_names\n"; -for (@f_names) { - $ok = 0 unless $_ eq shift @g_names; -} -print $ok ? "ok 10\n" : "not ok 10\n"; - -$ok = 1; -@g_alpha = bsd_glob($pat); -print "# f_alpha = @f_alpha\n"; -print "# g_alpha = @g_alpha\n"; -for (@f_alpha) { - $ok = 0 unless $_ eq shift @g_alpha; -} -print $ok ? "ok 11\n" : "not ok 11\n"; - -unlink @f_names; -chdir ".."; -rmdir "pteerslt"; diff --git a/lib/File/Glob/case.t b/lib/File/Glob/case.t deleted file mode 100755 index 87f3b9f694..0000000000 --- a/lib/File/Glob/case.t +++ /dev/null @@ -1,60 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - if ($^O eq 'MacOS') { - @INC = qw(: ::lib ::macos:lib); - } else { - @INC = '.'; - push @INC, '../lib'; - } - require Config; import Config; - if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { - print "1..0\n"; - exit 0; - } - print "1..7\n"; -} -END { - print "not ok 1\n" unless $loaded; -} -use File::Glob qw(:glob csh_glob); -$loaded = 1; -print "ok 1\n"; - -my $pat = $^O eq "MacOS" ? ":op:G*.t" : "op/G*.t"; - -# Test the actual use of the case sensitivity tags, via csh_glob() -import File::Glob ':nocase'; -@a = csh_glob($pat); -print "not " unless @a >= 8; -print "ok 2\n"; - -# This may fail on systems which are not case-PRESERVING -import File::Glob ':case'; -@a = csh_glob($pat); # None should be uppercase -print "not " unless @a == 0; -print "ok 3\n"; - -# Test the explicit use of the GLOB_NOCASE flag -@a = bsd_glob($pat, GLOB_NOCASE); -print "not " unless @a >= 3; -print "ok 4\n"; - -# Test Win32 backslash nastiness... -if ($^O ne 'MSWin32' && $^O ne 'NetWare') { - print "ok 5\nok 6\nok 7\n"; -} -else { - @a = File::Glob::glob("op\\g*.t"); - print "not " unless @a >= 8; - print "ok 5\n"; - mkdir "[]", 0; - @a = File::Glob::glob("\\[\\]", GLOB_QUOTE); - rmdir "[]"; - print "# returned @a\nnot " unless @a == 1; - print "ok 6\n"; - @a = bsd_glob("op\\*", GLOB_QUOTE); - print "not " if @a == 0; - print "ok 7\n"; -} diff --git a/lib/File/Glob/global.t b/lib/File/Glob/global.t deleted file mode 100755 index c0abbc5ea5..0000000000 --- a/lib/File/Glob/global.t +++ /dev/null @@ -1,151 +0,0 @@ -#!./perl - -BEGIN { - chdir 't' if -d 't'; - if ($^O eq 'MacOS') { - @INC = qw(: ::lib ::macos:lib); - } else { - @INC = '.'; - push @INC, '../lib'; - } - require Config; import Config; - if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { - print "1..0\n"; - exit 0; - } - print "1..10\n"; -} -END { - print "not ok 1\n" unless $loaded; -} - -BEGIN { - *CORE::GLOBAL::glob = sub { "Just another Perl hacker," }; -} - -BEGIN { - if ("Just another Perl hacker," ne (<*>)[0]) { - die <<EOMessage; -Your version of perl ($]) doesn't seem to allow extensions to override -the core glob operator. -EOMessage - } -} - -use File::Glob ':globally'; -$loaded = 1; -print "ok 1\n"; - -$_ = $^O eq "MacOS" ? ":op:*.t" : "op/*.t"; -my @r = glob; -print "not " if $_ ne ($^O eq "MacOS" ? ":op:*.t" : "op/*.t"); -print "ok 2\n"; - -print "# |@r|\nnot " if @r < 3; -print "ok 3\n"; - -# check if <*/*> works -if ($^O eq "MacOS") { - @r = <:*:*.t>; -} else { - @r = <*/*.t>; -} -# at least t/global.t t/basic.t, t/taint.t -print "not " if @r < 3; -print "ok 4\n"; -my $r = scalar @r; - -# check if scalar context works -@r = (); -if ($^O eq "MacOS") { - while (defined($_ = <:*:*.t>)) { - #print "# $_\n"; - push @r, $_; - } -} else { - while (defined($_ = <*/*.t>)) { - #print "# $_\n"; - push @r, $_; - } -} -print "not " if @r != $r; -print "ok 5\n"; - -# check if list context works -@r = (); -if ($^O eq "MacOS") { - for (<:*:*.t>) { - #print "# $_\n"; - push @r, $_; - } -} else { - for (<*/*.t>) { - #print "# $_\n"; - push @r, $_; - } -} -print "not " if @r != $r; -print "ok 6\n"; - -# test if implicit assign to $_ in while() works -@r = (); -if ($^O eq "MacOS") { - while (<:*:*.t>) { - #print "# $_\n"; - push @r, $_; - } -} else { - while (<*/*.t>) { - #print "# $_\n"; - push @r, $_; - } -} -print "not " if @r != $r; -print "ok 7\n"; - -# test if explicit glob() gets assign magic too -my @s = (); -while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) { - #print "# $_\n"; - push @s, $_; -} -print "not " if "@r" ne "@s"; -print "ok 8\n"; - -# how about in a different package, like? -package Foo; -use File::Glob ':globally'; -@s = (); -while (glob($^O eq 'MacOS' ? ':*:*.t' : '*/*.t')) { - #print "# $_\n"; - push @s, $_; -} -print "not " if "@r" ne "@s"; -print "ok 9\n"; - -# test if different glob ops maintain independent contexts -@s = (); -my $i = 0; -if ($^O eq "MacOS") { - while (<:*:*.t>) { - #print "# $_ <"; - push @s, $_; - while (<:bas*:*.t>) { - #print " $_"; - $i++; - } - #print " >\n"; - } -} else { - while (<*/*.t>) { - #print "# $_ <"; - push @s, $_; - while (<bas*/*.t>) { - #print " $_"; - $i++; - } - #print " >\n"; - } -} -print "not " if "@r" ne "@s" or not $i; -print "ok 10\n"; diff --git a/lib/File/Glob/taint.t b/lib/File/Glob/taint.t deleted file mode 100755 index 4c0990358d..0000000000 --- a/lib/File/Glob/taint.t +++ /dev/null @@ -1,31 +0,0 @@ -#!./perl -T - -BEGIN { - chdir 't' if -d 't'; - if ($^O eq 'MacOS') { - @INC = qw(: ::lib ::macos:lib); - } else { - @INC = '.'; - push @INC, '../lib'; - } - require Config; import Config; - if ($Config{'extensions'} !~ /\bFile\/Glob\b/i) { - print "1..0\n"; - exit 0; - } - print "1..2\n"; -} -END { - print "not ok 1\n" unless $loaded; -} -use File::Glob; -$loaded = 1; -print "ok 1\n"; - -# all filenames should be tainted -@a = File::Glob::bsd_glob("*"); -eval { $a = join("",@a), kill 0; 1 }; -unless ($@ =~ /Insecure dependency/) { - print "not "; -} -print "ok 2\n"; diff --git a/lib/File/Temp/mktemp.t b/lib/File/Temp/t/mktemp.t index 4e31d01a3f..4e31d01a3f 100755 --- a/lib/File/Temp/mktemp.t +++ b/lib/File/Temp/t/mktemp.t diff --git a/lib/File/Temp/posix.t b/lib/File/Temp/t/posix.t index 0a5e86061b..0a5e86061b 100755 --- a/lib/File/Temp/posix.t +++ b/lib/File/Temp/t/posix.t diff --git a/lib/File/Temp/security.t b/lib/File/Temp/t/security.t index 7f557e39b1..7f557e39b1 100755 --- a/lib/File/Temp/security.t +++ b/lib/File/Temp/t/security.t diff --git a/lib/File/Temp/tempfile.t b/lib/File/Temp/t/tempfile.t index ed59765a75..ed59765a75 100755 --- a/lib/File/Temp/tempfile.t +++ b/lib/File/Temp/t/tempfile.t |