Integrate mainline

p4raw-id: //depot/perlio@8266

19 files changed, 435 insertions, 206 deletions

diff --git a/MANIFEST b/MANIFEST
index 1bf4b4a6ab..7445fd785d 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -719,6 +719,7 @@ lib/Pod/Plainer.pm	Pod migration utility module
 lib/Pod/Select.pm	Pod-Parser - select portions of POD docs
 lib/Pod/Text.pm		Pod-Parser - convert POD data to formatted ASCII text
 lib/Pod/Text/Color.pm	Convert POD data to color ASCII text
+lib/Pod/Text/Overstrike.pm	Convert POD data to formatted overstrike text
 lib/Pod/Text/Termcap.pm	Convert POD data to ASCII text with format escapes
 lib/Pod/Usage.pm	Pod-Parser - print usage messages
 lib/Search/Dict.pm	Perform binary search on dictionaries
diff --git a/doio.c b/doio.c
index 1ac381b896..94a4329e1e 100644
--- a/doio.c
+++ b/doio.c
@@ -476,6 +476,15 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	    SV *sv;
 
 	    PerlLIO_dup2(PerlIO_fileno(fp), fd);
+#ifdef VMS
+	    if (fd != PerlIO_fileno(PerlIO_stdin())) {
+	      char newname[FILENAME_MAX+1];
+	      if (fgetname(fp, newname)) {
+	        if (fd == PerlIO_fileno(PerlIO_stdout())) Perl_vmssetuserlnm("SYS$OUTPUT", newname);
+	        if (fd == PerlIO_fileno(PerlIO_stderr())) Perl_vmssetuserlnm("SYS$ERROR",  newname);
+	      }
+	    }
+#endif
 	    LOCK_FDPID_MUTEX;
 	    sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
 	    (void)SvUPGRADE(sv, SVt_IV);
diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh
index 07b80ea920..ce3a40c77d 100644
--- a/hints/dec_osf.sh
+++ b/hints/dec_osf.sh
@@ -70,12 +70,13 @@ case "`$cc -v 2>&1 | grep cc`" in
 	if test "$1" -lt 2 -o \( "$1" -eq 2 -a \( "$2" -lt 95 -o \( "$2" -eq 95 -a "$3" -lt 2 \) \) \); then
 	    cat >&4 <<EOF
 
-*** Your cc seems to be gcc and its version seems to be less than 2.95.2.
-*** This is not a good idea since old versions of gcc are known to produce
-*** buggy code when compiling Perl (and no doubt for other programs, too).
+*** Your cc seems to be gcc and its version ($_gcc_version) seems to be
+*** less than 2.95.2.  This is not a good idea since old versions of gcc
+*** are known to produce buggy code when compiling Perl (and no doubt for
+*** other programs, too).
 ***
-*** Therefore, I strongly suggest upgrading your gcc.  (Why don't you
-*** use the vendor cc is also a good question.  It comes with the operating
+*** Therefore, I strongly suggest upgrading your gcc.  (Why don't you use
+*** the vendor cc is also a good question.  It comes with the operating
 *** system and produces good code.)
 
 Cannot continue, aborting.
@@ -88,10 +89,10 @@ EOF
 
 *** Note that as of gcc 2.95.2 (19991024) and Perl 5.6.0 (March 2000)
 *** if the said Perl is compiled with the said gcc the lib/sdbm test
-*** dumps core (meaning  that the SDBM_File is unusable).  As this core
-*** dump doesn't happen with the vendor cc, this is most probably
-*** a lingering bug in gcc.  Therefore unless you have a better gcc
-*** you are still better off using the vendor cc.
+*** may dump core (meaning that the SDBM_File extension is unusable).
+*** As this core dump never happens with the vendor cc, this is most
+*** probably a lingering bug in gcc.  Therefore unless you have a better
+*** gcc installation you are still better off using the vendor cc.
 
 Since you explicitly chose gcc, I assume that you know what are doing.
 
diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm
index 3b961560ad..84c8f6671b 100644
--- a/lib/Pod/Man.pm
+++ b/lib/Pod/Man.pm
@@ -1,5 +1,5 @@
 # Pod::Man -- Convert POD data to formatted *roff input.
-# $Id: Man.pm,v 1.10 2000/11/19 05:46:19 eagle Exp $
+# $Id: Man.pm,v 1.12 2000/12/25 12:56:12 eagle Exp $
 #
 # Copyright 1999, 2000 by Russ Allbery <rra@stanford.edu>
 #
@@ -38,7 +38,7 @@ use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION);
 # Perl core and too many things could munge CVS magic revision strings.
 # This number should ideally be the same as the CVS revision in podlators,
 # however.
-$VERSION = 1.10;
+$VERSION = 1.12;
 
 
 ############################################################################
@@ -1063,7 +1063,7 @@ sub output { print { $_[0]->output_handle } $_[1] }
 # If there are double quotes, use an if statement to test for nroff, and for
 # nroff output the command followed by the argument in double quotes with
 # embedded double quotes doubled.  For other formatters, remap paired double
