Integrate with Sarathy.

p4raw-id: //depot/cfgperl@4365

7 files changed, 249 insertions, 3 deletions

diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t
new file mode 100755
index 0000000000..5189db458a
--- /dev/null
+++ b/t/lib/glob-basic.t
@@ -0,0 +1,103 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+
+    print "1..9\n";
+}
+END {
+    print "not ok 1\n" unless $loaded;
+}
+use File::Glob ':glob';
+$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, ".")) {
+   @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') {
+    ($name, $home) = (getpwuid($>))[0,7];
+    @a = File::Glob::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 = File::Glob::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 = File::Glob::glob("asdfasdf", 0);
+if ($^O ne 'MSWin32' and scalar @a != 0) {
+    print "# |@a|\nnot ";
+}
+print "ok 5\n";
+
+# check bad protections
+# should return an empty list, and set ERROR
+$dir = "PtEeRsLt.dir";
+mkdir $dir, 0;
+@a = File::Glob::glob("$dir/*", GLOB_ERR);
+#print "\@a = ", array(@a);
+rmdir $dir;
+if (scalar(@a) != 0 || ($^O ne 'MSWin32' && GLOB_ERROR == 0)) {
+    print "not ";
+}
+print "ok 6\n";
+
+# check for csh style globbing
+@a = File::Glob::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 = File::Glob::glob(
+    '{TES*,doesntexist*,a,b}',
+    GLOB_BRACE | GLOB_NOMAGIC
+);
+unless (@a == 3
+        and $a[0] eq 'TEST'
+        and $a[1] eq 'a'
+        and $a[2] eq 'b')
+{
+    print "not ";
+}
+print "ok 8\n";
+
+# "~" should expand to $ENV{HOME}
+$ENV{HOME} = "sweet home";
+@a = File::Glob::glob('~', GLOB_TILDE | GLOB_NOMAGIC);
+unless (@a == 1 and $a[0] eq $ENV{HOME}) {
+    print "not ";
+}
+print "ok 9\n";
diff --git a/t/lib/glob-global.t b/t/lib/glob-global.t
new file mode 100755
index 0000000000..7da741ee16
--- /dev/null
+++ b/t/lib/glob-global.t
@@ -0,0 +1,106 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+
+    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";
+
+$_ = "lib/*.t";
+my @r = glob;
+print "not " if $_ ne 'lib/*.t';
+print "ok 2\n";
+
+# we should have at least basic.t, global.t, taint.t
+print "# |@r|\nnot " if @r < 3;
+print "ok 3\n";
+
+# check if <*/*> works
+@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 = ();
+while (defined($_ = <*/*.t>)) {
+    #print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 5\n";
+
+# check if array context works
+@r = ();
+for (<*/*.t>) {
+    #print "# $_\n";
+    push @r, $_;
+}
+print "not " if @r != $r;
+print "ok 6\n";
+
+# test if implicit assign to $_ in while() works
+@r = ();
+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 '*/*.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 '*/*.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;
+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/t/lib/glob-taint.t b/t/lib/glob-taint.t
new file mode 100755
index 0000000000..1b9c053bf7
--- /dev/null
+++ b/t/lib/glob-taint.t
@@ -0,0 +1,21 @@
+#!./perl -T
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    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::glob("*");
+eval { $a = join("",@a), kill 0; 1 };
+unless ($@ =~ /Insecure dependency/) {
+    print "not ";
+}
+print "ok 2\n";
diff --git a/t/op/glob.t b/t/op/glob.t
index 253e4a312f..4c2744590b 100755
--- a/t/op/glob.t
+++ b/t/op/glob.t
@@ -1,6 +1,9 @@
 #!./perl
 
-# $RCSfile: glob.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:55 $
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
 
 print "1..6\n";
 
diff --git a/t/op/readdir.t b/t/op/readdir.t
index aea976823a..d101c2f622 100755
--- a/t/op/readdir.t
+++ b/t/op/readdir.t
@@ -1,5 +1,10 @@
 #!./perl
 
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
 eval 'opendir(NOSUCH, "no/such/directory");';
 if ($@) { print "1..0\n"; exit; }
 
diff --git a/t/op/taint.t b/t/op/taint.t
index fdd1c79b83..6a9537b057 100755
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -254,7 +254,8 @@ print "1..149\n";
 
 # Globs should be forbidden, except under VMS,
 #   which doesn't spawn an external program.
-if ($Is_VMS) {
+if (1  # built-in glob
+    or $Is_VMS) {
     for (35..36) { print "ok $_\n"; }
 }
 else {
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index ff8d8059f1..f673dce028 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -712,7 +712,14 @@ test($c, "bareword");	# 135
   sub new { my ($p, $v) = @_; bless \$v, $p }
   sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; }
 }
-{
+
+# XXX iterator overload not intended to work with CORE::GLOBAL?
+if (defined &CORE::GLOBAL::glob) {
+  test '1', '1';	# 175
+  test '1', '1';	# 176
+  test '1', '1';	# 177
+}
+else {
   my $iter = iterator->new(5);
   my $acc = '';
   my $out;