Integrate mainline

p4raw-id: //depot/perlio@8071

14 files changed, 231 insertions, 13 deletions

diff --git a/t/TEST b/t/TEST
index ef3d312a46..cfee26c00d 100755
--- a/t/TEST
+++ b/t/TEST
@@ -114,6 +114,9 @@ EOT
 		    $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
 		    if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
 			$next = $next + 1;
+                    }
+                    elsif (/^Bail out!\s*(.*)/i) { # magic words
+                        die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
 		    }
 		    else {
 			$ok = 0;
diff --git a/t/UTEST b/t/UTEST
index 9c1dfc0d80..1be1a5bbef 100755
--- a/t/UTEST
+++ b/t/UTEST
@@ -127,6 +127,9 @@ EOT
 		    $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
 		    if (/^ok (\d+)(\s*#.*)?$/ && $1 == $next) {
 			$next = $next + 1;
+                    }
+                    elsif (/^Bail out!\s*(.*)/i) { # magic words
+                        die "FAILED--Further testing stopped" . ($1 ? ": $1\n" : ".\n");
 		    }
 		    else {
 			$ok = 0;
diff --git a/t/base/commonsense.t b/t/base/commonsense.t
new file mode 100644
index 0000000000..155c5345b6
--- /dev/null
+++ b/t/base/commonsense.t
@@ -0,0 +1,24 @@
+#!./perl
+
+chdir 't' if -d 't';
+@INC = '../lib';
+require Config; import Config;
+if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){
+  print "Bail out! Perl configured without DB_File or [A-Z]DBM_File\n";
+  exit 0;
+}
+if (($Config{'extensions'} !~ /\bFcntl\b/) ){
+  print "Bail out! Perl configured without Fcntl module\n";
+  exit 0;
+}
+if (($Config{'extensions'} !~ /\bIO\b/) ){
+  print "Bail out! Perl configured without IO module\n";
+  exit 0;
+}
+if (($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
+  print "Bail out! Perl configured without File::Glob module\n";
+  exit 0;
+}
+
+print "1..1\nok 1\n";
+
diff --git a/t/comp/proto.t b/t/comp/proto.t
index 4c5b5eee83..845843ad64 100755
--- a/t/comp/proto.t
+++ b/t/comp/proto.t
@@ -19,7 +19,7 @@ BEGIN {
 
 use strict;
 
-print "1..122\n";
+print "1..123\n";
 
 my $i = 1;
 
@@ -498,3 +498,7 @@ for my $p ( "", qw{ () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@) } ) {
   print "# eval[$eval]\nnot " unless $@ && $@ =~ /syntax error/;
   print "ok ", $i++, "\n";
 }
+
+# Not $$;$;$
+print "not " unless prototype "CORE::substr" eq '$$;$$';
+print "ok ", $i++, "\n";
diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t
index 75c661bbee..11e86afc1d 100755
--- a/t/lib/db-btree.t
+++ b/t/lib/db-btree.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..155\n";
+print "1..156\n";
 
 sub ok
 {
@@ -1217,4 +1217,26 @@ EOM
 #   unlink $Dfile;
 #}
 
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie %h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_BTREE 
+	or die "Can't open file: $!\n" ;
+    $h{ABC} = undef;
+    ok(156, $a eq "") ;
+    untie %h ;
+    unlink $Dfile;
+}
+
 exit ;
diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t
index b7018742e4..462796926c 100755
--- a/t/lib/db-hash.t
+++ b/t/lib/db-hash.t
@@ -12,7 +12,7 @@ BEGIN {
 use DB_File; 
 use Fcntl;
 
-print "1..109\n";
+print "1..110\n";
 
 sub ok
 {
@@ -682,4 +682,25 @@ EOM
    
 }
 
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie %h, 'DB_File', $Dfile or die "Can't open file: $!\n" ;
+    $h{ABC} = undef;
+    ok(110, $a eq "") ;
+    untie %h;
+    unlink $Dfile;
+}
+
 exit ;
diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t
index 18fb45b114..f932a8938c 100755
--- a/t/lib/db-recno.t
+++ b/t/lib/db-recno.t
@@ -99,7 +99,7 @@ sub bad_one
 EOM
 }
 
-print "1..126\n";
+print "1..127\n";
 
 my $Dfile = "recno.tmp";
 unlink $Dfile ;
@@ -836,4 +836,26 @@ EOM
    
 }
 
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use DB_File ;
+
+    unlink $Dfile;
+    my @h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    tie @h, 'DB_File', $Dfile,  O_RDWR|O_CREAT, 0664, $DB_RECNO 
+	or die "Can't open file: $!\n" ;
+    $h[0] = undef;
+    ok(127, $a eq "") ;
+    untie @h;
+    unlink $Dfile;
+}
+
 exit ;
diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t
index 54f59946b7..af83fdda81 100755
--- a/t/lib/gdbm.t
+++ b/t/lib/gdbm.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use GDBM_File;
 
-print "1..66\n";
+print "1..68\n";
 
 unlink <Op.dbmx*>;
 
@@ -178,6 +178,7 @@ EOM
     close FILE ;
 
     BEGIN { push @INC, '.'; }
+    unlink <dbhash.tmp*> ;
 
     eval 'use SubDB ; ';
     main::ok(13, $@ eq "") ;
