Integrate mainline

p4raw-id: //depot/perlio@12507

9 files changed, 55 insertions, 61 deletions

diff --git a/t/TEST b/t/TEST
index 57ac836e1f..98fc8dcd17 100755
--- a/t/TEST
+++ b/t/TEST
@@ -5,6 +5,10 @@
 
 $| = 1;
 
+# Let tests know they're running in the perl core.  Useful for modules
+# which live dual lives on CPAN.
+$ENV{PERL_CORE} = 1;
+
 # Cheesy version of Getopt::Std.  Maybe we should replace it with that.
 if ($#ARGV >= 0) {
     foreach my $idx (0..$#ARGV) {
diff --git a/t/harness b/t/harness
index d5ddb51b9f..36ee4ce6da 100644
--- a/t/harness
+++ b/t/harness
@@ -14,6 +14,10 @@ use Test::Harness;
 $Test::Harness::switches = "";    # Too much noise otherwise
 $Test::Harness::verbose = shift if @ARGV && $ARGV[0] eq '-v';
 
+# Let tests know they're running in the perl core.  Useful for modules
+# which live dual lives on CPAN.
+$ENV{PERL_CORE} = 1;
+
 #fudge DATA for now.
 %datahandle = qw(
 		lib/bigint.t		1
diff --git a/t/io/fs.t b/t/io/fs.t
index bd07833cbd..8a700b2cae 100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -245,14 +245,21 @@ else {
 }
 
 # check if rename() can be used to just change case of filename
-chdir './tmp';
-open(fh,'>x') || die "Can't create x";
-close(fh);
-rename('x', 'X');
-print 'not ' unless -e 'X';
-print "ok 27\n";
-unlink 'X';
-chdir $wd || die "Can't cd back to $wd";
+if ($^O eq 'cygwin') {
+  print "ok 27 # skipped: works only if check_case is set to relaxed.\n";
+} else { 
+  chdir './tmp';
+  open(fh,'>x') || die "Can't create x";
+  close(fh);
+  rename('x', 'X');
+  
+  # this works on win32 only, because fs isn't casesensitive
+  print 'not ' unless -e 'X'; 
+  
+  print "ok 27\n";
+  unlink 'X';
+  chdir $wd || die "Can't cd back to $wd";
+}
 
 # check if rename() works on directories
 if ($Is_VMSish) {
@@ -267,4 +274,5 @@ print "ok 28\n";
 -d 'tmp1' or print "not ";
 print "ok 29\n";
 
-END { rmdir 'tmp1'; 1 while unlink "Iofs.tmp"; }
+# need to remove 'tmp' if rename() in test 28 failed!
+END { rmdir 'tmp1'; rmdir 'tmp'; unlink "Iofs.tmp"; }
diff --git a/t/lib/Test/Simple/Catch.pm b/t/lib/Test/Simple/Catch.pm
index 3460a64dcb..e1ccd7ce45 100644
--- a/t/lib/Test/Simple/Catch.pm
+++ b/t/lib/Test/Simple/Catch.pm
@@ -1,16 +1,18 @@
 # For testing Test::Simple;
 package Test::Simple::Catch;
 
-my $out = tie *Test::Simple::TESTOUT, __PACKAGE__;
-my $err = tie *Test::Simple::TESTERR, __PACKAGE__;
+use Symbol;
+my($out_fh, $err_fh) = (gensym, gensym);
+my $out = tie *$out_fh, __PACKAGE__;
+my $err = tie *$err_fh, __PACKAGE__;
 
-# We have to use them to shut up a "used only once" warning.
-() = (*Test::Simple::TESTOUT, *Test::Simple::TESTERR);
+use Test::Builder;
+my $t = Test::Builder->new;
+$t->output($out_fh);
+$t->failure_output($err_fh);
+$t->todo_output($err_fh);
 
-sub caught { return $out, $err }
-
-# Prevent Test::Simple from exiting in its END block.
-*Test::Simple::exit = sub {};
+sub caught { return($out, $err) }
 
 sub PRINT  {
     my $self = shift;
@@ -25,5 +27,6 @@ sub TIEHANDLE {
 sub READ {}
 sub READLINE {}
 sub GETC {}
+sub FILENO {}
 
 1;
diff --git a/t/lib/Test/Simple/Catch/More.pm b/t/lib/Test/Simple/Catch/More.pm
deleted file mode 100644
index f4dee3f3ad..0000000000
--- a/t/lib/Test/Simple/Catch/More.pm
+++ /dev/null
@@ -1,30 +0,0 @@
-# For testing Test::More;
-package Test::Simple::Catch::More;
-
-my $out = tie *Test::Simple::TESTOUT, __PACKAGE__;
-tie *Test::More::TESTOUT, __PACKAGE__, $out;
-my $err = tie *Test::More::TESTERR, __PACKAGE__;
-tie *Test::Simple::TESTERR, __PACKAGE__, $err;
-
-# We have to use them to shut up a "used only once" warning.
-() = (*Test::More::TESTOUT, *Test::More::TESTERR);
-
-sub caught { return $out, $err }
-
-
-sub PRINT  {
-    my $self = shift;
-    $$self .= join '', @_;
-}
-
-sub TIEHANDLE {
-    my($class, $self) = @_;
-    my $foo = '';
-    $self = $self || \$foo;
-    return bless $self, $class;
-}
-sub READ {}
-sub READLINE {}
-sub GETC {}
-
-1;
diff --git a/t/lib/Test/Simple/sample_tests/five_fail.plx b/t/lib/Test/Simple/sample_tests/five_fail.plx
index d33b84519b..c058e1f8f0 100644
--- a/t/lib/Test/Simple/sample_tests/five_fail.plx
+++ b/t/lib/Test/Simple/sample_tests/five_fail.plx
@@ -1,6 +1,6 @@
 require Test::Simple;
 
-push @INC, 't/lib';
+use lib 't/lib';
 require Test::Simple::Catch;
 my($out, $err) = Test::Simple::Catch::caught();
 
diff --git a/t/op/groups.t b/t/op/groups.t
index 0531826dba..3228729426 100755
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -100,8 +100,11 @@ print "1..2\n";
 
 $pwgid = $( + 0;
 ($pwgnam) = getgrgid($pwgid);
-@basegroup{$pwgid,$pwgnam} = (1,1);
-
+if ($^O eq 'cygwin') { # basegroup on Cygwin has id = 0.
+    @basegroup{$pwgid,$pwgnam} = (0,0);
+} else {
+    @basegroup{$pwgid,$pwgnam} = (1,1);
+}
 $seen{$pwgid}++;
 
 for (split(' ', $()) {
diff --git a/t/op/pat.t b/t/op/pat.t
index 0f978d106b..66179212b2 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..747\n";
+print "1..750\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -2243,3 +2243,15 @@ print "# some Unicode properties\n";
     print "not " unless "\x{AC00}" =~ /\p{HangulSyllable}/;
     print "ok 747\n";
 }
+
+{
+    print "not " unless "\x{0100}" =~ /\p{Script=Latin}/;
+    print "ok 748\n";
+
+    print "not " unless "\x{0100}" =~ /\p{Block=LatinExtendedA}/;
+    print "ok 749\n";
+
+    print "not " unless "\x{0100}" =~ /\p{Category=UppercaseLetter}/;
+    print "ok 750\n";
+}
+
diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t
index ce98e01807..7e4f3a8b8e 100644
--- a/t/run/kill_perl.t
+++ b/t/run/kill_perl.t
@@ -629,16 +629,6 @@ EOT
 EXPECT
 ok
 ########
-# test that closures generated by eval"" hold on to the CV of the eval""
-# for their entire lifetime
-$code = eval q[
-  sub { eval '$x = "ok 1\n"'; }
-];
-&{$code}();
-print $x;
-EXPECT
-ok 1
-########
 # This test is here instead of pragma/locale.t because
 # the bug depends on in the internal state of the locale
 # settings and pragma/locale messes up that state pretty badly.