Integrate mainline

p4raw-id: //depot/perlio@16015

4 files changed, 88 insertions, 11 deletions

diff --git a/t/io/open.t b/t/io/open.t
index fa8b10ac6c..187106156f 100755
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -8,9 +8,10 @@ BEGIN {
 
 $|  = 1;
 use warnings;
+use Config;
 $Is_VMS = $^O eq 'VMS';
 
-plan tests => 91;
+plan tests => 94;
 
 my $Perl = which_perl();
 
@@ -223,3 +224,15 @@ like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
     ok( open(STDOUT,     ">&", $stdout),  'restore dupped STDOUT from lexical fh');
 }
 
+SKIP: {
+    skip "This perl uses perlio", 1 if $Config{useperlio};
+    skip "This system doesn't understand EINVAL", 1 unless exists $!{EINVAL};
+
+    no warnings 'io';
+    ok( !open(F,'>',\my $s) && $!{EINVAL}, 'open(reference) raises EINVAL' );
+}
+
+{
+    ok( !eval { open F, "BAR", "QUUX" },       'Unknown open() mode' );
+    like( $@, qr/\QUnknown open() mode 'BAR'/, '       right error' );
+}
diff --git a/t/japh/abigail.t b/t/japh/abigail.t
index 9b2dc968ec..c8412aa6e5 100644
--- a/t/japh/abigail.t
+++ b/t/japh/abigail.t
@@ -21,9 +21,9 @@ BEGIN {
 #
 sub skip {
     my $why  = shift;
-    my $test = curr_test;
     my $n    = @_ ? shift : 1;
     for (1..$n) {
+        my $test = curr_test;
         print STDOUT "ok $test # skip: $why\n";
         next_test;
     }
@@ -80,7 +80,7 @@ plan tests => 130;
     if ($^O eq 'MSWin32' ||
         $^O eq 'NetWare' ||
         $^O eq 'VMS') {
-            skip 3, "Your platform quotes differently.\n";
+            skip "Your platform quotes differently.", 3;
             last;
     }
 
@@ -108,7 +108,7 @@ plan tests => 130;
     if ($^O eq 'MSWin32' ||
         $^O eq 'NetWare' ||
         $^O eq 'VMS') {
-            skip 1, "Your platform quotes differently.\n";
+            skip "Your platform quotes differently.", 1;
             last;
     }
     is (runperl (switches => [qw /-sweprint --/,
@@ -170,14 +170,16 @@ plan tests => 130;
     foreach my $program (@progs) {
         if (exists $program -> {SKIP}) {
             chomp  $program -> {SKIP};
-            skip   $program -> {SKIP};
+            skip   $program -> {SKIP}, 1;
             next;
         }
 
-        if (@{$program -> {SKIP_OS}} &&
-            grep {$^O eq $_} @{$program -> {SKIP_OS}}) {
-            skip "Your OS uses different quoting.";
-            next;
+        if (@{$program -> {SKIP_OS}}) {
+            chomp @{$program -> {SKIP_OS}};
+            if (grep {$^O eq $_} @{$program -> {SKIP_OS}}) {
+                skip "Your OS uses different quoting.", 1;
+                next;
+            }
         }
 
         map {s/\$datafile/$datafile/} @{$program -> {ARGS}};
@@ -212,6 +214,20 @@ truncate$0,-1+-s$0;exec$0;}}//rekcaH_lreP_rehtona_tsuJ
     --
     chomp @programs;
 
+    if ($^O eq 'VMS') {
+        # VMS needs extensions for files to be executable,
+        # but the Japhs above rely on $0 being exactly the
+        # filename of the program.
+        skip "VMS", 2 * @programs;
+        last
+    }
+
+    use Config;
+    unless (defined $Config {useperlio}) {
+        skip "Uuseperlio", 2 * @programs;
+        last
+    }
+
     my $i = 1;
     foreach my $program (@programs) {
         open my $fh => "> $progfile" or die "Failed to open $progfile: $!\n";
diff --git a/t/lib/warnings/doio b/t/lib/warnings/doio
index db571957c4..569229d35f 100644
--- a/t/lib/warnings/doio
+++ b/t/lib/warnings/doio
@@ -243,6 +243,7 @@ EOM
 use warnings 'io';
 my $x = "foo";
 open FOO, '>', \$x;
+open BAR, '>&', \*STDOUT; # should not warn
 no warnings 'io';
 open FOO, '>', \$x;
 EXPECT
diff --git a/t/op/pat.t b/t/op/pat.t
index 853c59ccd2..905204bed1 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..900\n";
+print "1..908\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -2800,7 +2800,7 @@ print "# some Unicode properties\n";
 }
 
 {
-    # [ID 20020412.005] wrong pmop flags checked when empty pattern
+    print "# [ID 20020412.005] wrong pmop flags checked when empty pattern\n";
     # requires reuse of last successful pattern
     my $test = 898;
     $test =~ /\d/;
@@ -2823,3 +2823,50 @@ print "# some Unicode properties\n";
     }
     ++$test;
 }
+
+print "# user-defined character properties\n";
+
+sub InKana1 {
+    return <<'END';
+3040	309F
+30A0	30FF
+END
+}
+
+sub InKana2 {
+    return <<'END';
++utf8::InHiragana
++utf8::InKatakana
+END
+}
+
+sub InKana3 {
+    return <<'END';
++utf8::InHiragana
++utf8::InKatakana
+-utf8::IsCn
+END
+}
+
+sub InNotKana {
+    return <<'END';
+!utf8::InHiragana
+-utf8::InKatakana
++utf8::IsCn
+END
+}
+
+$test = 901;
+
+print "\x{3040}" =~ /\p{InKana1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+print "\x{303F}" =~ /\P{InKana1}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+
+print "\x{3040}" =~ /\p{InKana2}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+print "\x{303F}" =~ /\P{InKana2}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+
+print "\x{3041}" =~ /\p{InKana3}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+print "\x{3040}" =~ /\P{InKana3}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+
+print "\x{3040}" =~ /\p{InNotKana}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+print "\x{3041}" =~ /\P{InNotKana}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+