-# quotes to `` and ''.
+# quotes to LQUOTE and RQUOTE.
 sub switchquotes {
     my $self = shift;
     my $command = shift;
@@ -1073,17 +1073,19 @@ sub switchquotes {
 
     # We also have to deal with \*C` and \*C', which are used to add the
     # quotes around C<> text, since they may expand to " and if they do this
-    # confuses the .SH macros and the like no end.
+    # confuses the .SH macros and the like no end.  Expand them ourselves.
+    # If $extra is set, we're dealing with =item, which in most nroff macro
+    # sets requires an extra level of quoting of double quotes.
     my $c_is_quote = ($$self{LQUOTE} =~ /\"/) || ($$self{RQUOTE} =~ /\"/);
     if (/\"/ || ($c_is_quote && /\\\*\(C[\'\`]/)) {
         s/\"/\"\"/g;
         my $troff = $_;
         $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g;
-        s/\"/\"\"/g if $extra;
-        $troff =~ s/\"/\"\"/g if $extra;
         s/\\\*\(C\`/$$self{LQUOTE}/g;
         s/\\\*\(C\'/$$self{RQUOTE}/g;
         $troff =~ s/\\\*\(C[\'\`]//g;
+        s/\"/\"\"/g if $extra;
+        $troff =~ s/\"/\"\"/g if $extra;
         $_ = qq("$_") . ($extra ? " $extra" : '');
         $troff = qq("$troff") . ($extra ? " $extra" : '');
         return ".if n $command $_\n.el $command $troff\n";
diff --git a/lib/Pod/Text/Color.pm b/lib/Pod/Text/Color.pm
index 10e1d9fa30..e943216d88 100644
--- a/lib/Pod/Text/Color.pm
+++ b/lib/Pod/Text/Color.pm
@@ -1,5 +1,5 @@
 # Pod::Text::Color -- Convert POD data to formatted color ASCII text
-# $Id: Color.pm,v 0.5 1999/09/20 10:15:16 eagle Exp $
+# $Id: Color.pm,v 0.6 2000/12/25 12:52:39 eagle Exp $
 #
 # Copyright 1999 by Russ Allbery <rra@stanford.edu>
 #
@@ -26,8 +26,11 @@ use vars qw(@ISA $VERSION);
 
 @ISA = qw(Pod::Text);
 
-# Use the CVS revision of this file as its version number.
-($VERSION = (split (' ', q$Revision: 0.5 $ ))[1]) =~ s/\.(\d)$/.0$1/;
+# Don't use the CVS revision as the version, since this module is also in
+# Perl core and too many things could munge CVS magic revision strings.
+# This number should ideally be the same as the CVS revision in podlators,
+# however.
+$VERSION = 0.06;
 
 
 ############################################################################
diff --git a/lib/Pod/Text/Overstrike.pm b/lib/Pod/Text/Overstrike.pm
new file mode 100644
index 0000000000..c9f0789d06
--- /dev/null
+++ b/lib/Pod/Text/Overstrike.pm
@@ -0,0 +1,160 @@
+# Pod::Text::Overstrike -- Convert POD data to formatted overstrike text
+# $Id: Overstrike.pm,v 1.1 2000/12/25 12:51:23 eagle Exp $
+#
+# Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000
+#   (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>)
+#
+# This program is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# This was written because the output from:
+#
+#     pod2text Text.pm > plain.txt; less plain.txt
+#
+# is not as rich as the output from
+#
+#     pod2man Text.pm | nroff -man > fancy.txt; less fancy.txt
+#
+# and because both Pod::Text::Color and Pod::Text::Termcap are not device
+# independent.
+
+############################################################################
+# Modules and declarations
+############################################################################
+
+package Pod::Text::Overstrike;
+
+require 5.004;
+
+use Pod::Text ();
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+@ISA = qw(Pod::Text);
+
+# Don't use the CVS revision as the version, since this module is also in
+# Perl core and too many things could munge CVS magic revision strings.
+# This number should ideally be the same as the CVS revision in podlators,
+# however.
+$VERSION = 1.01;
+
+
+############################################################################
+# Overrides
+############################################################################
+
+# Make level one headings bold, overridding any existing formatting.
+sub cmd_head1 {
+    my $self = shift;
+    local $_ = shift;
+    s/\s+$//;
+    s/(.)\cH\1//g;
+    s/_\cH//g;
+    s/(.)/$1\b$1/g;
+    $self->SUPER::cmd_head1 ($_);
+}
+
+# Make level two headings bold, overriding any existing formatting.
+sub cmd_head2 {
+    my $self = shift;
+    local $_ = shift;
+    s/\s+$//;
+    s/(.)\cH\1//g;
+    s/_\cH//g;
+    s/(.)/$1\b$1/g;
+    $self->SUPER::cmd_head2 ($_);
+}
+
+# Make level three headings underscored, overriding any existing formatting.
+sub cmd_head3 {
+    my $self = shift;
+    local $_ = shift;
+    s/\s+$//;
+    s/(.)\cH\1//g;
+    s/_\cH//g;
+    s/(.)/_\b$1/g;
+    $self->SUPER::cmd_head3 ($_);
+}
+
+# Fix the various interior sequences.
+sub seq_b { local $_ = $_[1]; s/(.)\cH\1//g; s/_\cH//g; s/(.)/$1\b$1/g; $_ }
+sub seq_f { local $_ = $_[1]; s/(.)\cH\1//g; s/_\cH//g; s/(.)/_\b$1/g; $_ }
+sub seq_i { local $_ = $_[1]; s/(.)\cH\1//g; s/_\cH//g; s/(.)/_\b$1/g; $_ }
+
+# We unfortunately have to override the wrapping code here, since the normal
+# wrapping code gets really confused by all the escape sequences.
+sub wrap {
+    my $self = shift;
+    local $_ = shift;
+    my $output = '';
+    my $spaces = ' ' x $$self{MARGIN};
+    my $width = $$self{width} - $$self{MARGIN};
+    while (length > $width) {
+        if (s/^((?:(?:[^\n]\cH)?[^\n]){0,$width})\s+//
+            || s/^((?:(?:[^\n]\cH)?[^\n]){$width})//) {
+            $output .= $spaces . $1 . "\n";
+        } else {
+            last;
+        }
+    }
+    $output .= $spaces . $_;
+    $output =~ s/\s+$/\n\n/;
+    $output;
+}
+
+############################################################################
+# Module return value and documentation
+############################################################################
+
+1;
+__END__
+
+=head1 NAME
+
+Pod::Text::Overstrike - Convert POD data to formatted overstrike text
+
+=head1 SYNOPSIS
+
+    use Pod::Text::Overstrike;
+    my $parser = Pod::Text::Overstrike->new (sentence => 0, width => 78);
+
+    # Read POD from STDIN and write to STDOUT.
+    $parser->parse_from_filehandle;
+
+    # Read POD from file.pod and write to file.txt.
+    $parser->parse_from_file ('file.pod', 'file.txt');
+
+=head1 DESCRIPTION
+
+Pod::Text::Overstrike is a simple subclass of Pod::Text that highlights
+output text using overstrike sequences, in a manner similar to nroff.
+Characters in bold text are overstruck (character, backspace, character) and
+characters in underlined text are converted to overstruck underscores
+(underscore, backspace, character).  This format was originally designed for
+hardcopy terminals and/or lineprinters, yet is readable on softcopy (CRT)
+terminals.
+
+Overstruck text is best viewed by page-at-a-time programs that take
+advantage of the terminal's B<stand-out> and I<underline> capabilities, such
+as the less program on Unix.
+
+Apart from the overstrike, it in all ways functions like Pod::Text.  See
+L<Pod::Text> for details and available options.
+
+=head1 BUGS
+
+Currently, the outermost formatting instruction wins, so for example
+underlined text inside a region of bold text is displayed as simply bold.
+There may be some better approach possible.
+
+=head1 SEE ALSO
+
+L<Pod::Text|Pod::Text>, L<Pod::Parser|Pod::Parser>
+
+=head1 AUTHOR
+
+Joe Smith E<lt>Joe.Smith@inwap.comE<gt>, using the framework created by Russ
+Allbery E<lt>rra@stanford.eduE<gt>.
+
+=cut
diff --git a/lib/Pod/Text/Termcap.pm b/lib/Pod/Text/Termcap.pm
index 7e89ec61be..333852a425 100644
--- a/lib/Pod/Text/Termcap.pm
+++ b/lib/Pod/Text/Termcap.pm
@@ -1,5 +1,5 @@
 # Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes.
-# $Id: Termcap.pm,v 0.4 1999/09/20 10:17:45 eagle Exp $
+# $Id: Termcap.pm,v 1.0 2000/12/25 12:52:48 eagle Exp $
 #
 # Copyright 1999 by Russ Allbery <rra@stanford.edu>
 #
@@ -27,8 +27,11 @@ use vars qw(@ISA $VERSION);
 
 @ISA = qw(Pod::Text);
 
-# Use the CVS revision of this file as its version number.
-($VERSION = (split (' ', q$Revision: 0.4 $ ))[1]) =~ s/\.(\d)$/.0$1/;
+# Don't use the CVS revision as the version, since this module is also in
+# Perl core and too many things could munge CVS magic revision strings.
+# This number should ideally be the same as the CVS revision in podlators,
+# however.
+$VERSION = 1.00;
 
 
 ############################################################################
diff --git a/op.c b/op.c
index 215b85ca7e..28e7e98606 100644
--- a/op.c
+++ b/op.c
@@ -1336,6 +1336,31 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	PL_modcount++;
 	return o;
     case OP_CONST:
+        if (o->op_private & (OPpCONST_BARE) && 
+                !(type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)) {
+            SV *sv = ((SVOP*)o)->op_sv;
+            GV *gv;
+
+            /* Could be a filehandle */
+            if (gv = gv_fetchpv(SvPV_nolen(sv), FALSE, SVt_PVIO)) {
+                OP* gvio = newUNOP(OP_RV2GV, 0, newGVOP(OP_GV, 0, gv));
+                op_free(o);
+                o = gvio;
+            } else {
+                /* OK, it's a sub */
+                OP* enter;
+                gv = gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVCV);
+
+                enter = newUNOP(OP_ENTERSUB,0, 
+                        newUNOP(OP_RV2CV, 0, 
+                            newGVOP(OP_GV, 0, gv)
+                        ));
+                enter->op_private |= OPpLVAL_INTRO;
+                op_free(o);
+                o = enter;
+            }
+            break;
+        }
 	if (!(o->op_private & (OPpCONST_ARYBASE)))
 	    goto nomod;
 	if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
diff --git a/pod/pod2text.PL b/pod/pod2text.PL
index b4965cb00f..7b5727decc 100644
--- a/pod/pod2text.PL
+++ b/pod/pod2text.PL
@@ -75,8 +75,8 @@ my %options;
 $options{sentence} = 0;
 Getopt::Long::config ('bundling');
 GetOptions (\%options, 'alt|a', 'color|c', 'help|h', 'indent|i=i',
-            'loose|l', 'quotes|q=s', 'sentence|s', 'termcap|t',
-            'width|w=i') or exit 1;
+            'loose|l', 'overstrike|o', 'quotes|q=s', 'sentence|s',
+            'termcap|t', 'width|w=i') or exit 1;
 pod2usage (1) if $options{help};
 
 # Figure out what formatter we're going to use.  -c overrides -t.
@@ -89,8 +89,11 @@ if ($options{color}) {
 } elsif ($options{termcap}) {
     $formatter = 'Pod::Text::Termcap';
     require Pod::Text::Termcap;
+} elsif ($options{overstrike}) {
+    $formatter = 'Pod::Text::Overstrike';
+    require Pod::Text::Overstrike;
 }
-delete @options{'color', 'termcap'};
+delete @options{'color', 'termcap', 'overstrike'};
 
 # Initialize and run the formatter.
 my $parser = $formatter->new (%options);
@@ -104,7 +107,7 @@ pod2text - Convert POD data to formatted ASCII text
 
 =head1 SYNOPSIS
 
-pod2text [B<-aclst>] [B<-i> I<indent>] [B<-q> I<quotes>] [B<-w> I<width>]
+pod2text [B<-aclost>] [B<-i> I<indent>] [B<-q> I<quotes>] [B<-w> I<width>]
 [I<input> [I<output>]]
 
 pod2text B<-h>
@@ -150,6 +153,13 @@ printed after C<=head1>, although one is still printed after C<=head2>,
 because this is the expected formatting for manual pages; if you're
 formatting arbitrary text documents, using this option is recommended.
 
+=item B<-o>, B<--overstrike>
+
+Format the output with overstruck printing.  Bold text is rendered as
+character, backspace, character.  Italics and file names are rendered as
+underscore, backspace, character.  Many pagers, such as B<less>, know how
+to convert this to bold or underlined text.
+
 =item B<-q> I<quotes>, B<--quotes>=I<quotes>
 
 Sets the quote marks used to surround CE<lt>> text to I<quotes>.  If
diff --git a/sv.c b/sv.c
index b43c0660bd..662b9747c7 100644
--- a/sv.c
+++ b/sv.c
@@ -2934,7 +2934,7 @@ Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
     char *s, *t, *e;
     int  hibit = 0;
 
-    if (!sv || !SvPOK(sv) || !SvCUR(sv) || SvUTF8(sv))
+    if (!sv || !SvPOK(sv) || SvUTF8(sv))
 	return;
 
     /* This function could be much more efficient if we had a FLAG in SVs
@@ -3748,66 +3748,41 @@ Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRL
 /*
 =for apidoc sv_catsv
 
-Concatenates the string from SV C<ssv> onto the end of the string in SV
-C<dsv>.  Handles 'get' magic, but not 'set' magic.  See C<sv_catsv_mg>.
+Concatenates the string from SV C<ssv> onto the end of the string in
+SV C<dsv>.  Modifies C<dsv> but not C<ssv>.  Handles 'get' magic, but
+not 'set' magic.  See C<sv_catsv_mg>.
 
-=cut
-*/
+=cut */
 
 void
-Perl_sv_catsv(pTHX_ SV *dsv, register SV *ssv)
+Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
 {
-    if (!ssv)
+    char *spv;
+    STRLEN slen;
+    if (!sstr)
 	return;
-    else {
-	STRLEN slen;
-	char *spv;
+    if ((spv = SvPV(sstr, slen))) {
+	bool dutf8 = DO_UTF8(dstr);
+	bool sutf8 = DO_UTF8(sstr);
 
-	if ((spv = SvPV(ssv, slen))) {
-	    bool dutf8 = DO_UTF8(dsv);
-	    bool sutf8 = DO_UTF8(ssv);
-	    
-	    if (dutf8 != sutf8) {
-		STRLEN dlen;
-		char *dpv;
-		char *d;
-
-		/* We may modify dsv but not ssv. */
-
-		if (!dutf8)
-		    sv_utf8_upgrade(dsv);
-		dpv = SvPV(dsv, dlen);
-		/* Overguestimate on the slen. */
-		/* (Why +2 and not +1 is needed?
-		 * (Try PERL_DESTRUCT_LEVEL=2 ./perl t/op/join.t)
-		 * Can't figure out right now. --jhi) */
-		SvGROW(dsv, dlen + (sutf8 ? 2 * slen : slen) + 2);
-		d = dpv + dlen;
-		if (dutf8) /* && !sutf8 */ {
-		    char *s = spv;
-		    char *send = s + slen;
-
-		    while (s < send) {
-			U8 c = *s++;
-
-			if (UTF8_IS_ASCII(c))
-			    *d++ = c;
-			else {
-			    *d++ = UTF8_EIGHT_BIT_HI(c);
-			    *d++ = UTF8_EIGHT_BIT_LO(c);
-			    s++; /* skip the low byte */
-			}
-		    }
-		    SvCUR(dsv) += s - spv;
-		    *d = 0;
-		}
-		else /* !dutf8 (was) && sutf8 */ {
-		    sv_catpvn(dsv, spv, slen);
-		    SvUTF8_on(dsv);
-		}
+	if (dutf8 == sutf8)
+	    sv_catpvn(dstr,spv,slen);
+	else {
+	    if (dutf8) {
+		SV* cstr = newSVsv(sstr);
+		char *cpv;
+		STRLEN clen;
+
+		sv_utf8_upgrade(cstr);
+		cpv = SvPV(cstr,clen);
+		sv_catpvn(dstr,cpv,clen);
+		sv_2mortal(cstr);
+	    }
+	    else {
+		sv_utf8_upgrade(dstr);
+		sv_catpvn(dstr,spv,slen);
+		SvUTF8_on(dstr);
 	    }
-	    else
-		sv_catpvn(dsv, spv, slen);
 	}
     }
 }
@@ -3821,10 +3796,10 @@ Like C<sv_catsv>, but also handles 'set' magic.
 */
 
 void
-Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
+Perl_sv_catsv_mg(pTHX_ SV *dstr, register SV *sstr)
 {
-    sv_catsv(dsv,ssv);
-    SvSETMAGIC(dsv);
+    sv_catsv(dstr,sstr);
+    SvSETMAGIC(dstr);
 }
 
 /*
@@ -3837,20 +3812,20 @@ Handles 'get' magic, but not 'set' magic.  See C<sv_catpv_mg>.
 */
 
 void
-Perl_sv_catpv(pTHX_ register SV *sv, register const char *pv)
+Perl_sv_catpv(pTHX_ register SV *sv, register const char *ptr)
 {
     register STRLEN len;
     STRLEN tlen;
     char *junk;
 
-    if (!pv)
+    if (!ptr)
 	return;
     junk = SvPV_force(sv, tlen);
-    len = strlen(pv);
+    len = strlen(ptr);
     SvGROW(sv, tlen + len + 1);
-    if (pv == junk)
-	pv = SvPVX(sv);
-    Move(pv,SvPVX(sv)+tlen,len+1,char);
+    if (ptr == junk)
+	ptr = SvPVX(sv);
+    Move(ptr,SvPVX(sv)+tlen,len+1,char);
     SvCUR(sv) += len;
     (void)SvPOK_only_UTF8(sv);		/* validate pointer */
     SvTAINT(sv);
@@ -3865,9 +3840,9 @@ Like C<sv_catpv>, but also handles 'set' magic.
 */
 
 void
-Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *pv)
+Perl_sv_catpv_mg(pTHX_ register SV *sv, register const char *ptr)
 {
-    sv_catpv(sv,pv);
+    sv_catpv(sv,ptr);
     SvSETMAGIC(sv);
 }
 
diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t
index cec839bc43..cd82dfb530 100644
--- a/t/lib/syslfs.t
+++ b/t/lib/syslfs.t
@@ -14,6 +14,10 @@ BEGIN {
 	require Fcntl; import Fcntl qw(/^O_/ /^SEEK_/);
 }
 
+use strict;
+our @s;
+our $fail;
+
 sub zap {
     close(BIG);
     unlink("big");
@@ -164,6 +168,20 @@ sub fail () {
     $fail++;
 }
 
+sub offset ($$) {
+    my ($offset_will_be, $offset_want) = @_;
+    my $offset_is = eval $offset_will_be;
+    unless ($offset_is == $offset_want) {
+        print "# bad offset $offset_is, want $offset_want\n";
+	if (unpack("L", pack("L", $offset_want)) == $offset_is) {
+	    my $offset_func = ($offset_will_be =~ /^(\w+)/);
+	    print "# 32-bit wraparound suspected in $offset_func() since\n";
+	    print "# $offset_want cast into 32 bits is $offset_is.\n";
+	}
+        fail;
+    }
+}
+
 print "1..17\n";
 
 my $fail = 0;
@@ -182,28 +200,28 @@ print "ok 4\n";
 
 sysopen(BIG, "big", O_RDONLY) or do { warn "sysopen failed: $!\n"; bye };
 
-fail unless sysseek(BIG, 4_500_000_000, SEEK_SET) == 4_500_000_000;
+offset('sysseek(BIG, 4_500_000_000, SEEK_SET)', 4_500_000_000);
 print "ok 5\n";
 
-fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
+offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000);
 print "ok 6\n";
 
-fail unless sysseek(BIG, 1, SEEK_CUR) == 4_500_000_001;
+offset('sysseek(BIG, 1, SEEK_CUR)', 4_500_000_001);
 print "ok 7\n";
 
-fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_001;
+offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_001);
 print "ok 8\n";
 
-fail unless sysseek(BIG, -1, SEEK_CUR) == 4_500_000_000;
+offset('sysseek(BIG, -1, SEEK_CUR)', 4_500_000_000);
 print "ok 9\n";
 
-fail unless sysseek(BIG, 0, SEEK_CUR) == 4_500_000_000;
+offset('sysseek(BIG, 0, SEEK_CUR)', 4_500_000_000);
 print "ok 10\n";
 
-fail unless sysseek(BIG, -3, SEEK_END) == 5_000_000_000;
+offset('sysseek(BIG, -3, SEEK_END)', 5_000_000_000);
 print "ok 11\n";
 
-fail unless sysseek(BIG, 0, SEEK_CUR) == 5_000_000_000;
+offset('sysseek(BIG, 0, SEEK_CUR)', 5_000_000_000);
 print "ok 12\n";
 
 my $big;
@@ -215,6 +233,8 @@ fail unless $big eq "big";
 print "ok 14\n";
 
 # 705_032_704 = (I32)5_000_000_000
+# See that we don't have "big" in the 705_... spot:
+# that would mean that we have a wraparound.
 fail unless sysseek(BIG, 705_032_704, SEEK_SET);
 print "ok 15\n";
 
diff --git a/t/op/join.t b/t/op/join.t
index 4cbe692b80..0f849fda9c 100755
--- a/t/op/join.t
+++ b/t/op/join.t
@@ -45,33 +45,23 @@ if ($f eq 'baeak') {print "ok 6\n";} else {print "# '$f'\nnot ok 6\n";}
   print "ok 10\n";
 };
 
-{ my $s = join("", chr(1234),chr(255));
-  print "not " unless length($s) == 2 &&
-                      ord(substr($s,0,1)) == 1234 &&
-                      ord(substr($s,1,1)) ==  255;
+{ my $s = join("", chr(0x1234), chr(0xff));
+  print "not " unless length($s) == 2 && $s eq "\x{1234}\x{ff}";
   print "ok 11\n";
 }
 
-{ my $s = join(chr(2345), chr(1234),chr(255));
-  print "not " unless length($s) == 3 &&
-                      ord(substr($s,0,1)) == 1234 &&
-                      ord(substr($s,1,1)) == 2345 &&
-                      ord(substr($s,2,1)) ==  255;
+{ my $s = join(chr(0xff), chr(0x1234), "");
+  print "not " unless length($s) == 2 && $s eq "\x{1234}\x{ff}";
   print "ok 12\n";
 }
 
-{ my $s = join(chr(2345), chr(1234),chr(3456));
-  print "not " unless length($s) == 3 &&
-                      ord(substr($s,0,1)) == 1234 &&
-                      ord(substr($s,1,1)) == 2345 &&
-                      ord(substr($s,2,1)) == 3456;
+{ my $s = join(chr(0x1234), chr(0xff), chr(0x2345));
+  print "not " unless length($s) == 3 && $s eq "\x{ff}\x{1234}\x{2345}";
   print "ok 13\n";
 }
 
-{ my $s = join(chr(255), chr(1234),chr(2345));
-  print "not " unless length($s) == 3 &&
-                      ord(substr($s,0,1)) == 1234 &&
-                      ord(substr($s,1,1)) ==  255 &&
-                      ord(substr($s,2,1)) == 2345;
+{ my $s = join(chr(0xff), chr(0x1234), chr(0xfe));
+  print "not " unless length($s) == 3 && $s eq "\x{1234}\x{ff}\x{fe}";
   print "ok 14\n";
 }
+
diff --git a/t/op/lfs.t b/t/op/lfs.t
index e732adc798..e04e1a1dac 100644
--- a/t/op/lfs.t
+++ b/t/op/lfs.t
@@ -13,6 +13,10 @@ BEGIN {
 	}
 }
 
+use strict;
+our @s;
+our $fail;
+
 sub zap {
     close(BIG);
     unlink("big");
@@ -167,6 +171,20 @@ sub fail () {
     $fail++;
 }
 
+sub offset ($$) {
+    my ($offset_will_be, $offset_want) = @_;
+    my $offset_is = eval $offset_will_be;
+    unless ($offset_is == $offset_want) {
+        print "# bad offset $offset_is, want $offset_want\n";
+	if (unpack("L", pack("L", $offset_want)) == $offset_is) {
+	    my $offset_func = ($offset_will_be =~ /^(\w+)/);
+	    print "# 32-bit wraparound suspected in $offset_func() since\n";
+	    print "# $offset_want cast into 32 bits is $offset_is.\n";
+	}
+        fail;
+    }
+}
+
 print "1..17\n";
 
 my $fail = 0;
@@ -189,25 +207,28 @@ binmode BIG;
 fail unless seek(BIG, 4_500_000_000, $SEEK_SET);
 print "ok 5\n";
 
-fail unless tell(BIG) == 4_500_000_000;
+offset('tell(BIG)', 4_500_000_000);
 print "ok 6\n";
 
 fail unless seek(BIG, 1, $SEEK_CUR);
 print "ok 7\n";
 
-fail unless tell(BIG) == 4_500_000_001;
+# If you get 205_032_705 from here it means that
+# your tell() is returning 32-bit values since (I32)4_500_000_001
+# is exactly 205_032_705.
+offset('tell(BIG)', 4_500_000_001);
 print "ok 8\n";
 
 fail unless seek(BIG, -1, $SEEK_CUR);
 print "ok 9\n";
 
-fail unless tell(BIG) == 4_500_000_000;
+offset('tell(BIG)', 4_500_000_000);
 print "ok 10\n";
 
 fail unless seek(BIG, -3, $SEEK_END);
 print "ok 11\n";
 
-fail unless tell(BIG) == 5_000_000_000;
+offset('tell(BIG)', 5_000_000_000);
 print "ok 12\n";
 
 my $big;
@@ -219,6 +240,8 @@ fail unless $big eq "big";
 print "ok 14\n";
 
 # 705_032_704 = (I32)5_000_000_000
+# See that we don't have "big" in the 705_... spot:
+# that would mean that we have a wraparound.
 fail unless seek(BIG, 705_032_704, $SEEK_SET);
 print "ok 15\n";
 
diff --git a/t/pragma/constant.t b/t/pragma/constant.t
index 450b4d02cf..f932976f60 100755
--- a/t/pragma/constant.t
+++ b/t/pragma/constant.t
@@ -14,7 +14,7 @@ END { print @warnings }
 
 ######################### We start with some black magic to print on failure.
 
-BEGIN { $| = 1; print "1..73\n"; }
+BEGIN { $| = 1; print "1..82\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use constant 1.01;
 $loaded = 1;
@@ -229,3 +229,23 @@ test 71, (shift @warnings) =~ /^Constant name 'ENV' is forced into package main:
 test 72, (shift @warnings) =~ /^Constant name 'INC' is forced into package main:: at/;
 test 73, (shift @warnings) =~ /^Constant name 'SIG' is forced into package main:: at/;
 @warnings = ();
+
+
+use constant {
+	THREE  => 3,
+	FAMILY => [ qw( John Jane Sally ) ],
+	AGES   => { John => 33, Jane => 28, Sally => 3 },
+	RFAM   => [ [ qw( John Jane Sally ) ] ],
+	SPIT   => sub { shift },
+	PHFAM  => [ { John => 1, Jane => 2, Sally => 3 }, 33, 28, 3 ],
+};
+
+test 74, @{+FAMILY} == THREE;
+test 75, @{+FAMILY} == @{RFAM->[0]};
+test 76, FAMILY->[2] eq RFAM->[0]->[2];
+test 77, AGES->{FAMILY->[1]} == 28;
+test 78, PHFAM->{John} == AGES->{John};
+test 79, PHFAM->[3] == AGES->{FAMILY->[2]};
+test 80, @{+PHFAM} == SPIT->(THREE+1);
+test 81, THREE**3 eq SPIT->(@{+FAMILY}**3);
+test 82, AGES->{FAMILY->[THREE-1]} == PHFAM->[THREE];
diff --git a/t/pragma/sub_lval.t b/t/pragma/sub_lval.t
index 1b8b73a7d8..a54075dd64 100755
--- a/t/pragma/sub_lval.t
+++ b/t/pragma/sub_lval.t
@@ -1,4 +1,4 @@
-print "1..47\n";
+print "1..49\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -436,3 +436,16 @@ foobar() = 12;
 print "# '$newvar'.\nnot " unless $newvar eq "12";
 print "ok 47\n";
 
+# Testing DWIM of foo = bar;
+sub foo : lvalue {
+    $a;
+}
+$a = "not ok 48\n";
+foo = "ok 48\n";
+print $a;
+
+open bar, ">nothing" or die $!; 
+bar = *STDOUT;
+print bar "ok 49\n";
+unlink "nothing";
+
diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t
index e55637edaa..8e4d296f5d 100755
--- a/t/pragma/utf8.t
+++ b/t/pragma/utf8.t
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 
-print "1..109\n";
+print "1..105\n";
 
 my $test = 1;
 
@@ -554,48 +554,3 @@ sub nok_bytes {
     print "ok $test\n";
     $test++;					# 105
 }
-
-{
-    use utf8;
-    my @a = map ord, split(/\x{123}/,
-			   join("", map chr, (1234, 0x123,
-					            0x123,
-					      23,   0x123,
-					      123,  0x123,
-					      128,  0x123,
-					      255,  0x123,
-					      2345)));
-    ok "@a", "1234 0 23 123 128 255 2345";
-    $test++;           				   # 106
-}
-
-{
-    use utf8;
-    my @a = map ord, split(/(\x{123})/,
-			   join("", map chr, (1234, 0x123,
-					            0x123,
-					      23,   0x123,
-					      123,  0x123,
-					      128,  0x123,
-					      255,  0x123,
-					      2345)));
-    # 291 is 0x123
-    ok "@a", "1234 291 0 291 23 291 123 291 128 291 255 291 2345";
-    $test++;           				   # 107 (variant of test 106)
-}
-
-{
-    use utf8;
-    my @a = map ord, split(//, join("", map chr, (1234, 0xff, 2345)));
-    ok "@a", "1234 255 2345";
-    $test++;                # 108 (variant of test 66)
-}
-
-{
-    use utf8;
-    my $x = chr(0xff);
-    my @a = map ord, split(/$x/, join("", map chr, (1234, 0xff, 2345)));
-    ok "@a", "1234 2345";
-    $test++;                # 109 (variant of test 67)
-}
-
diff --git a/vms/vms.c b/vms/vms.c
index fec955cb86..7872bddf40 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -733,6 +733,30 @@ Perl_my_setenv(pTHX_ char *lnm,char *eqv)
 }
 /*}}}*/
 
+/*{{{static void vmssetuserlnm(char *name, char *eqv);
+/*  vmssetuserlnm
+ *  sets a user-mode logical in the process logical name table
+ *  used for redirection of sys$error
+ */
+void
+Perl_vmssetuserlnm(char *name, char *eqv)
+{
+    $DESCRIPTOR(d_tab, "LNM$PROCESS");
+    struct dsc$descriptor_d d_name = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
+    unsigned long int iss, attr = 0;
+    unsigned char acmode = PSL$C_USER;
+    struct itmlst_3 lnmlst[2] = {{0, LNM$_STRING, 0, 0},
+                                 {0, 0, 0, 0}};
+    d_name.dsc$a_pointer = name;
+    d_name.dsc$w_length = strlen(name);
+
+    lnmlst[0].buflen = strlen(eqv);
+    lnmlst[0].bufadr = eqv;
+
+    iss = sys$crelnm(&attr,&d_tab,&d_name,&acmode,lnmlst);
+    if (!(iss&1)) lib$signal(iss);
+}
+/*}}}*/
 
 
 /*{{{ char *my_crypt(const char *textpasswd, const char *usrname)*/
@@ -1846,17 +1870,19 @@ vmspipe_tempfile(void)
     fprintf(fp,"$ perl_del    = \"delete\"\n");
     fprintf(fp,"$ pif         = \"if\"\n");
     fprintf(fp,"$!  --- define i/o redirection (sys$output set by lib$spawn)\n");
-    fprintf(fp,"$ pif perl_popen_in  .nes. \"\" then perl_define sys$input  'perl_popen_in'\n");
-    fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define sys$error  'perl_popen_err'\n");
+    fprintf(fp,"$ pif perl_popen_in  .nes. \"\" then perl_define/user sys$input  'perl_popen_in'\n");
+    fprintf(fp,"$ pif perl_popen_err .nes. \"\" then perl_define/user sys$error  'perl_popen_err'\n");
+    fprintf(fp,"$ pif perl_popen_out .nes. \"\" then perl_define      sys$output 'perl_popen_out'\n");
     fprintf(fp,"$ cmd = perl_popen_cmd\n");
     fprintf(fp,"$!  --- get rid of global symbols\n");
     fprintf(fp,"$ perl_del/symbol/global perl_popen_in\n");
     fprintf(fp,"$ perl_del/symbol/global perl_popen_err\n");
+    fprintf(fp,"$ perl_del/symbol/global perl_popen_out\n");
     fprintf(fp,"$ perl_del/symbol/global perl_popen_cmd\n");
     fprintf(fp,"$ perl_on\n");
     fprintf(fp,"$ 'cmd\n");
     fprintf(fp,"$ perl_status = $STATUS\n");
-    fprintf(fp,"$ perl_del 'perl_cfile'\n");
+    fprintf(fp,"$ perl_del  'perl_cfile'\n");
     fprintf(fp,"$ perl_exit 'perl_status'\n");
     fsync(fileno(fp));
 
@@ -1895,12 +1921,12 @@ safe_popen(char *cmd, char *mode)
     pInfo info;
     struct dsc$descriptor_s d_symbol= {0, DSC$K_DTYPE_T,
                                       DSC$K_CLASS_S, symbol};
-    struct dsc$descriptor_s d_out = {0, DSC$K_DTYPE_T,
-                                      DSC$K_CLASS_S, out};
     struct dsc$descriptor_s vmspipedsc = {0, DSC$K_DTYPE_T,
                                       DSC$K_CLASS_S, 0};
+
     $DESCRIPTOR(d_sym_cmd,"PERL_POPEN_CMD");
     $DESCRIPTOR(d_sym_in ,"PERL_POPEN_IN");
+    $DESCRIPTOR(d_sym_out,"PERL_POPEN_OUT");
     $DESCRIPTOR(d_sym_err,"PERL_POPEN_ERR");
                             
     /* once-per-program initialization...
@@ -1961,9 +1987,9 @@ safe_popen(char *cmd, char *mode)
     info->in_done    = TRUE;
     info->out_done   = TRUE;
     info->err_done   = TRUE;
+    in[0] = out[0] = err[0] = '\0';
 
     if (*mode == 'r') {             /* piping from subroutine */
-        in[0] = '\0';
 
         info->out = pipe_infromchild_setup(mbx,out);
         if (info->out) {
@@ -1982,13 +2008,13 @@ safe_popen(char *cmd, char *mode)
                 if (!done) _ckvmssts(sys$clref(pipe_ef));
                 _ckvmssts(sys$setast(1));
                 if (!done) _ckvmssts(sys$waitfr(pipe_ef));
-    }
+            }
 
             if (info->out->buf) Safefree(info->out->buf);
             Safefree(info->out);
             Safefree(info);
             return Nullfp;
-    }
+        }
 
         info->err = pipe_mbxtofd_setup(fileno(stderr), err);
         if (info->err) {
@@ -1998,7 +2024,6 @@ safe_popen(char *cmd, char *mode)
         }
 
     } else {                        /* piping to subroutine , mode=w*/
-        int melded;
 
         info->in = pipe_tochild_setup(in,mbx);
         info->fp  = PerlIO_open(mbx, mode);
@@ -2026,21 +2051,9 @@ safe_popen(char *cmd, char *mode)
             if (info->in->buf) Safefree(info->in->buf);
             Safefree(info->in);
             Safefree(info);
-        return Nullfp;
+            return Nullfp;
         }
         
-        /* if SYS$ERROR == SYS$OUTPUT, use only one mbx */
-        
-        melded = FALSE;
-        fgetname(stderr, err);
-        if (strncmp(err,"SYS$ERROR:",10) == 0) {
-            fgetname(stdout, out);
-            if (strncmp(out,"SYS$OUTPUT:",11) == 0) {
-                if (popen_translate("SYS$OUTPUT",out) == popen_translate("SYS$ERROR",err)) {
-                    melded = TRUE;
-                }
-    }
-    }
 
         info->out = pipe_mbxtofd_setup(fileno(stdout), out);
         if (info->out) {
@@ -2048,18 +2061,14 @@ safe_popen(char *cmd, char *mode)
             info->out_done = FALSE;
             info->out->info = info;
         }
-        if (!melded) {
-            info->err = pipe_mbxtofd_setup(fileno(stderr), err);
-            if (info->err) {
-                info->err->pipe_done = &info->err_done;
-                info->err_done = FALSE;
-                info->err->info = info;
-    }
-        } else {
-            err[0] = '\0';
-    }
+
+        info->err = pipe_mbxtofd_setup(fileno(stderr), err);
+        if (info->err) {
+            info->err->pipe_done = &info->err_done;
+            info->err_done = FALSE;
+            info->err->info = info;
+        }
     }
-    d_out.dsc$w_length = strlen(out);   /* lib$spawn sets SYS$OUTPUT so can meld*/
 
     symbol[MAX_DCL_SYMBOL] = '\0';
 
@@ -2071,6 +2080,9 @@ safe_popen(char *cmd, char *mode)
     d_symbol.dsc$w_length = strlen(symbol);
     _ckvmssts(lib$set_symbol(&d_sym_err, &d_symbol, &table));
 
+    strncpy(symbol, out, MAX_DCL_SYMBOL);
+    d_symbol.dsc$w_length = strlen(symbol);
+    _ckvmssts(lib$set_symbol(&d_sym_out, &d_symbol, &table));
 
     p = VMScmd.dsc$a_pointer;
     while (*p && *p != '\n') p++;
@@ -2087,7 +2099,7 @@ safe_popen(char *cmd, char *mode)
     info->next=open_pipes;  /* prepend to list */
     open_pipes=info;
     _ckvmssts(sys$setast(1));
-    _ckvmssts(lib$spawn(&vmspipedsc, &nl_desc, &d_out, &flags,
+    _ckvmssts(lib$spawn(&vmspipedsc, &nl_desc, &nl_desc, &flags,
                       0, &info->pid, &info->completion,
                       0, popen_completion_ast,info,0,0,0));
 
@@ -2101,7 +2113,7 @@ safe_popen(char *cmd, char *mode)
     _ckvmssts(lib$delete_symbol(&d_sym_cmd, &table));
     _ckvmssts(lib$delete_symbol(&d_sym_in,  &table));
     _ckvmssts(lib$delete_symbol(&d_sym_err, &table));
-
+    _ckvmssts(lib$delete_symbol(&d_sym_out, &table));
     vms_execfree(aTHX);
         
     PL_forkprocess = info->pid;
@@ -3575,9 +3587,12 @@ mp_getredirection(pTHX_ int *ac, char ***av)
 	PerlIO_printf(Perl_debug_log,"Can't open output file %s as stdout",out);
 	exit(vaxc$errno);
 	}
+	if (out != NULL) Perl_vmssetuserlnm("SYS$OUTPUT",out);
+
     if (err != NULL) {
         if (strcmp(err,"&1") == 0) {
             dup2(fileno(stdout), fileno(Perl_debug_log));
+            Perl_vmssetuserlnm("SYS$ERROR","SYS$OUTPUT");
         } else {
 	FILE *tmperr;
 	if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
@@ -3590,6 +3605,7 @@ mp_getredirection(pTHX_ int *ac, char ***av)
 		{
 		exit(vaxc$errno);
 		}
+	    Perl_vmssetuserlnm("SYS$ERROR",err);
 	}
         }
 #ifdef ARGPROC_DEBUG
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 8d2a628894..17c5a00ed3 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -709,6 +709,7 @@ int	Perl_rmscopy (pTHX_ char *, char *, int);
 #endif
 char *	my_getenv_len (const char *, unsigned long *, bool);
 int	vmssetenv (char *, char *, struct dsc$descriptor_s **);
+void	Perl_vmssetuserlnm(char *name, char *eqv);
 char *	my_crypt (const char *, const char *);
 Pid_t	my_waitpid (Pid_t, int *, int);
 char *	my_gconvert (double, int, int, char *);
diff --git a/vms/vmspipe.com b/vms/vmspipe.com
index bbb4461c72..652783eec5 100644
--- a/vms/vmspipe.com
+++ b/vms/vmspipe.com
@@ -6,12 +6,14 @@ $ perl_exit   = "exit"
 $ perl_del    = "delete"
 $ pif         = "if"
 $!  --- define i/o redirection (sys$output set by lib$spawn)
-$ pif perl_popen_in  .nes. "" then perl_define sys$input  'perl_popen_in'
-$ pif perl_popen_err .nes. "" then perl_define sys$error  'perl_popen_err'
+$ pif perl_popen_in  .nes. "" then perl_define/user sys$input  'perl_popen_in'
+$ pif perl_popen_err .nes. "" then perl_define/user sys$error  'perl_popen_err'
+$ pif perl_popen_out .nes. "" then perl_define      sys$output 'perl_popen_out'
 $ cmd = perl_popen_cmd
 $!  --- get rid of global symbols
 $ perl_del/symbol/global perl_popen_in
 $ perl_del/symbol/global perl_popen_err
+$ perl_del/symbol/global perl_popen_out
 $ perl_del/symbol/global perl_popen_cmd
 $ perl_on
 $ 'cmd