Integrate with Sarathy.

p4raw-id: //depot/cfgperl@4091

14 files changed, 887 insertions, 134 deletions

diff --git a/t/lib/dumper.t b/t/lib/dumper.t
index 96c07ea48a..9130d1c690 100755
--- a/t/lib/dumper.t
+++ b/t/lib/dumper.t
@@ -20,6 +20,8 @@ sub TEST {
   my $string = shift;
   my $t = eval $string;
   ++$TNUM;
+  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+      if ($WANT =~ /deadbeef/);
   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
 	: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
 
@@ -29,17 +31,19 @@ sub TEST {
 
   $t = eval $string;
   ++$TNUM;
+  $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g
+      if ($WANT =~ /deadbeef/);
   print( ($t eq $WANT and not $@) ? "ok $TNUM\n"
 	: "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n");
 }
 
 if (defined &Data::Dumper::Dumpxs) {
   print "### XS extension loaded, will run XS tests\n";
-  $TMAX = 162; $XS = 1;
+  $TMAX = 174; $XS = 1;
 }
 else {
   print "### XS extensions not loaded, will NOT run XS tests\n";
-  $TMAX = 81; $XS = 0;
+  $TMAX = 87; $XS = 0;
 }
 
 print "1..$TMAX\n";
@@ -702,3 +706,48 @@ TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dump;);
 TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Purity(1)->Dumpxs;)
 	if $XS;
 }
+
+{
+    $f = "pearl";
+    $e = [        $f ];
+    $d = { 'e' => $e };
+    $c = [        $d ];
+    $b = { 'c' => $c };
+    $a = { 'b' => $b };
+
+############# 163
+##
+  $WANT = <<'EOT';
+#$a = {
+#  b => {
+#    c => [
+#      {
+#        e => 'ARRAY(0xdeadbeef)'
+#      }
+#    ]
+#  }
+#};
+#$b = $a->{b};
+#$c = $a->{b}{c};
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(4)->Dumpxs;)
+	if $XS;
+
+############# 169
+##
+  $WANT = <<'EOT';
+#$a = {
+#  b => 'HASH(0xdeadbeef)'
+#};
+#$b = $a->{b};
+#$c = [
+#  'HASH(0xdeadbeef)'
+#];
+EOT
+
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dump;);
+TEST q(Data::Dumper->new([$a,$b,$c],['a','b','c'])->Maxdepth(1)->Dumpxs;)
+	if $XS;
+}
diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t
index 01e0ba0019..b5c471a5a0 100755
--- a/t/op/lex_assign.t
+++ b/t/op/lex_assign.t
@@ -22,7 +22,8 @@ $nn = $n = 2;
 sub subb {"in s"}
 
 @INPUT = <DATA>;
-print "1..", (8 + @INPUT), "\n";
+@simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT;
+print "1..", (8 + @INPUT + @simple_input), "\n";
 $ord = 0;
 
 sub wrn {"@_"}
@@ -121,6 +122,33 @@ EOE
     }
   }
 }
+
+for (@simple_input) {
+  $ord++;
+  ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/;
+  $comment = $op unless defined $comment;
+  ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n";
+  eval <<EOE;
+  local \$SIG{__WARN__} = \\&wrn;
+  my \$$variable = "Ac# Ca\\nxxx";
+  \$$variable = $operator \$$variable;
+  \$toself = \$$variable;
+  \$direct = $operator "Ac# Ca\\nxxx";
+  print "# \\\$$variable = $operator \\\$$variable\\nnot "
+    unless \$toself eq \$direct;
+  print "ok \$ord\\n";
+EOE
+  if ($@) {
+    if ($@ =~ /is unimplemented/) {
+      print "# skipping $comment: unimplemented:\nok $ord\n";
+    } elsif ($@ =~ /Can't (modify|take log of 0)/) {
+      print "# skipping $comment: syntax not good for selfassign:\nok $ord\n";
+    } else {
+      warn $@;
+      print "not ok $ord\n";
+    }
+  }
+}
 __END__
 ref $xref			# ref
 ref $cstr			# ref nonref
