Integrate mainline

p4raw-id: //depot/perlio@18849

18 files changed, 657 insertions, 27 deletions

diff --git a/t/comp/assertions.t b/t/comp/assertions.t
new file mode 100644
index 0000000000..da9f5680ff
--- /dev/null
+++ b/t/comp/assertions.t
@@ -0,0 +1,162 @@
+#!./perl
+
+sub callme ($ ) : assertion {
+    return shift;
+}
+
+# select STDERR; $|=1;
+
+my @expr=( '1' => 1,
+	   '0' => 0,
+	   '1 && 1' => 1,
+	   '1 && 0' => 0,
+	   '0 && 1' => 0,
+	   '0 && 0' => 0,
+	   '1 || 1' => 1,
+	   '1 || 0' => 1,
+	   '0 || 1' => 1,
+	   '0 || 0' => 0,
+	   '(1)' => 1,
+	   '(0)' => 0,
+	   '1 && ((1) && 1)' => 1,
+	   '1 && (0 || 1)' => 1,
+	   '1 && ( 0' => undef,
+	   '1 &&' => undef,
+	   '&& 1' => undef,
+	   '1 && || 1' => undef,
+	   '(1 && 1) && 1)' => undef,
+	   'one && two' => 1,
+	   '_ && one' => 0,
+	   'one && three' => 0,
+	   '1 ' => 1,
+	   ' 1' => 1,
+	   ' 1 ' => 1,
+	   ' ( 1 && 1 ) ' => 1,
+	   ' ( 1 && 0 ) ' => 0,
+	   '(( 1 && 1) && ( 1 || 0)) || _ && one && ( one || three)' => 1 );
+
+my $n=@expr/2+10;
+my $i=1;
+print "1..$n\n";
+
+use assertions::activate 'one', 'two';
+require assertions;
+
+while (@expr) {
+    my $expr=shift @expr;
+    my $expected=shift @expr;
+    my $result=eval {assertions::calc_expr($expr)};
+    if (defined $expected) {
+	unless (defined $result and $result == $expected) {
+	    print STDERR "assertions::calc_expr($expr) failed,".
+		" expected '$expected' but '$result' obtained (\$@=$@)\n";
+	    print "not ";
+	}
+    }
+    else {
+	if (defined $result) {
+	    print STDERR "assertions::calc_expr($expr) failed,".
+		" expected undef but '$result' obtained\n";
+	    print "not ";
+	}
+    }
+    print "ok ", $i++, "\n";
+}
+
+
+# @expr/2+1
+if (callme(1)) {
+    print STDERR "assertions called by default\n";
+    print "not ";
+}
+print "ok ", $i++, "\n";
+
+# 2
+use assertions::activate 'mine';
+{
+  package mine;
+  sub callme ($) : assertion {
+    return shift;
+  }
+  use assertions;
+  unless (callme(1)) {
+    print STDERR "'use assertions;' doesn't active assertions based on package name\n";
+    print "not ";
+  }
+}
+print "ok ", $i++, "\n";
+
+# 3
+use assertions 'foo';
+if (callme(1)) {
+    print STDERR "assertion deselection doesn't work\n";
+    print "not ";
+}
+print "ok ", $i++, "\n";
+
+# 4
+use assertions::activate 'bar', 'doz';
+use assertions 'bar';
+unless (callme(1)) {
+    print STDERR "assertion selection doesn't work\n";
+    print "not ";
+}
+print "ok ", $i++, "\n";
+
+# 5
+use assertions q(_ && doz);
+unless (callme(1)) {
+    print STDERR "assertion activation filtering doesn't work\n";
+    print "not ";
+}
+print "ok ", $i++, "\n";
+
+# 6
+use assertions q(_ && foo);
+if (callme(1)) {
+    print STDERR "assertion deactivation filtering doesn't work\n";
+    print "not ";
+}
+print "ok ", $i++, "\n";
+
+# 7
+if (1) {
+    use assertions 'bar';
+}
+if (callme(1)) {
+    print STDERR "assertion scoping doesn't work\n";
+    print "not ";
+}
+print "ok ", $i++, "\n";
+
+# 8
+use assertions::activate 're.*';
+use assertions 'reassert';
+unless (callme(1)) {
+    print STDERR "assertion selection with re failed\n";
+    print "not ";
+}
+print "ok ", $i++, "\n";
+
+# 9
+my $b=12;
+{
+    use assertions 'bar';
+    callme(my $b=45);
+    unless ($b == 45) {
+	print STDERR "this shouldn't fail ever (b=$b)\n";
+	print "not ";
+    }
+}
+print "ok ", $i++, "\n";
+
+# 10
+{
+    no assertions;
+    callme(my $b=46);
+    if (defined $b) {
+	print STDERR "lexical declaration in assertion arg ignored (b=$b\n";
+	print "not ";
+    }
+}
+print "ok ", $i++, "\n";
diff --git a/t/comp/parser.t b/t/comp/parser.t
index 88f933c7a6..ad1c5b80bd 100644
--- a/t/comp/parser.t
+++ b/t/comp/parser.t
@@ -9,7 +9,7 @@ BEGIN {
 }
 
 require "./test.pl";