@@ -392,3 +393,24 @@ EOM
    untie %h;
    unlink <Op.dbmx*>;
 }
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use GDBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(67, tie(%h, 'GDBM_File','Op.dbmx', &GDBM_WRCREAT, 0640));
+    $h{ABC} = undef;
+    ok(68, $a eq "") ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}
diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t
index 4937a8ce31..a8344444c8 100755
--- a/t/lib/ndbm.t
+++ b/t/lib/ndbm.t
@@ -16,7 +16,7 @@ require NDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..64\n";
+print "1..65\n";
 
 unlink <Op.dbmx*>;
 
@@ -391,3 +391,20 @@ EOM
    untie %h;
    unlink <Op.dbmx*>;
 }
+
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use NDBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(65, tie(%h, 'NDBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+}
diff --git a/t/lib/net-hostent.t b/t/lib/net-hostent.t
index b1c7a9db66..abc5b9292f 100644
--- a/t/lib/net-hostent.t
+++ b/t/lib/net-hostent.t
@@ -44,9 +44,29 @@ print "ok 5\n";
 if ($^O eq 'MSWin32' or $^O eq 'cygwin') {
   print "ok $_ # skipped on win32\n" for (6,7);
 } else {
-  print "not " unless $h->name =~ /^localhost(?:\..+)?$/i;
-  print "ok 6 # ",$h->name,"\n";
+  my $in_alias;
+  unless ($h->name =~ /^localhost(?:\..+)?$/i) {
+    foreach (@{$h->aliases}) {
+      if (/^localhost(?:\..+)?$/i) {
+       $in_alias = 1;
+       last;
+      }
+    }
+    print "not " unless $in_alias;
+  } # Else we found it as the hostname
+  print "ok 6 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
 
-  print "not " unless $i->name =~ /^localhost(?:\..+)?$/i;
-  print "ok 7 # ",$i->name,"\n";
+  if ($in_alias) {
+    # If we found it in the aliases before, expect to find it there again.
+    foreach (@{$h->aliases}) {
+      if (/^localhost(?:\..+)?$/i) {
+       undef $in_alias; # This time, clear the flag if we see "localhost"
+       last;
+      }
+    }
+    print "not " if $in_alias;
+  } else {
+    print "not " unless $i->name =~ /^localhost(?:\..+)?$/i;
+  }
+  print "ok 7 # ",$h->name, " ", join (",", @{$h->aliases}), "\n";
 }
diff --git a/t/lib/odbm.t b/t/lib/odbm.t
index ccd3e60319..f2c1bb6d32 100755
--- a/t/lib/odbm.t
+++ b/t/lib/odbm.t
@@ -16,7 +16,7 @@ require ODBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..64\n";
+print "1..66\n";
 
 unlink <Op.dbmx*>;
 
@@ -394,6 +394,27 @@ EOM
    unlink <Op.dbmx*>;
 }
 
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use ODBM_File ;
+
+    unlink <Op.dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(65, tie(%h, 'ODBM_File','Op.dbmx', O_RDWR|O_CREAT, 0640)) ;
+    $h{ABC} = undef;
+    ok(66, $a eq "") ;
+    untie %h;
+    unlink <Op.dbmx*>;
+}
+
 if ($^O eq 'hpux') {
     print <<EOM;
 #
diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t
index b6a1a69de0..d60447e960 100755
--- a/t/lib/sdbm.t
+++ b/t/lib/sdbm.t
@@ -15,7 +15,7 @@ require SDBM_File;
 #If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT
 use Fcntl;
 
-print "1..66\n";
+print "1..68\n";
 
 unlink <Op_dbmx.*>;
 
@@ -396,3 +396,24 @@ unlink <Op_dbmx*>, $Dfile;
    unlink <Op_dbmx*>;
 }
 
+{
+    # Bug ID 20001013.009
+    #
+    # test that $hash{KEY} = undef doesn't produce the warning
+    #     Use of uninitialized value in null operation 
+    use warnings ;
+    use strict ;
+    use SDBM_File ;
+
+    unlink <Op_dbmx*>;
+    my %h ;
+    my $a = "";
+    local $SIG{__WARN__} = sub {$a = $_[0]} ;
+    
+    ok(67, tie(%h, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640)) ;
+    $h{ABC} = undef;
+    ok(68, $a eq "") ;
+
+    untie %h;
+    unlink <Op_dbmx*>;
+}
diff --git a/t/op/each.t b/t/op/each.t
index 4a00a1e2c5..35792ab9c3 100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..20\n";
+print "1..24\n";
 
 $h{'abc'} = 'ABC';
 $h{'def'} = 'DEF';
@@ -143,3 +143,16 @@ foreach (keys %u) {
     }
 }
 print "ok 20\n";
+
+$a = "\xe3\x81\x82"; $A = "\x{3042}";
+%b = ( $a => "non-utf8");
+%u = ( $A => "utf8");
+
+print "not " if exists $b{$A};
+print "ok 21\n";
+print "not " if exists $u{$a};
+print "ok 22\n";
+print "#$b{$_}\n" for keys %b; # Used to core dump before change #8056.
+print "ok 23\n";
+print "#$u{$_}\n" for keys %u; # Used to core dump before change #8056.
+print "ok 24\n";
diff --git a/t/op/misc.t b/t/op/misc.t
index aea14c85b5..0db36c9d85 100755
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -595,3 +595,8 @@ for (@locales) {
     print "$_ $s\n";
 }
 EXPECT
+########
+die qr(x)
+EXPECT
+(?-xism:x) at - line 1.
+########