diff --git a/t/pragma/sub_lval.t b/t/pragma/sub_lval.t
new file mode 100755
index 0000000000..f6d867c829
--- /dev/null
+++ b/t/pragma/sub_lval.t
@@ -0,0 +1,429 @@
+print "1..46\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib';
+}
+
+sub a {use attrs 'lvalue'; my $a = 34; bless \$a}  # Return a temporary
+sub b {use attrs 'lvalue'; shift}
+
+my $out = a(b());		# Check that temporaries are allowed.
+print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error.
+print "ok 1\n";
+
+my @out = grep /main/, a(b()); # Check that temporaries are allowed.
+print "# `@out'\nnot " unless @out==1; # Not reached if error.
+print "ok 2\n";
+
+my $in;
+
+# Check that we can return localized values from subroutines:
+
+sub in {use attrs 'lvalue'; $in = shift;}
+sub neg {use attrs 'lvalue';  #(num_str) return num_str
+    local $_ = shift;
+    s/^\+/-/;
+    $_;
+}
+in(neg("+2"));
+
+
+print "# `$in'\nnot " unless $in eq '-2';
+print "ok 3\n";
+
+sub get_lex {use attrs 'lvalue'; $in}
+sub get_st {use attrs 'lvalue'; $blah}
+sub id {use attrs 'lvalue'; shift}
+sub id1 {use attrs 'lvalue'; $_[0]}
+sub inc {use attrs 'lvalue'; ++$_[0]}
+
+$in = 5;
+$blah = 3;
+
+get_st = 7;
+
+print "# `$blah' ne 7\nnot " unless $blah eq 7;
+print "ok 4\n";
+
+get_lex = 7;
+
+print "# `$in' ne 7\nnot " unless $in eq 7;
+print "ok 5\n";
+
+++get_st;
+
+print "# `$blah' ne 8\nnot " unless $blah eq 8;
+print "ok 6\n";
+
+++get_lex;
+
+print "# `$in' ne 8\nnot " unless $in eq 8;
+print "ok 7\n";
+
+id(get_st) = 10;
+
+print "# `$blah' ne 10\nnot " unless $blah eq 10;
+print "ok 8\n";
+
+id(get_lex) = 10;
+
+print "# `$in' ne 10\nnot " unless $in eq 10;
+print "ok 9\n";
+
+++id(get_st);
+
+print "# `$blah' ne 11\nnot " unless $blah eq 11;
+print "ok 10\n";
+
+++id(get_lex);
+
+print "# `$in' ne 11\nnot " unless $in eq 11;
+print "ok 11\n";
+
+id1(get_st) = 20;
+
+print "# `$blah' ne 20\nnot " unless $blah eq 20;
+print "ok 12\n";
+
+id1(get_lex) = 20;
+
+print "# `$in' ne 20\nnot " unless $in eq 20;
+print "ok 13\n";
+
+++id1(get_st);
+
+print "# `$blah' ne 21\nnot " unless $blah eq 21;
+print "ok 14\n";
+
+++id1(get_lex);
+
+print "# `$in' ne 21\nnot " unless $in eq 21;
+print "ok 15\n";
+
+inc(get_st);
+
+print "# `$blah' ne 22\nnot " unless $blah eq 22;
+print "ok 16\n";
+
+inc(get_lex);
+
+print "# `$in' ne 22\nnot " unless $in eq 22;
+print "ok 17\n";
+
+inc(id(get_st));
+
+print "# `$blah' ne 23\nnot " unless $blah eq 23;
+print "ok 18\n";
+
+inc(id(get_lex));
+
+print "# `$in' ne 23\nnot " unless $in eq 23;
+print "ok 19\n";
+
+++inc(id1(id(get_st)));
+
+print "# `$blah' ne 25\nnot " unless $blah eq 25;
+print "ok 20\n";
+
+++inc(id1(id(get_lex)));
+
+print "# `$in' ne 25\nnot " unless $in eq 25;
+print "ok 21\n";
+
+@a = (1) x 3;
+@b = (undef) x 2;
+$#c = 3;			# These slots are not fillable.
+
+# Explanation: empty slots contain &sv_undef.
+
+=for disabled constructs
+
+sub a3 {use attrs 'lvalue'; @a}
+sub b2 {use attrs 'lvalue'; @b}
+sub c4 {use attrs 'lvalue'; @c}
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  ($x, a3, $y, b2, $z, c4, $t) = (34 .. 78);
+  1;
+EOE
+
+#@out = ($x, a3, $y, b2, $z, c4, $t);
+#@in = (34 .. 41, (undef) x 4, 46);
+#print "# `@out' ne `@in'\nnot " unless "@out" eq "@in";
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+=cut
+
+print "ok 22\n";
+
+my $var;
+
+sub a::var {use attrs 'lvalue'; $var}
+
+"a"->var = 45;
+
+print "# `$var' ne 45\nnot " unless $var eq 45;
+print "ok 23\n";
+
+my $oo;
+$o = bless \$oo, "a";
+
+$o->var = 47;
+
+print "# `$var' ne 47\nnot " unless $var eq 47;
+print "ok 24\n";
+
+sub o {use attrs 'lvalue'; $o}
+
+o->var = 49;
+
+print "# `$var' ne 49\nnot " unless $var eq 49;
+print "ok 25\n";
+
+sub nolv () { $x0, $x1 } # Not lvalue
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  nolv = (2,3);
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 26\n";
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  nolv = (2,3) if $_;
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 27\n";
+
+$_ = '';
+
+eval <<'EOE' or $_ = $@;
+  &nolv = (2,3) if $_;
+  1;
+EOE
+
+print "not "
+  unless /Can\'t modify non-lvalue subroutine call in scalar assignment/;
+print "ok 28\n";
+
+$x0 = $x1 = $_ = undef;
+$nolv = \&nolv;
+
+eval <<'EOE' or $_ = $@;
+  $nolv->() = (2,3) if $_;
+  1;
+EOE
+
+print "# '$_', '$x0', '$x1'.\nnot " if defined $_;
+print "ok 29\n";
+
+$x0 = $x1 = $_ = undef;
+$nolv = \&nolv;
+
+eval <<'EOE' or $_ = $@;
+  $nolv->() = (2,3);
+  1;
+EOE
+
+print "# '$_', '$x0', '$x1'.\nnot "
+  unless /Can\'t modify non-lvalue indirect subroutine call/;
+print "ok 30\n";
+
+sub lv0 {use attrs 'lvalue';}		# Converted to lv10 in scalar context
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv0 = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 31\n";
+
+sub lv10 {use attrs 'lvalue';}
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv0) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " if defined $_;
+print "ok 32\n";
+
+sub lv1u {use attrs 'lvalue'; undef }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1u = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 33\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1u) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+print "ok 34\n";
+
+$x = '1234567';
+sub lv1t {use attrs 'lvalue'; index $x, 2 }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1t = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 35\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1t) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 36\n";
+
+$xxx = 'xxx';
+sub xxx () { $xxx }  # Not lvalue
+sub lv1tmp {use attrs 'lvalue'; xxx }			# is it a TEMP?
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1tmp = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 37\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1tmp) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a temporary from lvalue subroutine/;
+print "ok 38\n";
+
+sub xxx () { 'xxx' } # Not lvalue
+sub lv1tmpr {use attrs 'lvalue'; xxx }			# is it a TEMP?
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1tmpr = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 39\n";
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1tmpr) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return a readonly value from lvalue subroutine/;
+print "ok 40\n";
+
+=for disabled constructs
+
+sub lva {use attrs 'lvalue';@a}
+
+$_ = undef;
+@a = ();
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot "
+  unless /Can\'t return an uninitialized value from lvalue subroutine/;
+print "ok 41\n";
+
+$_ = undef;
+@a = ();
+$a[0] = undef;
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 42\n";
+
+$_ = undef;
+@a = ();
+$a[0] = undef;
+$a[1] = 12;
+eval <<'EOE' or $_ = $@;
+  (lva) = (2,3);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'@a' $_" eq "'2 3' ";
+print "ok 43\n";
+
+=cut
+
+print "ok $_\n" for 41..43;
+
+sub lv1n {use attrs 'lvalue'; $newvar }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  lv1n = (3,4);
+  1;
+EOE
+
+print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' ";
+print "ok 44\n";
+
+sub lv1nn {use attrs 'lvalue'; $nnewvar }
+
+$_ = undef;
+eval <<'EOE' or $_ = $@;
+  (lv1nn) = (3,4);
+  1;
+EOE
+
+print "# '$_'.\nnot " unless "'$nnewvar' $_" eq "'3' ";
+print "ok 45\n";
+
+$a = \&lv1nn;
+$a->() = 8;
+print "# '$nnewvar'.\nnot " unless $nnewvar eq '8';
+print "ok 46\n";
diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio
index e6de782686..5101bdef80 100644
--- a/t/pragma/warn/doio
+++ b/t/pragma/warn/doio
@@ -1,60 +1,62 @@
-  doio.c	AOK
+  doio.c	
 
