Merge of mainline (does not build MULTIPLICITY/DEBUGGING issue).

p4raw-id: //depot/perlio@10044

11 files changed, 331 insertions, 64 deletions

diff --git a/t/io/fflush.t b/t/io/fflush.t
index 2c7f7bbc97..6c22fa663a 100644
--- a/t/io/fflush.t
+++ b/t/io/fflush.t
@@ -122,9 +122,9 @@ for (qw(system qx popen)) {
     my $command = qq{$runperl "ff-prog" "$f" "rl"};
     open OUT, "> $f" or die "open $f: $!";
     print OUT "Pe";
+    close OUT;
     print "# $command\n";
     $code->($command);
-    close OUT;
     print file_eq($f, "Perl") ? "ok $t\n" : "not ok $t\n";
     push @delete, $f;
     ++$t;
diff --git a/t/lib/b-deparse.t b/t/lib/b-deparse.t
index 59f8cbfb4f..048ce31eef 100644
--- a/t/lib/b-deparse.t
+++ b/t/lib/b-deparse.t
@@ -15,7 +15,7 @@ use warnings;
 use strict;
 use Config;
 
-print "1..12\n";
+print "1..14\n";
 
 use B::Deparse;
 my $deparse = B::Deparse->new() or print "not ";
@@ -166,3 +166,11 @@ $test /= 2 if ++$test;
 continue {
     123;
 }
+####
+# 9
+my $x;
+print $main::x;
+####
+# 10
+my @x;
+print $main::x[1];
diff --git a/t/lib/b-stash.t b/t/lib/b-stash.t
index de439127bb..3d12de3dfe 100644
--- a/t/lib/b-stash.t
+++ b/t/lib/b-stash.t
@@ -32,13 +32,19 @@ $a =~ s/-u(PerlIO|open)(?:::\w+)?,//g if defined $Config{'useperlio'} and $Confi
 $a =~ s/-uWin32,// if $^O eq 'MSWin32';
 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 $a =~ s/-uCwd,// if $^O eq 'cygwin';
-if ($Config{static_ext} eq ' ') {
   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uattributes,'
      . '-umain,-ustrict,-uutf8,-uwarnings';
+if ($Is_VMS) {
+    $a =~ s/-uFile,-uFile::Copy,//;
+    $a =~ s/-uVMS,-uVMS::Filespec,//;
+    $a =~ s/-uSocket,//; # Socket is optional/compiler version dependent
+}
+if ($Config{static_ext} eq ' ' ||
+    ($Config{static_ext} eq 'Socket' && $Is_VMS)) {
   if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
       $b = join ',', sort split /,/, $b;
   }
-  print "# [$a] vs [$b]\nnot " if $a ne $b;
+  print "# [$a]\n# vs.\n# [$b]\nnot " if $a ne $b;
   ok;
 } else {
   print "ok $test # skipped: one or more static extensions\n"; $test++;
diff --git a/t/lib/io_scalar.t b/t/lib/io_scalar.t
index 928355ecb5..14bbf4d222 100644
--- a/t/lib/io_scalar.t
+++ b/t/lib/io_scalar.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 $| = 1;
-print "1..11\n";
+print "1..19\n";
 
 my $fh;
 my $var = "ok 2\n";
@@ -32,17 +32,57 @@ print "not " if eof($fh);
 print "ok 8\n";
 print "not " unless <$fh> eq "foo\n";
 print "ok 9\n";
-# Test multiple consecutive writes to $var
-$var = "";
-seek($fh, 0, 0);
-print $fh "Fred and Wilma ";
-print $fh "Flintstone";
-print "not " unless $var eq "Fred and Wilma Flintstone";
+my $rv = close $fh;
+if (!$rv) {
+    print "# Close on scalar failed: $!\n";
+    print "not ";
+}
 print "ok 10\n";
-# Test appending
+
+# Test that semantics are similar to normal file-based I/O
+# Check that ">" clobbers the scalar
+$var = "Something";
+open $fh, ">", \$var;
+print "# Got [$var], expect []\n";
+print "not " unless $var eq "";
+print "ok 11\n";
+#  Check that file offset set to beginning of scalar
+my $off = tell($fh);
+print "# Got $off, expect 0\n";
+print "not " unless $off == 0;
+print "ok 12\n";
+# Check that writes go where they should and update the offset
+$var = "Something";
+print $fh "Brea";
+$off = tell($fh);
+print "# Got $off, expect 4\n";
+print "not " unless $off == 4;
+print "ok 13\n";
+print "# Got [$var], expect [Breathing]\n";
+print "not " unless $var eq "Breathing";
+print "ok 14\n";
 close $fh;
-$var = "Fred and Wilma ";
+
+# Check that ">>" appends to the scalar
+$var = "Something ";
 open $fh, ">>", \$var;
-print $fh "Flintstone";
-print "not " unless $var eq "Fred and Wilma Flintstone";
-print "ok 11\n";
+$off = tell($fh);
+print "# Got $off, expect 10\n";
+print "not " unless $off == 10;
+print "ok 15\n";
+print "# Got [$var], expect [Something ]\n";
+print "not " unless $var eq "Something ";
+print "ok 16\n";
+#  Check that further writes go to the very end of the scalar
+$var .= "else ";
+print "# Got [$var], expect [Something else ]\n";
+print "not " unless $var eq "Something else ";
+print "ok 17\n";
+$off = tell($fh);
+print "# Got $off, expect 10\n";
+print "not " unless $off == 10;
+print "ok 18\n";
+print $fh "is here";
+print "# Got [$var], expect [Something else is here]\n";
+print "not " unless $var eq "Something else is here";
+print "ok 19\n";
diff --git a/t/lib/tb-xbrak.t b/t/lib/tb-xbrak.t
index 8f61160b7b..5a8e5249a8 100644
--- a/t/lib/tb-xbrak.t
+++ b/t/lib/tb-xbrak.t
@@ -11,7 +11,7 @@ BEGIN {
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
-BEGIN { $| = 1; print "1..17\n"; }
+BEGIN { $| = 1; print "1..19\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_bracketed );
 $loaded = 1;
@@ -58,6 +58,7 @@ __DATA__
 
 # USING: extract_bracketed($str);
 {a nested { and } are okay as are () and <> pairs and escaped \}'s };
+{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s };
 
 # USING: extract_bracketed($str,'{}');
 {a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s };
diff --git a/t/op/my_stash.t b/t/op/my_stash.t
index 4a1d5022e0..5a131830be 100644
--- a/t/op/my_stash.t
+++ b/t/op/my_stash.t
@@ -14,6 +14,7 @@ use constant MyClass => 'Foo::Bar::Biz::Baz';
 
 {
     package Foo::Bar::Biz::Baz;
+    1;
 }
 
 for (qw(Foo Foo:: MyClass __PACKAGE__)) {
diff --git a/t/pod/plainer.t b/t/pod/plainer.t
new file mode 100644
index 0000000000..7bc0b8dde3
--- /dev/null
+++ b/t/pod/plainer.t
@@ -0,0 +1,55 @@
+#!./perl
+
+BEGIN { chdir 't' if -d 't'; @INC = '../lib' }
+
+use Pod::Plainer;
+my $parser = Pod::Plainer->new();
+my $header = "=pod\n\n";
+my $input  = 'plnr_in.pod';
+my $output = 'plnr_out.pod';
+
+my $test = 0;
+print "1..7\n";
+while( <DATA> ) {
+    my $expected = $header.<DATA>; 
+
+    open(IN, '>', $input) or die $!;
+    print IN $header, $_;
+    close IN or die $!;
+
+    open IN, '<', $input or die $!;
+    open OUT, '>', $output or die $!;
+    $parser->parse_from_filehandle(\*IN,\*OUT);
+
+    open OUT, '<', $output or die $!;
+    my $returned; { local $/; $returned = <OUT>; }
+    
+    unless( $returned eq $expected ) {
+       print map { s/^/\#/mg; $_; }
+               map {+$_}               # to avoid readonly values
+                   "EXPECTED:\n", $expected, "GOT:\n", $returned;
+       print "not ";
+    }
+    printf "ok %d\n", ++$test; 
+}
+
+END { 
+    1 while unlink $input;
+    1 while unlink $output;
+}
+
+__END__
+=head <> now reads in records
+=head E<lt>E<gt> now reads in records
+=item C<-T> and C<-B> not implemented on filehandles
+=item C<-T> and C<-B> not implemented on filehandles
+e.g. C<< Foo->bar() >> or C<< $obj->bar() >>
+e.g. C<Foo-E<gt>bar()> or C<$obj-E<gt>bar()>
+The C<< => >> operator is mostly just a more visually distinctive
+The C<=E<gt>> operator is mostly just a more visually distinctive
+C<uv < 0x80> in which case you can use C<*s = uv>.
+C<uv E<lt> 0x80> in which case you can use C<*s = uv>.
+C<time ^ ($$ + ($$ << 15))>), but that isn't necessary any more.
+C<time ^ ($$ + ($$ E<lt>E<lt> 15))>), but that isn't necessary any more.
+The bitwise operation C<<< >> >>>
+The bitwise operation C<E<gt>E<gt>>
diff --git a/t/pod/testp2pt.pl b/t/pod/testp2pt.pl
index 8cfdbb9386..735350ff40 100644
--- a/t/pod/testp2pt.pl
+++ b/t/pod/testp2pt.pl
@@ -156,7 +156,7 @@ sub testpodplaintext( @ ) {
    for $podfile (@testpods) {
       ($testname, $_) = fileparse($podfile);
       $testdir ||=  $_;
-      $testname  =~ s/\.t$//;
+      $testname  =~ s/\..*$//;
       $cmpfile   =  $testdir . $testname . '.xr';
       $outfile   =  $testdir . $testname . '.OUT';
 
diff --git a/t/pragma/overload.t b/t/pragma/overload.t
index b3105309c3..d07506261d 100755
--- a/t/pragma/overload.t
+++ b/t/pragma/overload.t
@@ -494,7 +494,7 @@ test($c, "bareword");	# 135
   sub STORE { 
     my $obj = shift; 
     $#$obj = 1; 
-    @$obj->[0,1] = ('=', shift);
+    $obj->[1] = shift;
   }
 }
 
@@ -615,7 +615,7 @@ test($c, "bareword");	# 135
   sub STORE { 
     my $obj = shift; 
     $#$obj = 1; 
-    @$obj->[0,1] = ('=', shift);
+    $obj->[1] = shift;
   }
 }
 
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
index b4b8e4e468..2f847ad14c 100644
--- a/t/pragma/warn/op
+++ b/t/pragma/warn/op
@@ -205,6 +205,36 @@ EXPECT
 Use of implicit split to @_ is deprecated at - line 3.
 ########
 # op.c
+use warnings 'deprecated';
+my (@foo, %foo);
+%main::foo->{"bar"};
+%foo->{"bar"};
+@main::foo->[23];
+@foo->[23];
+$main::foo = {}; %$main::foo->{"bar"};
+$foo = {}; %$foo->{"bar"};
+$main::foo = []; @$main::foo->[34];
+$foo = []; @$foo->[34];
+no warnings 'deprecated';
+%main::foo->{"bar"};
+%foo->{"bar"};
+@main::foo->[23];
+@foo->[23];
+$main::foo = {}; %$main::foo->{"bar"};
+$foo = {}; %$foo->{"bar"};
+$main::foo = []; @$main::foo->[34];
+$foo = []; @$foo->[34];
+EXPECT
+Using a hash as a reference is deprecated at - line 4.
+Using a hash as a reference is deprecated at - line 5.
+Using an array as a reference is deprecated at - line 6.
+Using an array as a reference is deprecated at - line 7.
+Using a hash as a reference is deprecated at - line 8.
+Using a hash as a reference is deprecated at - line 9.
+Using an array as a reference is deprecated at - line 10.
+Using an array as a reference is deprecated at - line 11.
+########
+# op.c
 use warnings 'void' ; close STDIN ;
 1 x 3 ;			# OP_REPEAT
 			# OP_GVSV
diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke
index 1776428188..6adddfc800 100644
--- a/t/pragma/warn/toke
+++ b/t/pragma/warn/toke
@@ -368,62 +368,188 @@ Ambiguous use of ${fred} resolved to $fred at - line 4.
 ########
 # toke.c
 use warnings 'syntax' ;
-$a = _123;	print "$a\n"; # not a number, a string
-$a = 1_23;	print "$a\n";
-$a = 1__3;	print "$a\n"; # misplaced [ 5]
-$a = 123_;	print "$a\n"; # misplaced [ 6]
-$a = 123._456;	print "$a\n"; # misplaced [ 7]
-$a = 123.4_56;	print "$a\n"; 
-$a = 123.4__6;	print "$a\n"; # misplaced [ 9]
-$a = 123.456_;	print "$a\n"; # misplaced [10]
-$a = 0b_101;	print "$a\n"; # misplaced [11]
-$a = 0b1_01;	print "$a\n";
-$a = 0b1__1;	print "$a\n"; # misplaced [13]
-$a = 0b101_;	print "$a\n"; # misplaced [14]
-$a = 0_123;	print "$a\n"; # misplaced [15]
-$a = 01_23;	print "$a\n";
-$a = 01__3;	print "$a\n"; # misplaced [17]
-$a = 0123_;	print "$a\n"; # misplaced [18]
-$a = 0x_123;	print "$a\n"; # misplaced [19]
-$a = 0x1_23;	print "$a\n";
-$a = 0x1__3;	print "$a\n"; # misplaced [21]
-$a = 0x123_;	print "$a\n"; # misplaced [22]
+$a = _123; print "$a\n";		#( 3	string)
+$a = 1_23; print "$a\n";
+$a = 12_3; print "$a\n";
+$a = 123_; print "$a\n";		#  6
+$a = _+123; print "$a\n";		#  7	string)
+$a = +_123; print "$a\n";		#( 8	string)
+$a = +1_23; print "$a\n";
+$a = +12_3; print "$a\n";
+$a = +123_; print "$a\n";		# 11
+$a = _-123; print "$a\n";		#(12	string)
+$a = -_123; print "$a\n";		#(13	string)
+$a = -1_23; print "$a\n";
+$a = -12_3; print "$a\n";
+$a = -123_; print "$a\n";		# 16
+$a = 123._456; print "$a\n";		# 17
+$a = 123.4_56; print "$a\n";
+$a = 123.45_6; print "$a\n";
+$a = 123.456_; print "$a\n";		# 20
+$a = +123._456; print "$a\n";		# 21
+$a = +123.4_56; print "$a\n";	
+$a = +123.45_6; print "$a\n";	
+$a = +123.456_; print "$a\n";		# 24
+$a = -123._456; print "$a\n";		# 25
+$a = -123.4_56; print "$a\n";	
+$a = -123.45_6; print "$a\n";
+$a = -123.456_; print "$a\n";		# 28
+$a = 123.456E_12; print "$a\n";		# 29
+$a = 123.456E1_2; print "$a\n";
+$a = 123.456E12_; print "$a\n";		# 31
+$a = 123.456E_+12; print "$a\n";	# 32
+$a = 123.456E+_12; print "$a\n";	# 33
+$a = 123.456E+1_2; print "$a\n";
+$a = 123.456E+12_; print "$a\n";	# 35
+$a = 123.456E_-12; print "$a\n";	# 36
+$a = 123.456E-_12; print "$a\n";	# 37
+$a = 123.456E-1_2; print "$a\n";
+$a = 123.456E-12_; print "$a\n";	# 39
+$a = 1__23; print "$a\n";		# 40
+$a = 12.3__4; print "$a\n";		# 41
+$a = 12.34e1__2; print "$a\n";		# 42
 no warnings 'syntax' ;
+$a = _123; print "$a\n";
+$a = 1_23; print "$a\n";
+$a = 12_3; print "$a\n";
+$a = 123_; print "$a\n";
+$a = _+123; print "$a\n";
+$a = +_123; print "$a\n";
+$a = +1_23; print "$a\n";
+$a = +12_3; print "$a\n";
+$a = +123_; print "$a\n";
+$a = _-123; print "$a\n";
+$a = -_123; print "$a\n";
+$a = -1_23; print "$a\n";
+$a = -12_3; print "$a\n";
+$a = -123_; print "$a\n";
+$a = 123._456; print "$a\n";
+$a = 123.4_56; print "$a\n";
+$a = 123.45_6; print "$a\n";
+$a = 123.456_; print "$a\n";
+$a = +123._456; print "$a\n";
+$a = +123.4_56; print "$a\n";
+$a = +123.45_6; print "$a\n";
+$a = +123.456_; print "$a\n";
+$a = -123._456; print "$a\n";
+$a = -123.4_56; print "$a\n";
+$a = -123.45_6; print "$a\n";
+$a = -123.456_; print "$a\n";
+$a = 123.456E_12; print "$a\n";
+$a = 123.456E1_2; print "$a\n";
+$a = 123.456E12_; print "$a\n";
+$a = 123.456E_+12; print "$a\n";
+$a = 123.456E+_12; print "$a\n";
+$a = 123.456E+1_2; print "$a\n";
+$a = 123.456E+12_; print "$a\n";
+$a = 123.456E_-12; print "$a\n";
+$a = 123.456E-_12; print "$a\n";
+$a = 123.456E-1_2; print "$a\n";
+$a = 123.456E-12_; print "$a\n";
+$a = 1__23; print "$a\n";
+$a = 12.3__4; print "$a\n";
+$a = 12.34e1__2; print "$a\n";
 EXPECT
-Misplaced _ in number at - line 5.
 Misplaced _ in number at - line 6.
-Misplaced _ in number at - line 7.
-Misplaced _ in number at - line 9.
-Misplaced _ in number at - line 10.
 Misplaced _ in number at - line 11.
-Misplaced _ in number at - line 13.
-Misplaced _ in number at - line 14.
-Misplaced _ in number at - line 15.
+Misplaced _ in number at - line 16.
 Misplaced _ in number at - line 17.
-Misplaced _ in number at - line 18.
-Misplaced _ in number at - line 19.
+Misplaced _ in number at - line 20.
 Misplaced _ in number at - line 21.
-Misplaced _ in number at - line 22.
+Misplaced _ in number at - line 24.
+Misplaced _ in number at - line 25.
+Misplaced _ in number at - line 28.
+Misplaced _ in number at - line 29.
+Misplaced _ in number at - line 31.
+Misplaced _ in number at - line 32.
+Misplaced _ in number at - line 33.
+Misplaced _ in number at - line 35.
+Misplaced _ in number at - line 36.
+Misplaced _ in number at - line 37.
+Misplaced _ in number at - line 39.
+Misplaced _ in number at - line 40.
+Misplaced _ in number at - line 41.
+Misplaced _ in number at - line 42.
 _123
 123
-13
 123
+123
+123
+_123
+123
+123
+123
+-123
+-_123
+-123
+-123
+-123
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+123.456
+-123.456
+-123.456
+-123.456
+-123.456
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+1.23456e-10
+1.23456e-10
+1.23456e-10
+1.23456e-10
+123
+12.34
+12340000000000
+_123
+123
+123
+123
+123
+_123
+123
+123
+123
+-123
+-_123
+-123
+-123
+-123
+123.456
+123.456
+123.456
 123.456
 123.456
-123.46
 123.456
-5
-5
-3
-5
-83
-83
-11
-83
-291
-291
-19
-291
+123.456
+123.456
+-123.456
+-123.456
+-123.456
+-123.456
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+123456000000000
+1.23456e-10
+1.23456e-10
+1.23456e-10
+1.23456e-10
+123
+12.34
+12340000000000
 ########
 # toke.c
 use warnings 'bareword' ;