Integrate with Sarathy.

p4raw-id: //depot/cfgperl@5844

13 files changed, 128 insertions, 19 deletions

diff --git a/lib/Dumpvalue.pm b/lib/Dumpvalue.pm
index 5d3a9dafc2..475f4ff725 100644
--- a/lib/Dumpvalue.pm
+++ b/lib/Dumpvalue.pm
@@ -227,9 +227,9 @@ sub unwrap {
     if ($self->{compactDump} && !grep(ref $_, @{$v})) {
       if ($#$v >= 0) {
 	$short = $sp . "0..$#{$v}  " .
-	  join(" ",
-	       map {$self->stringify($_)} @{$v}[0..$tArrayDepth])
-	    . "$shortmore";
+	  join(" ", 
+	       map {exists $v->[$_] ? $self->stringify($v->[$_]) : "empty"} ($[..$tArrayDepth)
+	      ) . "$shortmore";
       } else {
 	$short = $sp . "empty array";
       }
@@ -238,7 +238,11 @@ sub unwrap {
     for my $num ($[ .. $tArrayDepth) {
       return if $DB::signal and $self->{stopDbSignal};
       print "$sp$num  ";
-      $self->DumpElem($v->[$num], $s);
+      if (exists $v->[$num]) {
+        $self->DumpElem($v->[$num], $s);
+      } else {
+	print "empty slot\n";
+      }
     }
     print "$sp  empty array\n" unless @$v;
     print "$sp$more" if defined $more ;
diff --git a/lib/User/pwent.pm b/lib/User/pwent.pm
index f41aa2ab5a..8c059265c3 100644
--- a/lib/User/pwent.pm
+++ b/lib/User/pwent.pm
@@ -250,7 +250,7 @@ You may ask whether one of these was implemented on the system Perl
 was built on by asking the importable C<pw_has> function about them.
 This function returns true if all parameters are supported fields
 on the build platform, false if one or more were not, and raises
-and exception if you asked about a field that Perl never knows how
+an exception if you asked about a field that Perl never knows how
 to provide.  Parameters may be in a space-separated string, or as
 separate arguments.  If you pass no parameters, the function returns
 the list of C<struct pwd> fields supported by your build platform's
diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl
index 4a3041a02b..51e9c88ea3 100644
--- a/lib/dumpvar.pl
+++ b/lib/dumpvar.pl
@@ -195,8 +195,8 @@ sub unwrap {
 	  if ($#$v >= 0) {
 	    $short = $sp . "0..$#{$v}  " . 
 	      join(" ", 
-		   map {stringify $_} @{$v}[0..$tArrayDepth])
-		. "$shortmore";
+		   map {exists $v->[$_] ? stringify $v->[$_] : "empty"} ($[..$tArrayDepth)
+		  ) . "$shortmore";
 	  } else {
 	    $short = $sp . "empty array";
 	  }
@@ -209,7 +209,11 @@ sub unwrap {
 	for $num ($[ .. $tArrayDepth) {
 	    return if $DB::signal;
 	    print "$sp$num  ";
-	    DumpElem $v->[$num], $s;
+	    if (exists $v->[$num]) {
+	        DumpElem $v->[$num], $s;
+	    } else {
+	    	print "empty slot\n";
+	    }
 	}
 	print "$sp  empty array\n" unless @$v;
 	print "$sp$more" if defined $more ;  
diff --git a/lib/strict.pm b/lib/strict.pm
index f9d60af154..042227f967 100644
--- a/lib/strict.pm
+++ b/lib/strict.pm
@@ -34,6 +34,8 @@ use symbolic references (see L<perlref>).
     print $$ref;	# ok
     $ref = "foo";
     print $$ref;	# runtime error; normally ok
+    $file = "STDOUT";
+    print $file "Hi!";	# error; note: no comma after $file
 
 =item C<strict vars>
 
diff --git a/op.c b/op.c
index 0cdeb92b28..3d5512683b 100644
--- a/op.c
+++ b/op.c
@@ -5520,6 +5520,13 @@ Perl_ck_fun(pTHX_ OP *o)
 				name = GvNAME(gv);
 				len = GvNAMELEN(gv);
 			    }
+			    else if (kid->op_type == OP_AELEM
+				     || kid->op_type == OP_HELEM)
+			    {
+				name = "__ANONIO__";
+				len = 10;
+				mod(kid,type);
+			    }
 			    if (name) {
 				SV *namesv;
 				targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
diff --git a/pod/perldata.pod b/pod/perldata.pod
index 3e10e6f3d4..ac444fa17c 100644
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -750,6 +750,28 @@ C<*HANDLE{IO}> only works if HANDLE has already been used as a handle.
 In other words, C<*FH> must be used to create new symbol table entries;
 C<*foo{THING}> cannot.  When in doubt, use C<*FH>.
 
+All functions that are capable of creating filehandles (open(),
+opendir(), pipe(), socketpair(), sysopen(), socket(), and accept())
+automatically create an anonymous filehandle if the handle passed to
+them is an uninitialized scalar variable. This allows the constructs
+such as C<open(my $fh, ...)> and C<open(local $fh,...)> to be used to
+create filehandles that will conveniently be closed automatically when
+the scope ends, provided there are no other references to them. This
+largely eliminates the need for typeglobs when opening filehandles
+that must be passed around, as in the following example:
+
+    sub myopen {
+        open my $fh, "@_"
+	     or die "Can't open '@_': $!";
+	return $fh;
+    }
+
+    {
+        my $f = myopen("</etc/motd");
+	print <$f>;
+	# $f implicitly closed here
+    }
+
 Another way to create anonymous filehandles is with the Symbol
 module or with the IO::Handle module and its ilk.  These modules
 have the advantage of not hiding different types of the same name
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index f85a819c20..680bcb76e4 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -2686,6 +2686,18 @@ rather mild: Perl itself is not adversely affected by the error, only
 the h2ph utility coming with Perl, and that is rather rarely needed
 these days.
 
+=head2 Arrow operator and arrays
+
+When the left argument to the arrow operator C<< -> >> is an array, or
+the C<scalar> operator operating on an array, the result of the
+operation must be considered erroneous. For example:
+
+    @x->[2]
+    scalar(@x)->[2]
+
+These expressions will get run-time errors in some future release of
+Perl.
+
 =head2 Many features still experimental
 
 As discussed above, many features are still experimental.  Interfaces and
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 2c96d1d310..5396fd1945 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2587,7 +2587,10 @@ conversion assumes base 10.)
 
 Opens the file whose filename is given by EXPR, and associates it with
 FILEHANDLE.  If FILEHANDLE is an expression, its value is used as the
-name of the real filehandle wanted.  If EXPR is omitted, the scalar
+name of the real filehandle wanted.  (This is considered a symbolic
+reference, so C<use strict 'refs'> should I<not> be in effect.)
+
+If EXPR is omitted, the scalar
 variable of the same name as the FILEHANDLE contains the filename.
 (Note that lexical variables--those declared with C<my>--will not work
 for this purpose; so if you're using C<my>, specify EXPR in your call
diff --git a/pp.c b/pp.c
index 30476bd750..a59664e4d1 100644
--- a/pp.c
+++ b/pp.c
@@ -205,7 +205,7 @@ PP(pp_rv2gv)
 		if (SvROK(sv))
 		    goto wasref;
 	    }
-	    if (!SvOK(sv)) {
+	    if (!SvOK(sv) && sv != &PL_sv_undef) {
 		/* If this is a 'my' scalar and flag is set then vivify 
 		 * NI-S 1999/05/07
 		 */ 
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 997c6bf5cc..4559624cca 100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -98,7 +98,7 @@ if ($Config{d_sfio} || $^O eq 'machten' || $^O eq 'beos' || $^O eq 'posix-bc') {
 else {
     local $SIG{PIPE} = 'IGNORE';
     open NIL, '|true'	or die "open failed: $!";
-    sleep 4;
+    sleep 5;
     print NIL 'foo'	or die "print failed: $!";
     if (close NIL) {
 	print "not ok 9\n";
diff --git a/t/lib/charnames.t b/t/lib/charnames.t
index a6fe47f305..7643390126 100644
--- a/t/lib/charnames.t
+++ b/t/lib/charnames.t
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 $| = 1;
-print "1..10\n";
+print "1..12\n";
 
 use charnames ':full';
 
@@ -67,4 +67,8 @@ $encoded_bet = "\327\221";
     print "ok 9\n";
     print "not " unless sprintf("%vx", "\N{WHITE SMILING FACE}") eq "263a";
     print "ok 10\n";
+    print "not " unless sprintf("%vx", "\xFF\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 11\n";
+    print "not " unless sprintf("%vx", "\x{ff}\N{WHITE SMILING FACE}") eq "ff.263a";
+    print "ok 12\n";
 }
diff --git a/toke.c b/toke.c
index cb6751a502..375d91738a 100644
--- a/toke.c
+++ b/toke.c
@@ -1479,8 +1479,14 @@ S_scan_const(pTHX_ char *start)
 		    res = new_constant( Nullch, 0, "charnames", 
 					res, Nullsv, "\\N{...}" );
 		    str = SvPV(res,len);
-		    if (len > 1)
+		    if (!has_utf && SvUTF8(res)) {
+			char *ostart = SvPVX(sv);
+			SvCUR_set(sv, d - ostart);
+			SvPOK_on(sv);
+			sv_utf8_upgrade(sv);
+			d = SvPVX(sv) + SvCUR(sv);
 			has_utf = TRUE;
+		    }
 		    if (len > e - s + 4) {
 			char *odest = SvPVX(sv);
 
diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index f6280d25b8..f6d3dc0bc0 100644
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -91,7 +91,7 @@ BEGIN {
     $::HaveUtil = ($@ eq "");
 };
 
-my $Version = "1.27";
+my $Version = "1.28";
 
 # Changed in 1.06 to skip Mail::Send and Mail::Util if not available.
 # Changed in 1.07 to see more sendmail execs, and added pipe output.
@@ -123,6 +123,7 @@ my $Version = "1.27";
 # Changed in 1.25 Warn on failure to open save file. HVDS 98-07-12
 # Changed in 1.26 Don't require -t STDIN for -ok. HVDS 98-07-15
 # Changed in 1.27 Added Mac OS and File::Spec support CNANDOR 99-07-27
+# Changed in 1.28 Additional questions for Perlbugtron RFOLEY 20.03.2000
 
 # TODO: - Allow the user to re-name the file on mail failure, and
 #       make sure failure (transmission-wise) of Mail::Send is
@@ -130,7 +131,7 @@ my $Version = "1.27";
 #       - Test -b option
 
 my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename,
-    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS,
+    $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity, 
     $fh, $me, $Is_MSWin32, $Is_VMS, $msg, $body, $andcc, %REP, $ok);
 
 my $perl_version = $^V ? sprintf("v%vd", $^V) : $];
@@ -157,6 +158,33 @@ Send();
 
 exit;
 
+sub ask_for_alternatives {
+    my $name = shift;
+    my $default = shift;
+    my @alts = @_;
+    my $alt = "";
+    paraprint <<EOF;
+Please pick a \u$name from the following:
+
+    @alts
+
+EOF
+    my $err = 0;
+    my $joined_alts = join('|', @alts);
+    do {
+	if ($err++ > 5) {
+	    die "Invalid $name: aborting.\n";
+	}
+	print "Please enter a \u$name [$default]: ";
+	$alt = <>;
+	chomp $alt;
+	if ($alt =~ /^\s*$/) {
+	    $alt = $default;
+	}
+    } while ($alt !~ /^($joined_alts)$/i);
+    lc $alt;
+}
+
 sub Init {
     # -------- Setup --------
 
@@ -437,6 +465,16 @@ EOF
 	}
     }
 
+    # Prompt for category of bug
+    $category ||= ask_for_alternatives("category", "core",
+				     qw(core docs install
+					library utilities));
+
+    # Prompt for severity of bug
+    $severity ||= ask_for_alternatives("severity", "low",
+				       qw(critical high medium
+					  low wishlist none));
+
     # Generate scratch file to edit report in
     $filename = filename();
 
@@ -516,8 +554,14 @@ EOF
 sub Dump {
     local(*OUT) = @_;
 
-    print REP "\n---\n";
-    print REP "This perlbug was built using Perl $config_tag1\n",
+    print OUT <<EFF;
+---
+Flags:
+    category=$category
+    severity=$severity
+---
+EFF
+    print OUT "This perlbug was built using Perl $config_tag1\n",
 	    "It is being executed now by  Perl $config_tag2.\n\n"
 	if $config_tag2 ne $config_tag1;
 
@@ -1130,8 +1174,9 @@ by Gurusamy Sarathy (E<lt>gsar@activestate.comE<gt>), Tom Christiansen
 Charles F. Randall (E<lt>cfr@pobox.comE<gt>), Mike Guy
 (E<lt>mjtg@cam.a.ukE<gt>), Dominic Dunlop (E<lt>domo@computer.orgE<gt>),
 Hugo van der Sanden (E<lt>hv@crypt0.demon.co.ukE<gt>),
-Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), hris Nandor
-(E<lt>pudge@pobox.comE<gt>), and Jon Orwant (E<lt>orwant@media.mit.eduE<gt>).
+Jarkko Hietaniemi (E<lt>jhi@iki.fiE<gt>), Chris Nandor
+(E<lt>pudge@pobox.comE<gt>), Jon Orwant (E<lt>orwant@media.mit.eduE<gt>,
+and Richard Foley (E<lt>richard@rfi.netE<gt>).
 
 =head1 SEE ALSO