-  Can't do bidirectional pipe
+  Can't do bidirectional pipe		[Perl_do_open9]
     open(F, "| true |");
 
-  Missing command in piped open
+  Missing command in piped open		[Perl_do_open9]
     open(F, "| ");
 
-  Missing command in piped open
+  Missing command in piped open		[Perl_do_open9]
     open(F, " |");
 
-  warn(warn_nl, "open");
+  warn(warn_nl, "open");		[Perl_do_open9]
     open(F, "true\ncd")
 
-  Close on unopened file <%s>
-    $a = "fred";close($a)
+  Close on unopened file <%s>		[Perl_do_close] <<TODO
+    $a = "fred";close("$a")
 
-  tell() on unopened file
+  tell() on unopened file		[Perl_do_tell]
     $a = "fred";$a = tell($a)
 
-  seek() on unopened file
+  seek() on unopened file		[Perl_do_seek]
     $a = "fred";$a = seek($a,1,1)
 
-  sysseek() on unopened file
+  sysseek() on unopened file		[Perl_do_sysseek]
     $a = "fred";$a = seek($a,1,1)
 
-  warn(warn_uninit);
+  warn(warn_uninit);			[Perl_do_print]
     print $a ;
 
-  Stat on unopened file <%s> 
+  Stat on unopened file <%s> 		[Perl_my_stat]
     close STDIN ; -x STDIN ;
 
-  warn(warn_nl, "stat");
+  warn(warn_nl, "stat");		[Perl_my_stat]
     stat "ab\ncd"
 
-  warn(warn_nl, "lstat");
+  warn(warn_nl, "lstat");		[Perl_my_lstat]
     lstat "ab\ncd"
 
-  Can't exec \"%s\": %s 
+  Can't exec \"%s\": %s 		[Perl_do_aexec5]
 
-  Can't exec \"%s\": %s 
+  Can't exec \"%s\": %s 		[Perl_do_exec3]
 
+  Filehandle %s opened only for output	[Perl_do_eof]
+	my $a = eof STDOUT
 
   Mandatory Warnings ALL TODO
   ------------------
-  Can't do inplace edit: %s is not a regular file
+  Can't do inplace edit: %s is not a regular file	[Perl_nextargv]
      edit a directory
 
-  Can't do inplace edit: %s would not be unique
-  Can't rename %s to %s: %s, skipping file
-  Can't rename %s to %s: %s, skipping file
-  Can't remove %s: %s, skipping file
-  Can't do inplace edit on %s: %s
+  Can't do inplace edit: %s would not be unique		[Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file		[Perl_nextargv]
+  Can't rename %s to %s: %s, skipping file		[Perl_nextargv]
+  Can't remove %s: %s, skipping file			[Perl_nextargv]
+  Can't do inplace edit on %s: %s			[Perl_nextargv]
   
 
 __END__
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|");
 close(F);
@@ -64,7 +66,7 @@ close(G);
 EXPECT
 Can't do bidirectional pipe at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, "|      ");
 no warnings 'io' ;
@@ -72,7 +74,7 @@ open(G, "|      ");
 EXPECT
 Missing command in piped open at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, "      |");
 no warnings 'io' ;
@@ -80,7 +82,7 @@ open(G, "      |");
 EXPECT
 Missing command in piped open at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_open9]
 use warnings 'io' ;
 open(F, "<true\ncd");
 no warnings 'io' ;
@@ -88,7 +90,15 @@ open(G, "<true\ncd");
 EXPECT
 Unsuccessful open on filename containing newline at - line 3.
 ########
-# doio.c
+# doio.c [Perl_do_close] <<TODO
+use warnings 'unopened' ;
+close "fred" ;
+no warnings 'unopened' ;
+close "joe" ;
+EXPECT
+Close on unopened file <fred> at - line 3.
+########
+# doio.c [Perl_do_tell Perl_do_seek Perl_do_sysseek Perl_my_stat]
 use warnings 'io' ;
 close STDIN ;
 tell(STDIN);