-plan( tests => 15 );
+plan( tests => 20 );
 
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
@@ -68,9 +68,23 @@ eval {
 is( $@, '', 'PL_lex_brackstack' );
 
 {
-     undef $a;
-     undef @b;
-     my $a="a"; is("${a}{", "a{", "scope error #20716");
-     my $a="a"; is("${a}[", "a[", "scope error #20716");
-     my @b=("b"); is("@{b}{", "b{", "scope error #20716");
+    # tests for bug #20716
+    undef $a;
+    undef @b;
+    my $a="A";
+    is("${a}{", "A{", "interpolation, qq//");
+    is("${a}[", "A[", "interpolation, qq//");
+    my @b=("B");
+    is("@{b}{", "B{", "interpolation, qq//");
+    is(qr/${a}{/, '(?-xism:A{)', "interpolation, qr//");
+    my $c = "A{";
+    $c =~ /${a}{/;
+    is($&, 'A{', "interpolation, m//");
+    $c =~ s/${a}{/foo/;
+    is($c, 'foo', "interpolation, s/...//");
+    $c =~ s/foo/${a}{/;
+    is($c, 'A{', "interpolation, s//.../");
+    is(<<"${a}{", "A{ A[ B{\n", "interpolation, here doc");
+${a}{ ${a}[ @{b}{
+${a}{
 }
diff --git a/t/io/utf8.t b/t/io/utf8.t
index e1ecf1c433..edf5fddb74 100755
--- a/t/io/utf8.t
+++ b/t/io/utf8.t
@@ -12,7 +12,7 @@ BEGIN {
 no utf8; # needed for use utf8 not griping about the raw octets
 
 $| = 1;
-print "1..31\n";
+print "1..49\n";
 
 open(F,"+>:utf8",'a');
 print F chr(0x100).'£';
@@ -273,6 +273,58 @@ print "ok 26\n";
     print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n";
 }
 
+{
+    open F, ">:bytes","a"; print F "\xde"; close F;
+
+    open F, "<:bytes", "a";
+    my $b = chr 0x100;
+    $b .= <F>;
+    print $b eq chr(0x100).chr(0xde) ? "ok 32" : "not ok 32";
+    print " \#21395 '.= <>' utf8 vs. bytes\n";
+    close F;
+}
+
+{
+    open F, ">:utf8","a"; print F chr 0x100; close F;
+
+    open F, "<:utf8", "a";
+    my $b = "\xde";
+    $b .= <F>;
+    print $b eq chr(0xde).chr(0x100) ? "ok 33" : "not ok 33";
+    print " \#21395 '.= <>' bytes vs. utf8\n";
+    close F;
+}
+
+{
+    my @a = ( [ 0x007F, "bytes" ],
+	      [ 0x0080, "bytes" ],
+	      [ 0x0080, "utf8"  ],
+	      [ 0x0100, "utf8"  ] );
+    my $t = 34;
+    for my $u (@a) {
+	for my $v (@a) {
+	    # print "# @$u - @$v\n";
+	    open F, ">a";
+	    binmode(F, ":" . $u->[1]);
+	    print F chr($u->[0]);
+	    close F;
+
+	    open F, "<a";
+	    binmode(F, ":" . $u->[1]);
+
+	    my $s = chr($v->[0]);
+	    utf8::upgrade($s) if $v->[1] eq "utf8";
+
+	    $s .= <F>;
+	    print $s eq chr($v->[0]) . chr($u->[0]) ?
+		"ok $t # rcatline utf8\n" : "not ok $t # rcatline utf8\n";
+	    close F;
+	    $t++;
+	}
+    }
+    # last test here 47
+}
+
 # sysread() and syswrite() tested in lib/open.t since Fnctl is used
 
 END {
diff --git a/t/op/caller.t b/t/op/caller.t
index 751a161de2..c97191b14a 100644
--- a/t/op/caller.t
+++ b/t/op/caller.t
@@ -5,10 +5,9 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
+    plan( tests => 27 );
 }
 
-plan( tests => 20 );
-
 my @c;
 
 print "# Tests with caller(0)\n";
@@ -63,3 +62,26 @@ my $fooref2 = delete $::{foo2};
 $fooref2 -> ();
 is( $c[3], "(unknown)", "unknown subroutine name" );
 ok( $c[4], "hasargs true with unknown sub" );
+
+# See if caller() returns the correct warning mask
+
+sub testwarn {
+    my $w = shift;
+    is( (caller(0))[9], $w, "warnings");
+}
+
+# NB : extend the warning mask values below when new warnings are added
+{
+    no warnings;
+    BEGIN { is( ${^WARNING_BITS}, "\0" x 12, 'warning bits' ) }
+    testwarn("\0" x 12);
+    use warnings;
+    BEGIN { is( ${^WARNING_BITS}, "U" x 12, 'warning bits' ) }
+    BEGIN { testwarn("U" x 12); }
+    # run-time :
+    # the warning mask has been extended by warnings::register
+    testwarn("UUUUUUUUUUUU\001");
+    use warnings::register;
+    BEGIN { is( ${^WARNING_BITS}, "UUUUUUUUUUUU\001", 'warning bits' ) }
+    testwarn("UUUUUUUUUUUU\001");
+}
diff --git a/t/op/concat.t b/t/op/concat.t
index 4813690d6b..c1a6e23e7e 100644
--- a/t/op/concat.t
+++ b/t/op/concat.t
@@ -18,7 +18,7 @@ sub ok {
     return $ok;
 }
 
-print "1..12\n";
+print "1..18\n";
 
 ($a, $b, $c) = qw(foo bar);
 
@@ -87,3 +87,20 @@ ok("$c$a$c" eq "foo",    "concatenate undef, fore and aft");
     eval{"\x{1234}$pi"};
     ok(!$@, "bug id 20001020.006, constant right");
 }
+
+sub beq { use bytes; $_[0] eq $_[1]; }
+
+{
+    # concat should not upgrade its arguments.
+    my($l, $r, $c);
+
+    ($l, $r, $c) = ("\x{101}", "\x{fe}", "\x{101}\x{fe}");
+    ok(beq($l.$r, $c), "concat utf8 and byte");
+    ok(beq($l, "\x{101}"), "right not changed after concat u+b");
+    ok(beq($r, "\x{fe}"), "left not changed after concat u+b");
+
+    ($l, $r, $c) = ("\x{fe}", "\x{101}", "\x{fe}\x{101}");
+    ok(beq($l.$r, $c), "concat byte and utf8");
+    ok(beq($l, "\x{fe}"), "right not changed after concat b+u");
+    ok(beq($r, "\x{101}"), "left not changed after concat b+u");
+}
diff --git a/t/op/local.t b/t/op/local.t
index 6da03912e9..1bb8b8ac1b 100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -45,10 +45,10 @@ print $a,@b,@c,%d,$x,$y;
 eval 'local($$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 21\n";
 
-eval 'local(@$e)';
+eval '$e = []; local(@$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 22\n";
 
-eval 'local(%$e)';
+eval '$e = {}; local(%$e)';
 print +($@ =~ /Can't localize through a reference/) ? "" : "not ", "ok 23\n";
 
 # Array and hash elements
diff --git a/t/op/localref.t b/t/op/localref.t
new file mode 100644
index 0000000000..9379575ede
--- /dev/null
+++ b/t/op/localref.t
@@ -0,0 +1,85 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = qw(. ../lib);
+require "test.pl";
+plan( tests => 63 );
+
+$aa = 1;
+{ local $aa;     $aa = 2; is($aa,2); }
+is($aa,1);
+{ local ${aa};   $aa = 3; is($aa,3); }
+is($aa,1);
+{ local ${"aa"}; $aa = 4; is($aa,4); }
+is($aa,1);
+$x = "aa";
+{ local ${$x};   $aa = 5; is($aa,5); undef $x; is($aa,5); }
+is($aa,1);
+$x = "a";
+{ local ${$x x2};$aa = 6; is($aa,6); undef $x; is($aa,6); }
+is($aa,1);
+$x = "aa";
+{ local $$x;     $aa = 7; is($aa,7); undef $x; is($aa,7); }
+is($aa,1);
+
+@aa = qw/a b/;
+{ local @aa;     @aa = qw/c d/; is("@aa","c d"); }
+is("@aa","a b");
+{ local @{aa};   @aa = qw/e f/; is("@aa","e f"); }
+is("@aa","a b");
+{ local @{"aa"}; @aa = qw/g h/; is("@aa","g h"); }
+is("@aa","a b");
+$x = "aa";
+{ local @{$x};   @aa = qw/i j/; is("@aa","i j"); undef $x; is("@aa","i j"); }
+is("@aa","a b");
+$x = "a";
+{ local @{$x x2};@aa = qw/k l/; is("@aa","k l"); undef $x; is("@aa","k l"); }
+is("@aa","a b");
+$x = "aa";
+{ local @$x;     @aa = qw/m n/; is("@aa","m n"); undef $x; is("@aa","m n"); }
+is("@aa","a b");
+
+%aa = qw/a b/;
+{ local %aa;     %aa = qw/c d/; is($aa{c},"d"); }
+is($aa{a},"b");
+{ local %{aa};   %aa = qw/e f/; is($aa{e},"f"); }
+is($aa{a},"b");
+{ local %{"aa"}; %aa = qw/g h/; is($aa{g},"h"); }
+is($aa{a},"b");
+$x = "aa";
+{ local %{$x};   %aa = qw/i j/; is($aa{i},"j"); undef $x; is($aa{i},"j"); }
+is($aa{a},"b");
+$x = "a";
+{ local %{$x x2};%aa = qw/k l/; is($aa{k},"l"); undef $x; is($aa{k},"l"); }
+is($aa{a},"b");
+$x = "aa";
+{ local %$x;     %aa = qw/m n/; is($aa{m},"n"); undef $x; is($aa{m},"n"); }
+is($aa{a},"b");
+
+sub test_err_localref () {
+    like($@,qr/Can't localize through a reference/,'error');
+}
+$x = \$aa;
+my $y = \$aa;
+eval { local $$x; };      test_err_localref;
+eval { local ${$x}; };    test_err_localref;
+eval { local $$y; };      test_err_localref;
+eval { local ${$y}; };    test_err_localref;
+eval { local ${\$aa}; };  test_err_localref;
+eval { local ${\'aa'}; }; test_err_localref;
+$x = \@aa;
+$y = \@aa;
+eval { local @$x; };      test_err_localref;
+eval { local @{$x}; };    test_err_localref;
+eval { local @$y; };      test_err_localref;
+eval { local @{$y}; };    test_err_localref;
+eval { local @{\@aa}; };  test_err_localref;
+eval { local @{[]}; };    test_err_localref;
+$x = \%aa;
+$y = \%aa;
+eval { local %$x; };      test_err_localref;
+eval { local %{$x}; };    test_err_localref;
+eval { local %$y; };      test_err_localref;
+eval { local %{$y}; };    test_err_localref;
+eval { local %{\%aa}; };  test_err_localref;
+eval { local %{{a=>1}}; };test_err_localref;
diff --git a/t/op/magic.t b/t/op/magic.t
index 0619c0dc34..8f598a1049 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -36,7 +36,7 @@ sub skip {
     return 1;
 }
 
-print "1..50\n";
+print "1..52\n";
 
 $Is_MSWin32 = $^O eq 'MSWin32';
 $Is_NetWare = $^O eq 'NetWare';
@@ -67,7 +67,7 @@ ok $!, $!;
 close FOO; # just mention it, squelch used-only-once
 
 if ($Is_MSWin32 || $Is_NetWare || $Is_Dos || $Is_MPE || $Is_MacOS) {
-    skip('SIGINT not safe on this platform') for 1..2;
+    skip('SIGINT not safe on this platform') for 1..4;
 }
 else {
   # the next tests are done in a subprocess because sh spits out a
@@ -98,7 +98,35 @@ END
 
     close CMDPIPE;
 
-    $test += 2;
+    open( CMDPIPE, "| $PERL");
+    print CMDPIPE <<'END';
+
+    { package X;
+	sub DESTROY {
+	    kill "INT",$$;
+	}
+    }
+    sub x {
+	my $x=bless [], 'X';
+	return sub { $x };
+    }
+    $| = 1;		# command buffering
+    $SIG{"INT"} = "ok5";
+    {
+	local $SIG{"INT"}=x();
+	print ""; # Needed to expose failure in 5.8.0 (why?)
+    }
+    sleep 1;
+    delete $SIG{"INT"};
+    kill "INT",$$; sleep 1;
+    sub ok5 {
+	print "ok 5\n";
+    }
+END
+    close CMDPIPE;
+    print $? & 0xFF ? "ok 6\n" : "not ok 6\n";
+
+    $test += 4;
 }
 
 # can we slice ENV?
diff --git a/t/op/method.t b/t/op/method.t
index 52fb705fb8..ae8031a9f6 100755
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -231,7 +231,7 @@ is( Foo->boogie(), "yes, sir!");
 # This is actually testing parsing of indirect objects and undefined subs
 #   print foo("bar") where foo does not exist is not an indirect object.
 #   print foo "bar"  where foo does not exist is an indirect object.
-eval { sub AUTOLOAD { "ok ", shift, "\n"; } };
+eval 'sub AUTOLOAD { "ok ", shift, "\n"; }';
 ok(1);
 
 # Bug ID 20010902.002
diff --git a/t/op/pack.t b/t/op/pack.t
index a4c5db01d2..9ac5d38f25 100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 5826;
+plan tests => 5827;
 
 use strict;
 use warnings;
@@ -995,3 +995,5 @@ foreach my $template (qw(A Z c C s S i I l L n N v V q Q j J f d F D u U w)) {
 
 ok(pack('u2', 'AA'), "[perl #8026]"); # used to hang and eat RAM in perl 5.7.2
 
+$_ = pack('c', 65); # 'A' would not be EBCDIC-friendly
+is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_
diff --git a/t/op/pat.t b/t/op/pat.t
index fe70e12725..fdc4f9b2a1 100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..988\n";
+print "1..994\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -3108,5 +3108,42 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]");
     ok ( "0" =~ /\p{N}+\z/, "[perl #19767] variant test" );
 }
 
-# last test 988
+{
+
+    $p = 1;
+    foreach (1,2,3,4) {
+	    $p++ if /(??{ $p })/
+    }
+    ok ($p == 5, "[perl #20683] (??{ }) returns stale values");
+    { package P; $a=1; sub TIESCALAR { bless[] } sub FETCH { $a++ } }
+    tie $p, P;
+    foreach (1,2,3,4) {
+	    /(??{ $p })/
+    }
+    ok ( $p == 5, "(??{ }) returns stale values");
+}
+
+{
+  # Subject: Odd regexp behavior
+  # From: Markus Kuhn <Markus.Kuhn@cl.cam.ac.uk>
+  # Date: Wed, 26 Feb 2003 16:53:12 +0000
+  # Message-Id: <E18o4nw-0008Ly-00@wisbech.cl.cam.ac.uk>
+  # To: perl-unicode@perl.org
+    
+  $x = "\x{2019}\nk"; $x =~ s/(\S)\n(\S)/$1 $2/sg;
+  ok($x eq "\x{2019} k", "Markus Kuhn 2003-02-26");
+
+  $x = "b\nk"; $x =~ s/(\S)\n(\S)/$1 $2/sg;
+  ok($x eq "b k", "Markus Kuhn 2003-02-26");
+
+  ok("\x{2019}" =~ /\S/, "Markus Kuhn 2003-02-26");
+}
+
+{
+    my $i;
+    ok('-1-3-5-' eq join('', split /((??{$i++}))/, '-1-3-5-'),
+	"[perl #21411] (??{ .. }) corrupts split's stack")
+}
+
+# last test 994
 
diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t
index a17c3c62c5..003c1a0a50 100755
--- a/t/op/sub_lval.t
+++ b/t/op/sub_lval.t
@@ -423,10 +423,7 @@ $a->() = 8;
 print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
 print "ok 46\n";
 
-# This must happen at run time
-eval {
-    sub AUTOLOAD : lvalue { $newvar };
-};
+eval 'sub AUTOLOAD : lvalue { $newvar }';
 foobar() = 12;
 print "# '$newvar'.\nnot " unless $newvar eq "12";
 print "ok 47\n";
diff --git a/t/op/subst.t b/t/op/subst.t
index 59c3d21b8d..21a4305776 100755
--- a/t/op/subst.t
+++ b/t/op/subst.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan( tests => 126 );
+plan( tests => 129 );
 
 $x = 'foo';
 $_ = "x";
@@ -516,3 +516,18 @@ is("<$_> <$s>", "<> <4>", "[perl #7806]");
     $f =~ s/x/y/g;
     is($f, "yy", "[perl #17757]");
 }
+
+# [perl #20684] returned a zero count
+$_ = "1111";
+is(s/(??{1})/2/eg, 4, '#20684 s/// with (??{..}) inside');
+
+# [perl #20682] @- not visible in replacement
+$_ = "123";
+/(2)/;	# seed @- with something else
+s/(1)(2)(3)/$#- (@-)/;
+is($_, "3 (0 0 1 2)", '#20682 @- not visible in replacement');
+
+# [perl #20682] $^N not visible in replacement
+$_ = "abc";
+/(a)/; s/(b)|(c)/-$^N/g;
+is($_,'a-b-c','#20682 $^N not visible in replacement');
diff --git a/t/op/ver.t b/t/op/ver.t
index 5cf97a8b9b..acf6af7f35 100755
--- a/t/op/ver.t
+++ b/t/op/ver.t
@@ -13,7 +13,7 @@ use Config;
 require "test.pl";
 plan( tests => 50 );
 
-eval { use v5.5.640; };
+eval 'use v5.5.640';
 is( $@, '', "use v5.5.640; $@");
 
 require_ok('v5.5.640');
@@ -52,7 +52,7 @@ is(v1.20.300.4000, "\x{1}\x{14}\x{12c}\x{fa0}",'compare embedded \x{} string');
 
 #
 # now do the same without the "v"
-eval { use 5.5.640; };
+eval 'use 5.5.640';
 is( $@, '', "use 5.5.640; $@");
 
 require_ok('5.5.640');
diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t
index 2f8baa6df4..a0f707ff05 100644
--- a/t/run/fresh_perl.t
+++ b/t/run/fresh_perl.t
@@ -89,7 +89,7 @@ $x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
 EXPECT
 25
 ########
-eval {sub bar {print "In bar";}}
+eval 'sub bar {print "In bar"}';
 ########
 system './perl -ne "print if eof" /dev/null' unless $^O eq 'MacOS'
 ########
diff --git a/t/run/switchC.t b/t/run/switchC.t
new file mode 100644
index 0000000000..c3cc4033a7
--- /dev/null
+++ b/t/run/switchC.t
@@ -0,0 +1,63 @@
+#!./perl -w
+
+# Tests for the command-line switches
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    unless (find PerlIO::Layer 'perlio') {
+	print "1..0 # Skip: not perlio\n";
+	exit 0;
+    }
+}
+
+require "./test.pl";
+
+plan(tests => 6);
+
+my $r;
+
+my @tmpfiles = ();
+END { unlink @tmpfiles }
+
+$r = runperl( switches => [ '-CO', '-w' ],
+	      prog     => 'print chr(256)',
+              stderr   => 1 );
+is( $r, "\xC4\x80", '-CO: no warning on UTF-8 output' );
+
+SKIP: {
+    if (exists $ENV{PERL_UNICODE} &&
+	($ENV{PERL_UNICODE} eq "" || $ENV{PERL_UNICODE} =~ /[SO]/)) {
+	skip(qq[cannot test with PERL_UNICODE locale "" or /[SO]/], 1);
+    }
+    $r = runperl( switches => [ '-CI', '-w' ],
+		  prog     => 'print ord(<STDIN>)',
+		  stderr   => 1,
+		  stdin    => "\xC4\x80" );
+    is( $r, 256, '-CI: read in UTF-8 input' );
+}
+
+$r = runperl( switches => [ '-CE', '-w' ],
+	      prog     => 'warn chr(256), qq(\n)',
+              stderr   => 1 );
+chomp $r;
+is( $r, "\xC4\x80", '-CE: UTF-8 stderr' );
+
+$r = runperl( switches => [ '-Co', '-w' ],
+	      prog     => 'open(F, q(>out)); print F chr(256); close F',
+              stderr   => 1 );
+is( $r, '', '-Co: auto-UTF-8 open for output' );
+
+push @tmpfiles, "out";
+
+$r = runperl( switches => [ '-Ci', '-w' ],
+	      prog     => 'open(F, q(<out)); print ord(<F>); close F',
+              stderr   => 1 );
+is( $r, 256, '-Ci: auto-UTF-8 open for input' );
+
+$r = runperl( switches => [ '-CA', '-w' ],
+	      prog     => 'print ord shift',
+              stderr   => 1,
+              args     => [ chr(256) ] );
+is( $r, 256, '-CA: @ARGV' );
+
diff --git a/t/run/switch_A.t b/t/run/switch_A.t
new file mode 100755
index 0000000000..5a71b409a5
--- /dev/null
+++ b/t/run/switch_A.t
@@ -0,0 +1,36 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+    require './test.pl';	# for which_perl() etc
+}
+
+BEGIN {
+    plan(5);
+}
+
+#1
+fresh_perl_is('sub cm : assertion { "ok" }; use assertions Hello; print cm()',
+	      'ok',
+	      { switches => ['-AHello'] }, '-A');
+
+#2
+fresh_perl_is('sub cm : assertion { "ok" }; use assertions SDFJKS; print cm()',
+	      'ok',
+	      { switches => ['-A.*'] }, '-A.*');
+
+#3
+fresh_perl_is('sub cm : assertion { "ok" }; use assertions Bye; print cm()',
+	      'ok',
+	      { switches => ['-AB.e'] }, '-AB.e');
+
+#4
+fresh_perl_is('sub cm : assertion { "ok" }; use assertions Hello; print cm()',
+	      '0',
+	      { switches => ['-ANoH..o'] }, '-ANoH..o');
+
+#5
+fresh_perl_is('sub cm : assertion { "ok" }; use assertions Hello; print cm()',
+             'ok',
+             { switches => ['-A'] }, '-A');
diff --git a/t/uni/write.t b/t/uni/write.t
new file mode 100644
index 0000000000..1a7564d3ac
--- /dev/null
+++ b/t/uni/write.t
@@ -0,0 +1,100 @@
+#!./perl -w
+use strict;
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = qw(../lib .);
+    require "test.pl";
+    unless (PerlIO::Layer->find('perlio')){
+        print "1..0 # Skip: PerlIO required\n";
+        exit 0;
+    }
+}
+
+plan tests => 6;
+
+# Some tests for UTF8 and format/write
+
+our ($bitem1, $uitem1) = ("\x{ff}", "\x{100}");
+our ($bitem2, $uitem2) = ("\x{fe}", "\x{101}");
+our ($blite1, $ulite1) = ("\x{fd}", "\x{102}");
+our ($blite2, $ulite2) = ("\x{fc}", "\x{103}");
+our ($bmulti, $umulti) = ("\x{fb}\n\x{fa}\n\x{f9}\n",
+			  "\x{104}\n\x{105}\n\x{106}\n");
+
+sub fmwrtest {
+  no strict 'refs';
+  my ($out, $format, $expect, $name) = @_;
+  eval "format $out =\n$format.\n"; die $@ if $@;
+  open $out, '>:utf8', 'Uni_write.tmp' or die "Can't create Uni_write.tmp";
+  write $out;
+  close $out or die "Could not close $out: $!";
+
+  open UIN, '<:utf8', 'Uni_write.tmp' or die "Can't open Uni_write.tmp";;
+  my $result = do { local $/; <UIN>; };
+  close UIN;
+
+  is($result, $expect, $name);
+}
+
+fmwrtest OUT1 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (1)";
+$blite1 @<<
+\$uitem1
+$blite2 @<<
+\$bitem2
+EOFORMAT
+$blite1 $uitem1
+$blite2 $bitem2
+EOEXPECT
+
+fmwrtest OUT2 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 item (2)";
+$blite1 @<<
+\$bitem1
+$blite2 @<<
+\$uitem2
+EOFORMAT
+$blite1 $bitem1
+$blite2 $uitem2
+EOEXPECT
+
+fmwrtest OUT3 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (1)";
+$ulite1 @<<
+\$bitem1
+$blite2 @<<
+\$bitem2
+EOFORMAT
+$ulite1 $bitem1
+$blite2 $bitem2
+EOEXPECT
+
+fmwrtest OUT4 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 item (2)";
+$blite1 @<<
+\$bitem1
+$ulite2 @<<
+\$bitem2
+EOFORMAT
+$blite1 $bitem1
+$ulite2 $bitem2
+EOEXPECT
+
+fmwrtest OUT5 => <<EOFORMAT, <<EOEXPECT, "non-UTF8 literal / UTF8 multiline";
+$blite1
+@*
+\$umulti
+$blite2
+EOFORMAT
+$blite1
+$umulti$blite2
+EOEXPECT
+
+fmwrtest OUT6 => <<EOFORMAT, <<EOEXPECT, "UTF8 literal / non-UTF8 multiline";
+$ulite1
+@*
+\$bmulti
+$blite2
+EOFORMAT
+$ulite1
+$bmulti$blite2
+EOEXPECT
+
+unlink 'Uni_write.tmp';