@@ -107,7 +117,7 @@ seek() on unopened file at - line 5.
 sysseek() on unopened file at - line 6.
 Stat on unopened file <STDIN> at - line 7.
 ########
-# doio.c
+# doio.c [Perl_do_print]
 use warnings 'uninitialized' ;
 print $a ;
 no warnings 'uninitialized' ;
@@ -115,13 +125,7 @@ print $b ;
 EXPECT
 Use of uninitialized value at - line 3.
 ########
-# doio.c
-use warnings 'io' ;
-
-EXPECT
-
-########
-# doio.c
+# doio.c [Perl_my_stat Perl_my_lstat]
 use warnings 'io' ;
 stat "ab\ncd";
 lstat "ab\ncd";
@@ -132,7 +136,7 @@ EXPECT
 Unsuccessful stat on filename containing newline at - line 3.
 Unsuccessful stat on filename containing newline at - line 4.
 ########
-# doio.c
+# doio.c [Perl_do_aexec5]
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls","" ;
 no warnings 'io' ;
@@ -141,7 +145,7 @@ EXPECT
 OPTION regex
 Can't exec "lskdjfalksdjfdjfkls": .+
 ########
-# doio.c
+# doio.c [Perl_do_exec3]
 use warnings 'io' ;
 exec "lskdjfalksdjfdjfkls", "abc" ;
 no warnings 'io' ;
@@ -150,7 +154,7 @@ EXPECT
 OPTION regex
 Can't exec "lskdjfalksdjfdjfkls(:? abc)?": .+
 ########
-# doio.c
+# doio.c [Perl_nextargv]
 $^W = 0 ;
 my $filename = "./temp" ;
 mkdir $filename, 0777 
@@ -177,3 +181,11 @@ EXPECT
 Can't do inplace edit: ./temp is not a regular file at - line 9.
 Can't do inplace edit: ./temp is not a regular file at - line 21.
 
+########
+# doio.c [Perl_do_eof]
+use warnings 'io' ;
+my $a = eof STDOUT ;
+no warnings 'io' ;
+$a = eof STDOUT ;
+EXPECT
+Filehandle main::STDOUT opened only for output at - line 3.
diff --git a/t/pragma/warn/op b/t/pragma/warn/op
index f6e5e14cad..e50420a8f6 100644
--- a/t/pragma/warn/op
+++ b/t/pragma/warn/op
@@ -95,6 +95,13 @@
      defined(%hash) is deprecated
      (Maybe you should just omit the defined()?)
 	my %h ; defined %h ;
+    
+     /---/ should probably be written as "---"
+        join(/---/, @foo);
+
+    %s() called too early to check prototype		[Perl_peep]
+        fred() ; sub fred ($$) {}
+
 
     Mandatory Warnings 
     ------------------
@@ -107,8 +114,6 @@
     oops: oopsAV		[oopsAV]	TODO
     oops: oopsHV		[oopsHV]	TODO
     
-    
-
 
 __END__
 # op.c
@@ -787,3 +792,19 @@ EXPECT
 Prototype mismatch: sub main::fred () vs ($) at - line 4.
 Prototype mismatch: sub main::freD () vs ($) at - line 11.
 Prototype mismatch: sub main::FRED () vs ($) at - line 14.
+########
+# op.c
+use warnings 'syntax' ;
+join /---/, 'x', 'y', 'z';
+EXPECT
+/---/ should probably be written as "---" at - line 3.
+########
+# op.c [Perl_peep]
+use warnings 'unsafe' ;
+fred() ; 
+sub fred ($$) {}
+no warnings 'unsafe' ;
+joe() ; 
+sub joe ($$) {}
+EXPECT
+main::fred() called too early to check prototype at - line 3.
diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl
index 5e0dd2766c..70e6d60e8d 100644
--- a/t/pragma/warn/pp_ctl
+++ b/t/pragma/warn/pp_ctl
@@ -48,10 +48,10 @@
     Deep recursion on subroutine \"%s\"
 	sub fred
 	{
-    	goto &fred() if $a++ < 200
+    	  fred() if $a++ < 200
 	}
 	 
-	goto &fred()
+	fred()
 
       (in cleanup) foo bar
 	package Foo;
@@ -179,10 +179,10 @@ use warnings 'recursion' ;
 BEGIN { warn "PREFIX\n" ;}
 sub fred
 {
-    goto &fred() if $a++ < 200
+    fred() if $a++ < 200
 }
  
-goto &fred()
+fred()
 EXPECT
 Deep recursion on subroutine "main::fred" at - line 6.
 ########
@@ -191,12 +191,11 @@ no warnings 'recursion' ;
 BEGIN { warn "PREFIX\n" ;}
 sub fred
 {
-    goto &fred() if $a++ < 200
+    fred() if $a++ < 200
 }
  
-goto &fred()
+fred()
 EXPECT
-Can't find label
 ########
 # pp_ctl.c
 use warnings 'unsafe' ;
diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot
index 2a52dfb2df..6bd315148f 100644
--- a/t/pragma/warn/pp_hot
+++ b/t/pragma/warn/pp_hot
@@ -1,40 +1,49 @@
-  pp_hot.c	AOK
+  pp_hot.c	
 
-  Filehandle %s never opened
+  Filehandle %s never opened			[pp_print]
     $f = $a = "abc" ; print $f $a
 
-  Filehandle %s opened only for input
+  Filehandle %s opened only for input		[pp_print]
     print STDIN "abc" ;
 
-  Filehandle %s opened only for output
+  Filehandle %s opened only for output		[pp_print]
     print <STDOUT> ;
 
-  print on closed filehandle %s
+  print on closed filehandle %s			[pp_print]
     close STDIN ; print STDIN "abc" ;
 
-  uninitialized
+  uninitialized					[pp_rv2av]
 	my $a = undef ; my @b = @$a
 
-  uninitialized	
+  uninitialized					[pp_rv2hv]
 	my $a = undef ; my %b = %$a
 
-  Odd number of elements in hash list
+  Odd number of elements in hash list		[pp_aassign]
 	%X = (1,2,3) ;
 
-  Reference found where even-sized list expected 
+  Reference found where even-sized list expected [pp_aassign]
 	$X = [ 1 ..3 ];
 
-  Read on closed filehandle %s
+  Filehandle %s opened only for output		[Perl_do_readline] 
+  	open (FH, ">./xcv") ;
+	my $a = <FH> ;
+
+  glob failed (can't start child: %s)		[Perl_do_readline] <<TODO
+
+  Read on closed filehandle %s			[Perl_do_readline]
     close STDIN ; $a = <STDIN>;
 
-  Deep recursion on subroutine \"%s\"
+  glob failed (child exited with status %d%s)	[Perl_do_readline] <<TODO
+
+  Deep recursion on subroutine \"%s\"		[Perl_sub_crush_depth]
      sub fred { fred() if $a++ < 200} fred()
 
-  Deep recursion on anonymous subroutine 
+  Deep recursion on anonymous subroutine 	[Perl_sub_crush_depth]
      $a = sub { &$a if $a++ < 200} &$a
 
+
 __END__
-# pp_hot.c
+# pp_hot.c [pp_print]
 use warnings 'unopened' ;
 $f = $a = "abc" ; 
 print $f $a;
@@ -43,7 +52,7 @@ print $f $a;
 EXPECT
 Filehandle main::abc never opened at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_print]
 use warnings 'io' ;
 print STDIN "anc";
 print <STDOUT>;
@@ -51,15 +60,15 @@ print <STDERR>;
 open(FOO, ">&STDOUT") and print <FOO>;
 print getc(STDERR);
 print getc(FOO);
-read(FOO,$_,1);
-no warnings 'io' ;
-print STDIN "anc";
 ####################################################################
-#                            N O T E                               #
-# This test is known to fail on Linux and *BSD systems with glibc. #
-# The glibc development team is aware of the problem, and has      #
-# determined a fix for the next release of that library.           #
+# The next test is known to fail on some systems (Linux/BSD+glibc, #
+# NeXT among others.  glibc should be fixed in the next version,   #
+# but it appears other platforms have little hope.  We skip it for #
+# now (on the grounds that it is "just" a warning).                #
 ####################################################################
+#read(FOO,$_,1);
+no warnings 'io' ;
+print STDIN "anc";
 EXPECT
 Filehandle main::STDIN opened only for input at - line 3.
 Filehandle main::STDOUT opened only for output at - line 4.
@@ -67,9 +76,8 @@ Filehandle main::STDERR opened only for output at - line 5.
 Filehandle main::FOO opened only for output at - line 6.
 Filehandle main::STDERR opened only for output at - line 7.
 Filehandle main::FOO opened only for output at - line 8.
-Filehandle main::FOO opened only for output at - line 9.
 ########
-# pp_hot.c
+# pp_hot.c [pp_print]
 use warnings 'closed' ;
 close STDIN ;
 print STDIN "anc";
@@ -78,7 +86,7 @@ print STDIN "anc";
 EXPECT
 print on closed filehandle main::STDIN at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_rv2av]
 use warnings 'uninitialized' ;
 my $a = undef ;
 my @b = @$a;
@@ -87,7 +95,7 @@ my @c = @$a;
 EXPECT
 Use of uninitialized value at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_rv2hv]
 use warnings 'uninitialized' ;
 my $a = undef ;
 my %b = %$a;
@@ -96,7 +104,7 @@ my %c = %$a;
 EXPECT
 Use of uninitialized value at - line 4.
 ########
-# pp_hot.c
+# pp_hot.c [pp_aassign]
 use warnings 'unsafe' ;
 my %X ; %X = (1,2,3) ;
 no warnings 'unsafe' ;
@@ -104,7 +112,7 @@ my %Y ; %Y = (1,2,3) ;
 EXPECT
 Odd number of elements in hash assignment at - line 3.
 ########
-# pp_hot.c
+# pp_hot.c [pp_aassign]
 use warnings 'unsafe' ;
 my %X ; %X = [1 .. 3] ;
 no warnings 'unsafe' ;
@@ -112,7 +120,7 @@ my %Y ; %Y = [1 .. 3] ;
 EXPECT
 Reference found where even-sized list expected at - line 3.
 ########
-# pp_hot.c
+# pp_hot.c [Perl_do_readline]
 use warnings 'closed' ;
 close STDIN ; $a = <STDIN> ;
 no warnings 'closed' ;
@@ -120,7 +128,18 @@ $a = <STDIN> ;
 EXPECT
 Read on closed filehandle main::STDIN at - line 3.
 ########
-# pp_hot.c
+# pp_hot.c [Perl_do_readline]
+use warnings 'io' ;
+my $file = "./xcv" ; unlink $file ;
+open (FH, ">./xcv") ;
+my $a = <FH> ;
+no warnings 'io' ;
+$a = <FH> ;
+unlink $file ;
+EXPECT
+Filehandle main::FH opened only for output at - line 5.
+########
+# pp_hot.c [Perl_sub_crush_depth]
 use warnings 'recursion' ;
 sub fred 
 { 
@@ -135,7 +154,7 @@ sub fred
 EXPECT
 ok
 ########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
 no warnings 'recursion' ;
 sub fred 
 { 
@@ -150,7 +169,7 @@ sub fred
 EXPECT
 
 ########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
 use warnings 'recursion' ;
 $b = sub 
 { 
@@ -161,7 +180,7 @@ $b = sub
 EXPECT
 Deep recursion on anonymous subroutine at - line 5.
 ########
-# pp_hot.c
+# pp_hot.c [Perl_sub_crush_depth]
 no warnings 'recursion' ;
 $b = sub 
 { 
diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys
index d0caf96f34..651cdf9515 100644
--- a/t/pragma/warn/pp_sys
+++ b/t/pragma/warn/pp_sys
@@ -1,83 +1,88 @@
   pp_sys.c 	AOK
 
-  untie attempted while %d inner references still exist
+  untie attempted while %d inner references still exist	[pp_untie]
     sub TIESCALAR { bless [] } ; tie $a, 'main'; untie $a ;
 
-  Filehandle %s opened only for input
+  Filehandle %s opened only for input		[pp_leavewrite]
     format STDIN =
     .
     write STDIN;
 
-  Write on closed filehandle %s
+  Write on closed filehandle %s			[pp_leavewrite]
     format STDIN =
     .
     close STDIN;
     write STDIN ;
 
-  page overflow	
+  page overflow	 				[pp_leavewrite]
 
-  Filehandle %s never opened
+  Filehandle %s never opened			[pp_prtf]
     $a = "abc"; printf $a "fred"
 
-  Filehandle %s opened only for input
+  Filehandle %s opened only for input		[pp_prtf]
     $a = "abc"; 
     printf $a "fred"
 
-  printf on closed filehandle %s
+  printf on closed filehandle %s		[pp_prtf]
     close STDIN ;
     printf STDIN "fred"
 
-  Syswrite on closed filehandle
+  Syswrite on closed filehandle			[pp_send]
     close STDIN; 
     syswrite STDIN, "fred", 1;
 
-  Send on closed socket
+  Send on closed socket				[pp_send]
     close STDIN; 
     send STDIN, "fred", 1
 
-  bind() on closed fd
+  bind() on closed fd				[pp_bind]
     close STDIN; 
     bind STDIN, "fred" ;
 
 
-  connect() on closed fd
+  connect() on closed fd			[pp_connect]
     close STDIN; 
     connect STDIN, "fred" ;
 
-  listen() on closed fd
+  listen() on closed fd				[pp_listen]
     close STDIN; 
     listen STDIN, 2;
 
-  accept() on closed fd
+  accept() on closed fd				[pp_accept]
     close STDIN; 
     accept STDIN, "fred" ;
 
-  shutdown() on closed fd
+  shutdown() on closed fd			[pp_shutdown]
     close STDIN; 
     shutdown STDIN, 0;
 
-  [gs]etsockopt() on closed fd
+  [gs]etsockopt() on closed fd			[pp_ssockopt]
     close STDIN; 
     setsockopt STDIN, 1,2,3;
     getsockopt STDIN, 1,2;
 
-  get{sock, peer}name() on closed fd
+  get{sock, peer}name() on closed fd		[pp_getpeername]
     close STDIN; 
     getsockname STDIN;
     getpeername STDIN;
 
-  warn(warn_nl, "stat");
+  warn(warn_nl, "stat");			[pp_stat]
 
   Test on unopened file <%s>
 	close STDIN ; -T STDIN ;
 
-  warn(warn_nl, "open");
+  warn(warn_nl, "open");			[pp_fttext]
     -T "abc\ndef" ;
 
+  Filehandle %s opened only for output		[pp_sysread]
+	my $file = "./xcv" ;
+	open(F, ">$file") ; 
+	my $a = sysread(F, $a,10) ;
+  
   
 
 __END__
-# pp_sys.c
+# pp_sys.c [pp_untie]
 use warnings 'untie' ;
 sub TIESCALAR { bless [] } ; 
 $b = tie $a, 'main'; 
@@ -88,7 +93,7 @@ untie $d ;
 EXPECT
 untie attempted while 1 inner references still exist at - line 5.
 ########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
 format STDIN =
 .
@@ -98,7 +103,7 @@ write STDIN;
 EXPECT
 Filehandle main::STDIN opened only for input at - line 5.
 ########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
 use warnings 'closed' ;
 format STDIN =
 .
@@ -109,7 +114,7 @@ write STDIN;
 EXPECT
 Write on closed filehandle main::STDIN at - line 6.
 ########
-# pp_sys.c
+# pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
 format STDOUT_TOP =
 abc
@@ -127,7 +132,7 @@ write ;
 EXPECT
 page overflow at - line 13.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
 use warnings 'unopened' ;
 $a = "abc"; 
 printf $a "fred";
@@ -136,7 +141,7 @@ printf $a "fred";
 EXPECT
 Filehandle main::abc never opened at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
 use warnings 'closed' ;
 close STDIN ;
 printf STDIN "fred";
@@ -145,7 +150,7 @@ printf STDIN "fred";
 EXPECT
 printf on closed filehandle main::STDIN at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf]
 use warnings 'io' ;
 printf STDIN "fred";
 no warnings 'io' ;
@@ -153,7 +158,7 @@ printf STDIN "fred";
 EXPECT
 Filehandle main::STDIN opened only for input at - line 3.
 ########
-# pp_sys.c
+# pp_sys.c [pp_send]
 use warnings 'closed' ;
 close STDIN; 
 syswrite STDIN, "fred", 1;
@@ -162,7 +167,7 @@ syswrite STDIN, "fred", 1;
 EXPECT
 Syswrite on closed filehandle at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
 use warnings 'io' ;
 use Config; 
 BEGIN { 
@@ -216,7 +221,7 @@ shutdown() on closed fd at - line 27.
 get{sock, peer}name() on closed fd at - line 30.
 get{sock, peer}name() on closed fd at - line 31.
 ########
-# pp_sys.c
+# pp_sys.c [pp_stat]
 use warnings 'newline' ;
 stat "abc\ndef";
 no warnings 'newline' ;
@@ -224,7 +229,7 @@ stat "abc\ndef";
 EXPECT
 Unsuccessful stat on filename containing newline at - line 3.
 ########
-# pp_sys.c
+# pp_sys.c [pp_fttext]
 use warnings 'unopened' ;
 close STDIN ; 
 -T STDIN ;
@@ -233,10 +238,22 @@ no warnings 'unopened' ;
 EXPECT
 Test on unopened file <STDIN> at - line 4.
 ########
-# pp_sys.c
+# pp_sys.c [pp_fttext]
 use warnings 'newline' ;
 -T "abc\ndef" ;
 no warnings 'newline' ;
 -T "abc\ndef" ;
 EXPECT
 Unsuccessful open on filename containing newline at - line 3.
+########
+# pp_sys.c [pp_sysread]
+use warnings 'io' ;
+my $file = "./xcv" ;
+open(F, ">$file") ; 
+my $a = sysread(F, $a,10) ;
+no warnings 'io' ;
+my $a = sysread(F, $a,10) ;
+close F ;
+unlink $file ;
+EXPECT
+Filehandle main::F opened only for output at - line 5.
diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp
index 6aa9fa629e..9c3677ee10 100644
--- a/t/pragma/warn/regcomp
+++ b/t/pragma/warn/regcomp
@@ -1,18 +1,25 @@
   regcomp.c	AOK
 
-  %.*s matches null string many times   
+  Strange *+?{} on zero-length expression	[S_study_chunk]
+	/(?=a)?/
 
+  %.*s matches null string many times   	[S_regpiece]
 	$a = "ABC123" ; $a =~ /(?=a)*/'
 
-  Strange *+?{} on zero-length expression
+  /%.127s/: Unrecognized escape \\%c passed through"	[S_regatom] 
+  	/\m/
 
-	/(?=a)?/
+  Character class syntax [. .] is reserved for future extensions [S_regpposixcc]
+
+  Character class syntax [= =] is reserved for future extensions [S_checkposixcc]
+
+  Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] 
+  
 
-  Character class syntax [. .] is reserved for future extensions
-  Character class syntax [= =] is reserved for future extensions
+  
 
 __END__
-# regcomp.c
+# regcomp.c [S_regpiece]
 use warnings 'unsafe' ;
 my $a = "ABC123" ; 
 $a =~ /(?=a)*/ ;
@@ -21,7 +28,7 @@ $a =~ /(?=a)*/ ;
 EXPECT
 (?=a)* matches null string many times at - line 4.
 ########
-# regcomp.c
+# regcomp.c [S_study_chunk]
 use warnings 'unsafe' ;
 $_ = "" ;
 /(?=a)?/;
@@ -30,7 +37,14 @@ no warnings 'unsafe' ;
 EXPECT
 Strange *+?{} on zero-length expression at - line 4.
 ########
-# regcomp.c
+# regcomp.c [S_regatom]
+use warnings 'unsafe' ;
+$a =~ /\m/ ;
+no warnings 'unsafe' ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# regcomp.c [S_regpposixcc S_checkposixcc]
 use warnings 'unsafe' ;
 $_ = "" ;
 /[:alpha:]/;
diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv
index a90e9d351d..bac2c42545 100644
--- a/t/pragma/warn/sv
+++ b/t/pragma/warn/sv
@@ -32,6 +32,8 @@
 
   Undefined value assigned to typeglob
 
+  Reference is already weak			[Perl_sv_rvweaken] <<TODO
+
   Mandatory Warnings
   ------------------
   Malformed UTF-8 character [sv_pos_b2u]
diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke
index 661d3d40b2..182cc1728c 100644
--- a/t/pragma/warn/toke
+++ b/t/pragma/warn/toke
@@ -96,6 +96,31 @@ toke.c	AOK
     \x%.*s will produce malformed UTF-8 character; use \x{%.*s} for that
         use utf8 ; 
 	$_ = "\xffe"
+
+    Unrecognized escape \\%c passed through
+        $a = "\m" ;
+
+    %s number > %s non-portable
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
+
+    Integer overflow in binary number
+        my $a =  0b011111111111111111111111111111110 ;
+        $a =  0b011111111111111111111111111111111 ;
+        $a =  0b111111111111111111111111111111111 ;
+        $a =  0x0fffffffe ;
+        $a =  0x0ffffffff ;
+        $a =  0x1ffffffff ;
+        $a =  0037777777776 ;
+        $a =  0037777777777 ;
+        $a =  0047777777777 ;
      
     Mandatory Warnings
     ------------------
@@ -524,3 +549,63 @@ Operator or semicolon missing before *foo at - line 8.
 Ambiguous use of * resolved as operator * at - line 8.
 Operator or semicolon missing before *foo at - line 10.
 Ambiguous use of * resolved as operator * at - line 10.
+########
+# toke.c
+use warnings 'unsafe' ;
+my $a = "\m" ;
+no warnings 'unsafe' ;
+$a = "\m" ;
+EXPECT
+Unrecognized escape \m passed through at - line 3.
+########
+# toke.c
+use warnings 'portable' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+no warnings 'portable' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+Hexadecimal number > 0xffffffff non-portable at - line 8.
+Octal number > 037777777777 non-portable at - line 11.
+########
+# toke.c
+use warnings 'overflow' ;
+my $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+no warnings 'overflow' ;
+   $a =  0b011111111111111111111111111111110 ;
+   $a =  0b011111111111111111111111111111111 ;
+   $a =  0b111111111111111111111111111111111 ;
+   $a =  0x0fffffffe ;
+   $a =  0x0ffffffff ;
+   $a =  0x1ffffffff ;
+   $a =  0037777777776 ;
+   $a =  0037777777777 ;
+   $a =  0047777777777 ;
+EXPECT
+Integer overflow in binary number at - line 5.
+Integer overflow in hexadecimal number at - line 8.
+Integer overflow in octal number at - line 11.
diff --git a/t/pragma/warn/universal b/t/pragma/warn/universal
index f4f863701c..6dbb1be4e0 100644
--- a/t/pragma/warn/universal
+++ b/t/pragma/warn/universal
@@ -1,11 +1,16 @@
-  universal.c TODO
+  universal.c AOK
 
-  Can't locate package %s for @%s::ISA
+  Can't locate package %s for @%s::ISA	[S_isa_lookup]
+      
 
 
 __END__
-# universal.c
+# universal.c [S_isa_lookup]
 use warnings 'misc' ;
-
+@ISA = qw(Joe) ;
+my $a = bless [] ;
+UNIVERSAL::isa $a, Jim ;
 EXPECT
-
+Can't locate package Joe for @main::ISA at - line 5.
+Can't locate package Joe for @main::ISA.
+Can't locate package Joe for @main::ISA.
diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8
index 30f552a231..b11514d826 100644
--- a/t/pragma/warn/utf8
+++ b/t/pragma/warn/utf8
@@ -15,13 +15,13 @@
      <<<<<< Add a test when somethig actually calls utf16_to_utf8
 
 __END__
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\x80" ;
 EXPECT
 Malformed UTF-8 character at - line 3.
 ########
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\x80" ;
 {
@@ -35,13 +35,13 @@ Malformed UTF-8 character at - line 3.
 \x80 will produce malformed UTF-8 character; use \x{80} for that at - line 6.
 Malformed UTF-8 character at - line 6.
 ########
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\xf080" ;
 EXPECT
 Malformed UTF-8 character at - line 3.
 ########
-# utf8.c
+# utf8.c [utf8_to_uv]
 use utf8 ;
 my $a = ord "\xf080" ;
 {
diff --git a/t/pragma/warn/util b/t/pragma/warn/util
index e9093c4814..6d82d133b8 100644
--- a/t/pragma/warn/util
+++ b/t/pragma/warn/util
@@ -8,28 +8,101 @@
 
      Illegal binary digit ignored
       my $a = oct "0b9" ;
+     
+     Integer overflow in binary number
+	my $a =  oct "0b111111111111111111111111111111111111111111" ;
+     Binary number > 0b11111111111111111111111111111111 non-portable
+   	$a =  oct "0b111111111111111111111111111111111" ;
+     Integer overflow in octal number
+	my $a =  oct "0777777777777777777777777777777777777777777777777" ;
+     Octal number > 037777777777 non-portable
+   	$a =  oct "0047777777777" ;
+     Integer overflow in hexadecimal number
+	my $a =  hex "0xffffffffffffffffffff" ;
+     Hexadecimal number > 0xffffffff non-portable
+   	$a =  hex "0x1ffffffff" ;
 
 __END__
 # util.c
 use warnings 'digit' ;
 my $a = oct "029" ;
 no warnings 'digit' ;
-my $a = oct "029" ;
+$a = oct "029" ;
 EXPECT
 Illegal octal digit '9' ignored at - line 3.
 ########
 # util.c
 use warnings 'digit' ;
-*a =  hex "0xv9" ;
+my $a =  hex "0xv9" ;
 no warnings 'digit' ;
-*a =  hex "0xv9" ;
+$a =  hex "0xv9" ;
 EXPECT
 Illegal hexadecimal digit 'v' ignored at - line 3.
 ########
 # util.c
 use warnings 'digit' ;
-*a =  oct "0b9" ;
+my $a =  oct "0b9" ;
 no warnings 'digit' ;
-*a =  oct "0b9" ;
+$a =  oct "0b9" ;
 EXPECT
 Illegal binary digit '9' ignored at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "0b111111111111111111111111111111111111111111" ;
+no warnings 'overflow' ;
+$a =  oct "0b111111111111111111111111111111111111111111" ;
+EXPECT
+Integer overflow in binary number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  hex "0xffffffffffffffffffff" ;
+no warnings 'overflow' ;
+$a =  hex "0xffffffffffffffffffff" ;
+EXPECT
+Integer overflow in hexadecimal number at - line 3.
+########
+# util.c
+use warnings 'overflow' ;
+my $a =  oct "0777777777777777777777777777777777777777777777777" ;
+no warnings 'overflow' ;
+$a =  oct "0777777777777777777777777777777777777777777777777" ;
+EXPECT
+Integer overflow in octal number at - line 3.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+no warnings 'portable' ;
+   $a =  oct "0b011111111111111111111111111111110" ;
+   $a =  oct "0b011111111111111111111111111111111" ;
+   $a =  oct "0b111111111111111111111111111111111" ;
+EXPECT
+Binary number > 0b11111111111111111111111111111111 non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+no warnings 'portable' ;
+   $a =  hex "0x0fffffffe" ;
+   $a =  hex "0x0ffffffff" ;
+   $a =  hex "0x1ffffffff" ;
+EXPECT
+Hexadecimal number > 0xffffffff non-portable at - line 5.
+########
+# util.c
+use warnings 'portable' ;
+my $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+no warnings 'portable' ;
+   $a =  oct "0037777777776" ;
+   $a =  oct "0037777777777" ;
+   $a =  oct "0047777777777" ;
+EXPECT
+Octal number > 037777777777 non-portable at - line 5.