[win32] merge change#887 from maintbranch

p4raw-link: @887 on //depot/maint-5.004/perl: 6cdf74fe31f049dc2164dbb9e6242179d4b8ee1f

p4raw-id: //depot/win32/perl@937

19 files changed, 732 insertions, 253 deletions

diff --git a/MANIFEST b/MANIFEST
index 8d7f49971c..8830dca638 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -817,6 +817,7 @@ t/op/closure.t		See if closures work
 t/op/cmp.t		See if the various string and numeric compare work
 t/op/cond.t		See if conditional expressions work
 t/op/delete.t		See if delete works
+t/op/die_exit.t		See if die and exit status interaction works
 t/op/do.t		See if subroutines work
 t/op/each.t		See if hash iterators work
 t/op/eval.t		See if eval operator works
@@ -832,6 +833,8 @@ t/op/hashwarn.t		See if warnings for bad hash assignments work
 t/op/inc.t		See if inc/dec of integers near 32 bit limit work
 t/op/index.t		See if index works
 t/op/int.t		See if int works
+t/op/ipcmsg.t		See if msg* ops work
+t/op/ipcsem.t		See if sem* ops work
 t/op/join.t		See if join works
 t/op/list.t		See if array lists work
 t/op/local.t		See if local works
diff --git a/doio.c b/doio.c
index d8ce25d186..4849740c44 100644
--- a/doio.c
+++ b/doio.c
@@ -1305,6 +1305,18 @@ do_ipcget(I32 optype, SV **mark, SV **sp)
     return -1;			/* should never happen */
 }
 
+#if defined(__sun__) && defined(__svr4__) /* XXX Need metaconfig test */
+/* Solaris manpage says that it uses (like linux)
+   int semctl (int semid, int semnum, int cmd, union semun arg)
+   but the system include files do not define union semun !!!!
+*/
+union semun {
+     int val;
+     struct semid_ds *buf;
+     ushort *array;
+};
+#endif
+
 I32
 do_ipcctl(I32 optype, SV **mark, SV **sp)
 {
@@ -1313,7 +1325,8 @@ do_ipcctl(I32 optype, SV **mark, SV **sp)
     char *a;
     I32 id, n, cmd, infosize, getinfo;
     I32 ret = -1;
-#ifdef __linux__	/* XXX Need metaconfig test */
+#if defined(__linux__) || (defined(__sun__) && defined(__svr4__))
+/* XXX Need metaconfig test */
     union semun unsemds;
 #endif
 
@@ -1345,8 +1358,9 @@ do_ipcctl(I32 optype, SV **mark, SV **sp)
 	else if (cmd == GETALL || cmd == SETALL)
 	{
 	    struct semid_ds semds;
-#ifdef __linux__	/* XXX Need metaconfig test */
-/* linux (and Solaris2?) uses :
+#if defined(__linux__) || (defined(__sun__) && defined(__svr4__))
+	/* XXX Need metaconfig test */
+/* linux and Solaris2 uses :
    int semctl (int semid, int semnum, int cmd, union semun arg)
        union semun {
             int val;
@@ -1405,7 +1419,8 @@ do_ipcctl(I32 optype, SV **mark, SV **sp)
 #endif
 #ifdef HAS_SEM
     case OP_SEMCTL:
-#ifdef __linux__	/* XXX Need metaconfig test */
+#if defined(__linux__) || (defined(__sun__) && defined(__svr4__))
+	/* XXX Need metaconfig test */
         unsemds.buf = (struct semid_ds *)a;
 	ret = semctl(id, n, cmd, unsemds);
 #else
diff --git a/lib/File/CheckTree.pm b/lib/File/CheckTree.pm
index a39308b6c9..dca7f6aff3 100644
--- a/lib/File/CheckTree.pm
+++ b/lib/File/CheckTree.pm
@@ -137,13 +137,13 @@ sub valmess {
 	    $mess =~ s/ does not / should not / ||
 	    $mess =~ s/ not / /;
 	}
-	print STDERR $mess,"\n";
     }
     else {
 	$this =~ s/\$file/'$file'/g;
-	print STDERR "Can't do $this.\n";
+	$mess = "Can't do $this.\n";
     }
-    if ($disposition eq 'die') { exit 1; }
+    die "$mess\n" if $disposition eq 'die';
+    warn "$mess\n";
     ++$warnings;
 }
 
diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index 38b396771b..5b5b495b57 100644
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -2,17 +2,17 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: GetoptLong.pm,v 2.13 1997-12-25 16:20:17+01 jv Exp $
+# RCS Status      : $Id: GetoptLong.pm,v 2.16 1998-03-13 11:05:29+01 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Thu Dec 25 16:18:08 1997
-# Update Count    : 647
+# Last Modified On: Fri Mar 13 11:05:28 1998
+# Update Count    : 659
 # Status          : Released
 
 ################ Copyright ################
 
-# This program is Copyright 1990,1997 by Johan Vromans.
+# This program is Copyright 1990,1998 by Johan Vromans.
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License
 # as published by the Free Software Foundation; either version 2
@@ -32,10 +32,10 @@ package Getopt::Long;
 use strict;
 
 BEGIN {
-    require 5.003;
+    require 5.004;
     use Exporter ();
     use vars   qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-    $VERSION   = sprintf("%d.%02d", q$Revision: 2.13 $ =~ /(\d+)\.(\d+)/);
+    $VERSION   = sprintf("%d.%02d", q$Revision: 2.16 $ =~ /(\d+)\.(\d+)/);
 
     @ISA       = qw(Exporter);
     @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
@@ -87,7 +87,7 @@ sub GetOptions {
     $genprefix = $gen_prefix;	# so we can call the same module many times
     $error = '';
 
-    print STDERR ('GetOptions $Revision: 2.13 $ ',
+    print STDERR ('GetOptions $Revision: 2.16 $ ',
 		  "[GetOpt::Long $Getopt::Long::VERSION] -- ",
 		  "called from package \"$pkg\".\n",
 		  "  (@ARGV)\n",
@@ -127,7 +127,7 @@ sub GetOptions {
 	my $opt = shift (@optionlist);
 
 	# Strip leading prefix so people can specify "--foo=i" if they like.
-	$opt = $2 if $opt =~ /^$genprefix+(.*)$/;
+	$opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
 
 	if ( $opt eq '<>' ) {
 	    if ( (defined $userlinkage)
@@ -420,9 +420,9 @@ sub config (@) {
     foreach $opt ( @options ) {
 	my $try = lc ($opt);
 	my $action = 1;
-	if ( $try =~ /^no_?(.*)$/ ) {
+	if ( $try =~ /^no_?(.*)$/s ) {
 	    $action = 0;
-	    $try = $1;
+	    $try = $+;
 	}
 	if ( $try eq 'default' or $try eq 'defaults' ) {
 	    &$config_defaults () if $action;
@@ -454,6 +454,21 @@ sub config (@) {
 	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
 	    $passthrough = $action;
 	}
+	elsif ( $try =~ /^prefix=(.+)$/ ) {
+	    $gen_prefix = $1;
+	    # Turn into regexp. Needs to be parenthesized!
+	    $gen_prefix = "(" . quotemeta($gen_prefix) . ")";
+	    eval { '' =~ /$gen_prefix/; };
+	    &$croak ("Getopt::Long: invalid pattern \"$gen_prefix\"") if $@;
+	}
+	elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
+	    $gen_prefix = $1;
+	    # Parenthesize if needed.
+	    $gen_prefix = "(" . $gen_prefix . ")" 
+	      unless $gen_prefix =~ /^\(.*\)$/;
+	    eval { '' =~ /$gen_prefix/; };
+	    &$croak ("Getopt::Long: invalid pattern \"$gen_prefix\"") if $@;
+	}
 	elsif ( $try eq 'debug' ) {
 	    $debug = $action;
 	}
@@ -476,9 +491,9 @@ $find_option = sub {
 
     print STDERR ("=> find \"$opt\", genprefix=\"$genprefix\"\n") if $debug;
 
-    return 0 unless $opt =~ /^$genprefix(.*)$/;
+    return 0 unless $opt =~ /^$genprefix(.*)$/s;
 
-    $opt = $2;
+    $opt = $+;
     my ($starter) = $1;
 
     print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
@@ -488,7 +503,7 @@ $find_option = sub {
 
     # If it is a long option, it may include the value.
     if (($starter eq "--" || ($getopt_compat && !$bundling))
-	&& $opt =~ /^([^=]+)=(.*)$/ ) {
+	&& $opt =~ /^([^=]+)=(.*)$/s ) {
 	$opt = $1;
 	$optarg = $2;
 	print STDERR ("=> option \"", $opt, 
@@ -626,7 +641,7 @@ $find_option = sub {
     # Get key if this is a "name=value" pair for a hash option.
     $key = undef;
     if ($hash && defined $arg) {
-	($key, $arg) = ($arg =~ /^(.*)=(.*)$/o) ? ($1, $2) : ($arg, 1);
+	($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
     }
 
     #### Check if the argument is valid for this option ####
@@ -650,7 +665,7 @@ $find_option = sub {
     }
 
     elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
-	if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/ ) {
+	if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) {
 	    $arg = $1;
 	    $rest = $2;
 	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
@@ -683,9 +698,9 @@ $find_option = sub {
 	# and at least one digit following the point and 'e'.
 	# [-]NN[.NN][eNN]
 	if ( $bundling && defined $rest &&
-	     $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/ ) {
+	     $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) {
 	    $arg = $1;
-	    $rest = $4;
+	    $rest = $+;
 	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
 	}
 	elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) {
@@ -1228,6 +1243,16 @@ remaining options to some other program.
 
 This can be very confusing, especially when B<permute> is also set.
 
+=item prefix
+
+The string that starts options. See also B<prefix_pattern>.
+
+=item prefix_pattern
+
+A Perl pattern that identifies the strings that introduce options.
+Default is C<(--|-|\+)> unless environment variable
+POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
+
 =item debug (default: reset)
 
 Enable copious debugging output.
@@ -1262,7 +1287,7 @@ Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-This program is Copyright 1990,1997 by Johan Vromans.
+This program is Copyright 1990,1998 by Johan Vromans.
 This program is free software; you can redistribute it and/or
 modify it under the terms of the GNU General Public License
 as published by the Free Software Foundation; either version 2
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
index 7551ad01a3..77fb5dd818 100644
--- a/lib/Math/BigFloat.pm
+++ b/lib/Math/BigFloat.pm
@@ -37,7 +37,7 @@ sub numify { 0 + "${$_[0]}" }	# Not needed, additional overhead
 sub stringify {
     my $n = ${$_[0]};
 
-    $n =~ s/^\+//;
+    my $minus = ($n =~ s/^([+-])// && $1 eq '-');
     $n =~ s/E//;
 
     $n =~ s/([-+]\d+)$//;
@@ -52,6 +52,7 @@ sub stringify {
     } else {
 	$n = '.' . ("0" x (abs($e) - $ln)) . $n;
     }
+    $n = "-$n" if $minus;
 
     # 1 while $n =~ s/(.*\d)(\d\d\d)/$1,$2/;
 
diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm
index 62da1d273f..d3a89f03b8 100644
--- a/lib/Text/ParseWords.pm
+++ b/lib/Text/ParseWords.pm
@@ -1,140 +1,93 @@
 package Text::ParseWords;
 
-require 5.000;
-use Carp;
+use vars qw($VERSION @ISA @EXPORT);
+$VERSION = "3.0";
 
-require AutoLoader;
-*AUTOLOAD = \&AutoLoader::AUTOLOAD;
+require 5.000;
 
-require Exporter;
+use Exporter;
 @ISA = qw(Exporter);
-@EXPORT = qw(shellwords quotewords);
+@EXPORT = qw(shellwords quotewords nested_quotewords parse_line);
 @EXPORT_OK = qw(old_shellwords);
 
-=head1 NAME
-
-Text::ParseWords - parse text into an array of tokens
-
-=head1 SYNOPSIS
-
-  use Text::ParseWords;
-  @words = &quotewords($delim, $keep, @lines);
-  @words = &shellwords(@lines);
-  @words = &old_shellwords(@lines);
-
-=head1 DESCRIPTION
 
-&quotewords() accepts a delimiter (which can be a regular expression)
-and a list of lines and then breaks those lines up into a list of
-words ignoring delimiters that appear inside quotes.
-
-The $keep argument is a boolean flag.  If true, the quotes are kept
-with each word, otherwise quotes are stripped in the splitting process.
-$keep also defines whether unprotected backslashes are retained.
-
-A &shellwords() replacement is included to demonstrate the new package.
-This version differs from the original in that it will _NOT_ default
-to using $_ if no arguments are given.  I personally find the old behavior
-to be a mis-feature.
-
-&quotewords() works by simply jamming all of @lines into a single
-string in $_ and then pulling off words a bit at a time until $_
-is exhausted.
+sub shellwords {
+    local(@lines) = @_;
+    $lines[$#lines] =~ s/\s+$//;
+    return(quotewords('\s+', 0, @lines));
+}
 
-=head1 AUTHORS
 
-Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
 
-Basically an update and generalization of the old shellwords.pl.
-Much code shamelessly stolen from the old version (author unknown).
+sub quotewords {
+    my($delim, $keep, @lines) = @_;
+    my($line, @words, @allwords);
+    
+
+    foreach $line (@lines) {
+	@words = parse_line($delim, $keep, $line);
+	return() unless (@words || !length($line));
+	push(@allwords, @words);
+    }
+    return(@allwords);
+}
 
-=cut
 
-1;
-__END__
 
-sub shellwords {
-    local(@lines) = @_;
-    $lines[$#lines] =~ s/\s+$//;
-    &quotewords('\s+', 0, @lines);
+sub nested_quotewords {
+    my($delim, $keep, @lines) = @_;
+    my($i, @allwords);
+    
+    for ($i = 0; $i < @lines; $i++) {
+	@{$allwords[$i]} = parse_line($delim, $keep, $lines[$i]);
+	return() unless (@{$allwords[$i]} || !length($lines[$i]));
+    }
+    return(@allwords);
 }
 
 
 
-sub quotewords {
-
-# The inner "for" loop builds up each word (or $field) one $snippet
-# at a time.  A $snippet is a quoted string, a backslashed character,
-# or an unquoted string.  We fall out of the "for" loop when we reach
-# the end of $_ or when we hit a delimiter.  Falling out of the "for"
-# loop, we push the $field we've been building up onto the list of
-# @words we'll be returning, and then loop back and pull another word
-# off of $_.
-#
-# The first two cases inside the "for" loop deal with quoted strings.
-# The first case matches a double quoted string, removes it from $_,
-# and assigns the double quoted string to $snippet in the body of the
-# conditional.  The second case handles single quoted strings.  In
-# the third case we've found a quote at the current beginning of $_,
-# but it didn't match the quoted string regexps in the first two cases,
-# so it must be an unbalanced quote and we croak with an error (which can
-# be caught by eval()).
-#
-# The next case handles backslashed characters, and the next case is the
-# exit case on reaching the end of the string or finding a delimiter.
-#
-# Otherwise, we've found an unquoted thing and we pull of characters one
-# at a time until we reach something that could start another $snippet--
-# a quote of some sort, a backslash, or the delimiter.  This one character
-# at a time behavior was necessary if the delimiter was going to be a
-# regexp (love to hear it if you can figure out a better way).
-
-    my ($delim, $keep, @lines) = @_;
-    my (@words, $snippet, $field);
-
-    local $_ = join ('', @lines);
-
-    while (length) {
-	$field = '';
+sub parse_line {
+    my($delimiter, $keep, $line) = @_;
+    my($quote, $quoted, $unquoted, $delim, $word, @pieces);
 
-	for (;;) {
-	    $snippet = '';
+    while (length($line)) {
+	($quote, $quoted, $unquoted, $delim) =
+	    $line =~ m/^(["'])                 # a $quote
+                        ((?:\\.|[^\1\\])*?)    # and $quoted text
+                        \1                     # followed by the same quote
+		       |                       # --OR--
+                       ^((?:\\.|[^\\"'])*?)    # an $unquoted text
+                        (\Z(?!\n)|$delimiter|(?!^)(?=["']))  
+                                               # plus EOL, delimiter, or quote
+                      /x;                      # extended layout
 
-	    if (s/^"([^"\\]*(\\.[^"\\]*)*)"//) {
-		$snippet = $1;
-		$snippet = qq|"$snippet"| if $keep;
-	    }
-	    elsif (s/^'([^'\\]*(\\.[^'\\]*)*)'//) {
-		$snippet = $1;
-		$snippet = "'$snippet'" if $keep;
-	    }
-	    elsif (/^["']/) {
-		croak 'Unmatched quote';
-	    }
-	    elsif (s/^\\(.)//) {
-		$snippet = $1;
-		$snippet = "\\$snippet" if $keep;
-	    }
-	    elsif (!length || s/^$delim//) {
-	       last;
-	    }
-	    else {
-		while (length && !(/^$delim/ || /^['"\\]/)) {
-		   $snippet .= substr ($_, 0, 1);
-		   substr($_, 0, 1) = '';
-		}
-	    }
+        return() unless(length($&));
+        $line = $';
 
-	    $field .= $snippet;
+        if ($keep) {
+	    $quoted = "$quote$quoted$quote";
+	}
+        else {
+	    $unquoted =~ s/\\(.)/$1/g;
+	    $quoted =~ s/\\(.)/$1/g if ($quote eq '"');
+	}
+        $word .= ($quote) ? $quoted : $unquoted;
+ 
+        if (length($delim)) {
+            push(@pieces, $word);
+            push(@pieces, $delim) if ($keep eq 'delimiters');
+            undef $word;
+        }
+        if (!length($line)) {
+            push(@pieces, $word);
 	}
-
-	push @words, $field;
     }
-
-    return @words;
+    return(@pieces);
 }
 
 
+
 sub old_shellwords {
 
     # Usage:
@@ -154,13 +107,13 @@ sub old_shellwords {
 		($snippet = $1) =~ s#\\(.)#$1#g;
 	    }
 	    elsif (/^"/) {
-		croak "Unmatched double quote: $_";
+		return();
 	    }
 	    elsif (s/^'(([^'\\]|\\.)*)'//) {
 		($snippet = $1) =~ s#\\(.)#$1#g;
 	    }
 	    elsif (/^'/) {
-		croak "Unmatched single quote: $_";
+		return();
 	    }
 	    elsif (s/^\\(.)//) {
 		$snippet = $1;
@@ -178,3 +131,117 @@ sub old_shellwords {
     }
     @words;
 }
+
+1;
+
+__END__
+
+=head1 NAME
+
+Text::ParseWords - parse text into an array of tokens or array of arrays
+
+=head1 SYNOPSIS
+
+  use Text::ParseWords;
+  @lists = &nested_quotewords($delim, $keep, @lines);
+  @words = &quotewords($delim, $keep, @lines);
+  @words = &shellwords(@lines);
+  @words = &parse_line($delim, $keep, $line);
+  @words = &old_shellwords(@lines); # DEPRECATED!
+
+=head1 DESCRIPTION
+
+The &nested_quotewords() and &quotewords() functions accept a delimiter 
+(which can be a regular expression)
+and a list of lines and then breaks those lines up into a list of
+words ignoring delimiters that appear inside quotes.  &quotewords()
+returns all of the tokens in a single long list, while &nested_quotewords()
+returns a list of token lists corresponding to the elements of @lines.
+&parse_line() does tokenizing on a single string.  The &*quotewords()
+functions simply call &parse_lines(), so if you're only splitting
+one line you can call &parse_lines() directly and save a function
+call.
+
+The $keep argument is a boolean flag.  If true, then the tokens are
+split on the specified delimiter, but all other characters (quotes,
+backslashes, etc.) are kept in the tokens.  If $keep is false then the
+&*quotewords() functions remove all quotes and backslashes that are
+not themselves backslash-escaped or inside of single quotes (i.e.,
+&quotewords() tries to interpret these characters just like the Bourne
+shell).  NB: these semantics are significantly different from the
+original version of this module shipped with Perl 5.000 through 5.004.
+As an additional feature, $keep may be the keyword "delimiters" which
+causes the functions to preserve the delimiters in each string as
+tokens in the token lists, in addition to preserving quote and
+backslash characters.
+
+&shellwords() is written as a special case of &quotewords(), and it
+does token parsing with whitespace as a delimiter-- similar to most
+Unix shells.
+
+=head1 EXAMPLES
+
+The sample program:
+
+  use Text::ParseWords;
+  @words = &quotewords('\s+', 0, q{this   is "a test" of\ quotewords \"for you});
+  $i = 0;
+  foreach (@words) {
+      print "$i: <$_>\n";
+      $i++;
+  }
+
+produces:
+
+  0: <this>
+  1: <is>
+  2: <a test>
+  3: <of quotewords>
+  4: <"for>
+  5: <you>
+
+demonstrating:
+
+=over 4
+
+=item 0
+a simple word
+
+=item 1
+multiple spaces are skipped because of our $delim
+
+=item 2
+use of quotes to include a space in a word
+
+=item 3
+use of a backslash to include a space in a word
+
+=item 4
+use of a backslash to remove the special meaning of a double-quote
+
+=item 5
+another simple word (note the lack of effect of the
+backslashed double-quote)
+
+=back
+
+Replacing C<&quotewords('\s+', 0, q{this   is...})>
+with C<&shellwords(q{this   is...})>
+is a simpler way to accomplish the same thing.
+
+=head1 AUTHORS
+
+Maintainer is Hal Pomeranz <pomeranz@netcom.com>, 1994-1997 (Original
+author unknown).  Much of the code for &parse_line() (including the
+primary regexp) from Joerk Behrends <jbehrends@multimediaproduzenten.de>.
+
+Examples section another documentation provided by John Heidemann 
+<johnh@ISI.EDU>
+
+Bug reports, patches, and nagging provided by lots of folks-- thanks
+everybody!  Special thanks to Michael Schwern <schwern@envirolink.org>
+for assuring me that a &nested_quotewords() would be useful, and to 
+Jeff Friedl <jfriedl@yahoo-inc.com> for telling me not to worry about
+error-checking (sort of-- you had to be there).
+
+=cut
diff --git a/lib/Text/Wrap.pm b/lib/Text/Wrap.pm
index 0910a2ab34..0fe7fb93c2 100644
--- a/lib/Text/Wrap.pm
+++ b/lib/Text/Wrap.pm
@@ -1,71 +1,74 @@
 package Text::Wrap;
 
-require Exporter;
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $columns $debug);
+use strict;
+use Exporter;
 
-@ISA = (Exporter);
+$VERSION = "97.02";
+@ISA = qw(Exporter);
 @EXPORT = qw(wrap);
-@EXPORT_OK = qw($columns);
+@EXPORT_OK = qw($columns $tabstop fill);
 
-$VERSION = 97.011701;
+use Text::Tabs qw(expand unexpand $tabstop);
 
-use vars qw($VERSION $columns $debug);
-use strict;
 
 BEGIN	{
-	$columns = 76;  # <= screen width
-	$debug = 0;
+    $columns = 76;  # <= screen width
+    $debug = 0;
 }
 
-use Text::Tabs qw(expand unexpand);
-
 sub wrap
 {
-	my ($ip, $xp, @t) = @_;
-
-	my $r = "";
-	my $t = expand(join(" ",@t));
-	my $lead = $ip;
-	my $ll = $columns - length(expand($lead)) - 1;
-	my $nl = "";
-
-	# remove up to a line length of things that aren't
-	# new lines and tabs.
-
-	if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm) {
-
-		# accept it.
-		$r .= unexpand($lead . $1);
-
-		# recompute the leader
-		$lead = $xp;
-		$ll = $columns - length(expand($lead)) - 1;
-		$nl = $2;
-
-		# repeat the above until there's none left
-		while ($t) {
-			if ( $t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//xm ) {
-				print "\$2 is '$2'\n" if $debug;
-				$nl = $2;
-				$r .= unexpand("\n" . $lead . $1);
-			} elsif ($t =~ s/^([^\n]{$ll})//) {
-				$nl = "\n";
-				$r .= unexpand("\n" . $lead . $1);
-			}
-		}
-		$r .= $nl;
-	} 
+    my ($ip, $xp, @t) = @_;
+
+    my @rv;
+    my $t = expand(join(" ",@t));
+
+    my $lead = $ip;
+    my $ll = $columns - length(expand($lead)) - 1;
+    my $nl = "";
+
+    $t =~ s/^\s+//;
+    while(length($t) > $ll) {
+	# remove up to a line length of things that
+	# aren't new lines and tabs.
+	if ($t =~ s/^([^\n]{0,$ll})(\s|\Z(?!\n))//) {
+	    my ($l,$r) = ($1,$2);
+	    $l =~ s/\s+$//;
+	    print "WRAP  $lead$l..($r)\n" if $debug;
+	    push @rv, unexpand($lead . $l), "\n";
+		
+	} elsif ($t =~ s/^([^\n]{$ll})//) {
+	    print "SPLIT $lead$1..\n" if $debug;
+	    push @rv, unexpand($lead . $1),"\n";
+	}
+	# recompute the leader
+	$lead = $xp;
+	$ll = $columns - length(expand($lead)) - 1;
+	$t =~ s/^\s+//;
+    } 
+    print "TAIL  $lead$t\n" if $debug;
+    push @rv, $lead.$t if $t ne "";
+    return join '', @rv;
+}
 
-	die "couldn't wrap '$t'" 
-		if length($t) > $ll;
 
-	print "-----------$r---------\n" if $debug;
+sub fill 
+{
+	my ($ip, $xp, @raw) = @_;
+	my @para;
+	my $pp;
 
-	print "Finish up with '$lead', '$t'\n" if $debug;
+	for $pp (split(/\n\s+/, join("\n",@raw))) {
+		$pp =~ s/\s+/ /g;
+		my $x = wrap($ip, $xp, $pp);
+		push(@para, $x);
+	}
 
-	$r .= $lead . $t if $t ne "";
+	# if paragraph_indent is the same as line_indent, 
+	# separate paragraphs with blank lines
 
-	print "-----------$r---------\n" if $debug;;
-	return $r;
+	return join ($ip eq $xp ? "\n\n" : "\n", @para);
 }
 
 1;
@@ -81,9 +84,13 @@ Text::Wrap - line wrapping to form simple paragraphs
 
 	print wrap($initial_tab, $subsequent_tab, @text);
 
-	use Text::Wrap qw(wrap $columns);
+	use Text::Wrap qw(wrap $columns $tabstop fill);
 
 	$columns = 132;
+	$tabstop = 4;
+
+	print fill($initial_tab, $subsequent_tab, @text);
+	print fill("", "", `cat book`);
 
 =head1 DESCRIPTION
 
@@ -93,6 +100,12 @@ Indentation is controlled for the first line ($initial_tab) and
 all subsquent lines ($subsequent_tab) independently.  $Text::Wrap::columns
 should be set to the full width of your output device.
 
+Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
+each paragraph separately and then joins them together when it's done.  It
+will destory any whitespace in the original text.  It breaks text into
+paragraphs by looking for whitespace after a newline.  In other respects
+it acts like wrap().
+
 =head1 EXAMPLE
 
 	print wrap("\t","","This is a bit of text that forms 
@@ -102,44 +115,11 @@ should be set to the full width of your output device.
 
 It's not clear what the correct behavior should be when Wrap() is
 presented with a word that is longer than a line.  The previous 
-behavior was to die.  Now the word is split at line-length.
+behavior was to die.  Now the word is now split at line-length.
 
 =head1 AUTHOR
 
 David Muir Sharnoff <muir@idiom.com> with help from Tim Pierce and
-others.
+others. Updated by Jacqui Caren.
 
 =cut
-
-Latest change by Andreas Koenig <k@anna.in-berlin.de> - 1/17/97
-
-	print fill($initial_tab, $subsequent_tab, @text);
-
-	print fill("", "", `cat book`);
-
-Text::Wrap::fill() is a simple multi-paragraph formatter.  It formats
-each paragraph separately and then joins them together when it's done.  It
-will destory any whitespace in the original text.  It breaks text into
-paragraphs by looking for whitespace after a newline.  In other respects
-it acts like wrap().
-
-# Tim Pierce did a faster version of this:
-
-sub fill 
-{
-	my ($ip, $xp, @raw) = @_;
-	my @para;
-	my $pp;
-
-	for $pp (split(/\n\s+/, join("\n",@raw))) {
-		$pp =~ s/\s+/ /g;
-		my $x = wrap($ip, $xp, $pp);
-		push(@para, $x);
-	}
-
-	# if paragraph_indent is the same as line_indent, 
-	# separate paragraphs with blank lines
-
-	return join ($ip eq $xp ? "\n\n" : "\n", @para);
-}
-
diff --git a/lib/base.pm b/lib/base.pm
index e20a64bc9a..4c4fb8b86b 100644
--- a/lib/base.pm
+++ b/lib/base.pm
@@ -34,6 +34,9 @@ sub import {
     foreach my $base (@_) {
 	unless (defined %{"$base\::"}) {
 	    eval "require $base";
+	    # Only ignore "Can't locate" errors from our eval require.
+	    # Other fatal errors (syntax etc) must be reported.
+	    die if $@ && $@ !~ /^Can't locate .*? at \(eval /;
 	    unless (defined %{"$base\::"}) {
 		require Carp;
 		Carp::croak("Base class package \"$base\" is empty.\n",
diff --git a/perl.c b/perl.c
index 88c0837ac6..16c5b9fd7f 100644
--- a/perl.c
+++ b/perl.c
@@ -2795,10 +2795,16 @@ my_failure_exit(void)
 	    STATUS_NATIVE_SET(vaxc$errno);
     }
 #else
+    int exitstatus;
     if (errno & 255)
 	STATUS_POSIX_SET(errno);
-    else if (STATUS_POSIX == 0)
-	STATUS_POSIX_SET(255);
+    else {
+	exitstatus = STATUS_POSIX >> 8; 
+	if (exitstatus & 255)
+	    STATUS_POSIX_SET(exitstatus);
+	else
+	    STATUS_POSIX_SET(255);
+    }
 #endif
     my_exit_jump();
 }
diff --git a/pod/perlre.pod b/pod/perlre.pod
index e985377586..95da75d95f 100644
--- a/pod/perlre.pod
+++ b/pod/perlre.pod
@@ -704,4 +704,10 @@ different things on the I<left> side of the C<s///>.
 
 =head2 SEE ALSO
 
+L<perlop/"Regexp Quote-Like Operators">.
+
+L<perlfunc/pos>.
+
+L<perllocale>.
+
 "Mastering Regular Expressions" (see L<perlbook>) by Jeffrey Friedl.
diff --git a/t/lib/io_sock.t b/t/lib/io_sock.t
index 0971e7803f..9fab56b237 100755
--- a/t/lib/io_sock.t
+++ b/t/lib/io_sock.t
@@ -55,11 +55,14 @@ if($pid = fork()) {
     # This can fail if localhost is undefined or the
     # special 'loopback' address 127.0.0.1 is not configured
     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+    # As a shortcut (not recommended) you could change 'localhost'
+    # here to be the name of this machine eg 'myhost.mycompany.com'.
 
     $sock = IO::Socket::INET->new(PeerPort => $port,
 				  Proto => 'tcp',
 				  PeerAddr => 'localhost'
-				 ) or die "$!";
+				 )
+	    or die "$! (maybe your system does not have the 'localhost' address defined)";
 
     $sock->autoflush(1);
 
diff --git a/t/lib/io_udp.t b/t/lib/io_udp.t
index 3e16714118..014e12dc58 100755
--- a/t/lib/io_udp.t
+++ b/t/lib/io_udp.t
@@ -30,9 +30,13 @@ use IO::Socket qw(AF_INET SOCK_DGRAM INADDR_ANY);
     # This can fail if localhost is undefined or the
     # special 'loopback' address 127.0.0.1 is not configured
     # on your system. (/etc/rc.config.d/netconfig on HP-UX.)
+    # As a shortcut (not recommended) you could change 'localhost'
+    # here to be the name of this machine eg 'myhost.mycompany.com'.
 
-$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
-$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost');
+$udpa = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+    or die "$! (maybe your system does not have the 'localhost' address defined)";
+$udpb = IO::Socket::INET->new(Proto => 'udp', LocalAddr => 'localhost')
+    or die "$! (maybe your system does not have the 'localhost' address defined)";
 
 print "ok 1\n";
 
diff --git a/t/lib/parsewords.t b/t/lib/parsewords.t
index 47a75881dc..21ed0d3eae 100755
--- a/t/lib/parsewords.t
+++ b/t/lib/parsewords.t
@@ -5,24 +5,77 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..4\n";
-
 use Text::ParseWords;
 
-@words = shellwords(qq(foo "bar quiz" zoo));
-#print join(";", @words), "\n";
+print "1..15\n";
 
+@words = shellwords(qq(foo "bar quiz" zoo));
 print "not " if $words[0] ne 'foo';
 print "ok 1\n";
-
 print "not " if $words[1] ne 'bar quiz';
 print "ok 2\n";
-
 print "not " if $words[2] ne 'zoo';
 print "ok 3\n";
 
-# Test quotewords() with other parameters
-@words = quotewords(":+", 1, qq(foo:::"bar:foo":zoo zoo:));
-#print join(";", @words), "\n";
-print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo);
+# Test quotewords() with other parameters and null last field
+@words = quotewords(':+', 1, 'foo:::"bar:foo":zoo zoo:');
+print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo;);
 print "ok 4\n";
+
+# Test $keep eq 'delimiters' and last field zero
+@words = quotewords('\s+', 'delimiters', '4 3 2 1 0');
+print "not " unless join(";", @words) eq qq(4; ;3; ;2; ;1; ;0);
+print "ok 5\n";
+
+# Big ol' nasty test (thanks, Joerk!)
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd" eee\\\\\\"ffff" "gg"';
+
+# First with $keep == 1
+$result = join('|', parse_line('\s+', 1, $string));
+print "not " unless $result eq 'aaaa"bbbbb"|cc\\ cc|\\\\\\"dddd" eee\\\\\\"ffff"|"gg"';
+print "ok 6\n";
+
+# Now, $keep == 0
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\"ffff|gg';
+print "ok 7\n";
+
+# Now test single quote behavior
+$string = 'aaaa"bbbbb" cc\\ cc \\\\\\"dddd\' eee\\\\\\"ffff\' gg';
+$result = join('|', parse_line('\s+', 0, $string));
+print "not " unless $result eq 'aaaabbbbb|cc cc|\\"dddd eee\\\\\\"ffff|gg';
+print "ok 8\n";
+
+# Make sure @nested_quotewords does the right thing
+@lists = nested_quotewords('\s+', 0, 'a b c', '1 2 3', 'x y z');
+print "not " unless (@lists == 3 && @{$lists[0]} == 3 && @{$lists[1]} == 3 && @{$lists[2]} == 3);
+print "ok 9\n";
+
+# Now test error return
+$string = 'foo bar baz"bach blech boop';
+
+@words = shellwords($string);
+print "not " if (@words);
+print "ok 10\n";
+
+@words = parse_line('s+', 0, $string);
+print "not " if (@words);
+print "ok 11\n";
+
+@words = quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 12\n";
+
+@words = nested_quotewords('s+', 0, $string);
+print "not " if (@words);
+print "ok 13\n";
+
+# Now test empty fields
+$result = join('|', parse_line(':', 0, 'foo::0:"":::'));
+print "not " unless ($result eq 'foo||0||||');
+print "ok 14\n";
+
+# Test for 0 in quotes without $keep
+$result = join('|', parse_line(':', 0, ':"0":'));
+print "not " unless ($result eq '|0|');
+print "ok 15\n";
diff --git a/t/lib/timelocal.t b/t/lib/timelocal.t
index 938ca695b1..100e0768aa 100755
--- a/t/lib/timelocal.t
+++ b/t/lib/timelocal.t
@@ -11,7 +11,7 @@ use Time::Local;
 @time =
   (
    #year,mon,day,hour,min,sec 
-   [1970,  1,  1, 00, 00, 00],
+   [1970,  1,  2, 00, 00, 00],
    [1980,  2, 28, 12, 00, 00],
    [1980,  2, 29, 12, 00, 00],
    [1999, 12, 31, 23, 59, 59],
diff --git a/t/op/die_exit.t b/t/op/die_exit.t
new file mode 100755
index 0000000000..b01dd35a97
--- /dev/null
+++ b/t/op/die_exit.t
@@ -0,0 +1,48 @@
+#!./perl
+
+#
+# Verify that C<die> return the return code
+#	-- Robin Barker <rmb@cise.npl.co.uk>
+#
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -e '../lib';
+}
+my $perl = -e '../perl' ? '../perl' : -e './perl' ? './perl' : 'perl';
+
+use strict;
+
+my %tests = (
+	 1 => [   0,   0],
+	 2 => [   0,   1], 
+	 3 => [   0, 127], 
+	 4 => [   0, 128], 
+	 5 => [   0, 255], 
+	 6 => [   0, 256], 
+	 7 => [   0, 512], 
+	 8 => [   1,   0],
+	 9 => [   1,   1],
+	10 => [   1, 256],
+	11 => [ 128,   0],
+	12 => [ 128,   1],
+	13 => [ 128, 256],
+	14 => [ 255,   0],
+	15 => [ 255,   1],
+	16 => [ 255, 256],
+);
+
+my $max = keys %tests;
+
+print "1..$max\n";
+
+foreach my $test (1 .. $max) {
+    my($bang, $query) = @{$tests{$test}};
+    my $exit =
+	system qq($perl -e '\$! = $bang; \$? = $query; die;' 2> /dev/null);
+
+    printf "# 0x%04x  0x%04x  0x%04x\nnot ", $exit, $bang, $query
+	unless $exit == (($bang || ($query >> 8) || 255) << 8);
+    print "ok $test\n";
+}
+    
diff --git a/t/op/ipcmsg.t b/t/op/ipcmsg.t
new file mode 100755
index 0000000000..336d6d1253
--- /dev/null
+++ b/t/op/ipcmsg.t
@@ -0,0 +1,124 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my @define;
+
+BEGIN {
+    @define = qw(
+	IPC_PRIVATE
+	IPC_RMID
+	IPC_NOWAIT
+	IPC_STAT
+	S_IRWXU
+	S_IRWXG
+	S_IRWXO
+    );
+}
+
+use Config;
+use vars map { '$' . $_ } @define;
+
+BEGIN {
+    unless($Config{'d_msgget'} eq 'define' &&
+	   $Config{'d_msgctl'} eq 'define' &&
+	   $Config{'d_msgsnd'} eq 'define' &&
+	   $Config{'d_msgrcv'} eq 'define') {
+	print "0..0\n";
+	exit;
+    }
+    my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
+    my %done = ();
+    my %define = ();
+
+    sub process_file {
+	my($file) = @_;
+
+	return unless defined $file;
+
+	my $path = undef;
+	my $dir;
+	foreach $dir (@incpath) {
+	    my $tmp = $dir . "/" . $file;
+	    next unless -r $tmp;
+	    $path = $tmp;
+	    last;
+	}
+
+	return if exists $done{$path};
+	$done{$path} = 1;
+
+	unless(defined $path) {
+	    warn "Cannot find '$file'";
+	    return;
+	}
+
+	open(F,$path) or return;
+	while(<F>) {
+	    s#/\*.*(\*/|$)##;
+
+	    process_file($mm,$1)
+		    if /^#\s*include\s*[<"]([^>"]+)[>"]/;
+
+	    s/(?:\([^)]*\)\s*)//;
+
+	    $define{$1} = $2
+		if /^#\s*define\s+(\w+)\s+((0x)?\d+|\w+)/;
+       }
+       close(F);
+    }
+
+    process_file("sys/sem.h");
+    process_file("sys/ipc.h");
+    process_file("sys/stat.h");
+
+    foreach $d (@define) {
+	while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
+	    $define{$d} = exists $define{$define{$d}}
+		    ? $define{$define{$d}} : undef;
+	}
+	unless(defined $define{$d}) {
+	    print "0..0\n";
+	    exit;
+	};
+	${ $d } = eval $define{$d};
+    }
+}
+
+use strict;
+
+print "1..6\n";
+
+my $msg = msgget($IPC_PRIVATE, $S_IRWXU | $S_IRWXG | $S_IRWXO)
+	|| die "msgget failed: $!\n";
+
+print "ok 1\n";
+
+#Putting a message on the queue
+my $msgtype = 1;
+my $msgtext = "hello";
+
+msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not ";
+print "ok 2\n";
+
+my $data;
+msgctl($msg,$IPC_STAT,$data) or print "not ";
+print "ok 3\n";
+
+print "not " unless length($data);
+print "ok 4\n";
+
+my $msgbuf;
+msgrcv($msg,$msgbuf,256,0,$IPC_NOWAIT) or print "not ";
+print "ok 5\n";
+
+my($rmsgtype,$rmsgtext) = unpack("L a*",$msgbuf);
+
+print "not " unless($rmsgtype == $msgtype && $rmsgtext eq $msgtext);
+print "ok 6\n";
+
+msgctl($msg,$IPC_RMID,0);
+
diff --git a/t/op/ipcsem.t b/t/op/ipcsem.t
new file mode 100755
index 0000000000..abe32fbf51
--- /dev/null
+++ b/t/op/ipcsem.t
@@ -0,0 +1,136 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+my @define;
+
+BEGIN {
+    @define = qw(
+	GETALL
+	SETALL
+	IPC_PRIVATE
+	IPC_CREAT
+	IPC_RMID
+	IPC_STAT
+	S_IRWXU
+	S_IRWXG
+	S_IRWXO
+    );
+}
+
+use Config;
+use vars map { '$' . $_ } @define;
+
+BEGIN {
+    unless($Config{'d_semget'} eq 'define' &&
+	   $Config{'d_semctl'} eq 'define') {
+	print "0..0\n";
+	exit;
+    }
+    my @incpath = (split(/\s+/, $Config{usrinc}), split(/\s+/ ,$Config{locincpth}));
+    my %done = ();
+    my %define = ();
+
+    sub process_file {
+	my($file) = @_;
+
+	return unless defined $file;
+
+	my $path = undef;
+	my $dir;
+	foreach $dir (@incpath) {
+	    my $tmp = $dir . "/" . $file;
+	    next unless -r $tmp;
+	    $path = $tmp;
+	    last;
+	}
+
+	return if exists $done{$path};
+	$done{$path} = 1;
+
+	unless(defined $path) {
+	    warn "Cannot find '$file'";
+	    return;
+	}
+
+	open(F,$path) or return;
+	while(<F>) {
+	    s#/\*.*(\*/|$)##;
+
+	    process_file($mm,$1)
+		    if /^#\s*include\s*[<"]([^>"]+)[>"]/;
+
+	    s/(?:\([^)]*\)\s*)//;
+
+	    $define{$1} = $2
+		if /^#\s*define\s+(\w+)\s+((0x)?\d+|\w+)/;
+       }
+       close(F);
+    }
+
+    process_file("sys/sem.h");
+    process_file("sys/ipc.h");
+    process_file("sys/stat.h");
+
+    foreach $d (@define) {
+	while(defined($define{$d}) && $define{$d} !~ /^(0x)?\d+$/) {
+	    $define{$d} = exists $define{$define{$d}}
+		    ? $define{$define{$d}} : undef;
+	}
+	unless(defined $define{$d}) {
+	    print "0..0\n";
+	    exit;
+	};
+	${ $d } = eval $define{$d};
+    }
+}
+
+use strict;
+
+print "1..10\n";
+
+my $sem = semget($IPC_PRIVATE, 10, $S_IRWXU | $S_IRWXG | $S_IRWXO | $IPC_CREAT)
+	|| die "semget: $!\n";
+
+print "ok 1\n";
+
+my $data;
+semctl($sem,0,$IPC_STAT,$data) or print "not ";
+print "ok 2\n";
+
+print "not " unless length($data);
+print "ok 3\n";
+
+semctl($sem,0,$SETALL,pack("s*",(0) x 10)) or print "not ";
+print "ok 4\n";
+
+$data = "";
+semctl($sem,0,$GETALL,$data) or print "not ";
+print "ok 5\n";
+
+print "not " unless length($data);
+print "ok 6\n";
+
+my @data = unpack("s*",$data);
+
+print "not " unless join("",@data) eq "0000000000";
+print "ok 7\n";
+
+$data[2] = 1;
+semctl($sem,0,$SETALL,pack("s*",@data)) or print "not ";
+print "ok 8\n";
+
+$data = "";
+semctl($sem,0,$GETALL,$data) or print "not ";
+print "ok 9\n";
+
+@data = unpack("s*",$data);
+
+print "not " unless join("",@data) eq "0010000000";
+print "ok 10\n";
+
+semctl($sem,0,$IPC_RMID,undef);
+
diff --git a/t/op/stat.t b/t/op/stat.t
index 9d4b3a6787..c7cd0961f3 100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -45,7 +45,12 @@ else {
 if ($Is_MSWin32 || $Is_Dos || $Config{dont_use_nlink} || $nlink == 2)
     {print "ok 3\n";} else {print "# \$nlink is |$nlink|\nnot ok 3\n";}
 
-if ($Is_MSWin32 || $Is_Dos || ($mtime && $mtime != $ctime) || $cwd =~ m#/afs/# || $^O eq 'amigaos') {
+if (   ($mtime && $mtime != $ctime)
+	|| $Is_MSWin32
+	|| $Is_Dos
+	|| ($cwd eq '/tmp' and $mtime && $mtime==$ctime) # Solaris tmpfs bug
+	|| $cwd =~ m#/afs/#
+	|| $^O eq 'amigaos') {
     print "ok 4\n";
 }
 else {
@@ -53,7 +58,7 @@ else {
     print "#4 If test op/stat.t fails test 4, check if you are on a tmpfs\n";
     print "#4 of some sort.  Building in /tmp sometimes has this problem.\n";
 }
-print "#4	:$mtime: != :$ctime:\n";
+print "#4	:$mtime: should != :$ctime:\n";
 
 unlink "Op.stat.tmp";
 if ($Is_MSWin32) {  open F, '>Op.stat.tmp' and close F }
diff --git a/toke.c b/toke.c
index 5605938274..2282ef7e54 100644
--- a/toke.c
+++ b/toke.c
@@ -768,6 +768,12 @@ sublex_done(void)
   processing a pattern (lex_inpat is true), a transliteration
   (lex_inwhat & OP_TRANS is true), or a double-quoted string.
 
+  Returns a pointer to the character scanned up to. Iff this is
+  advanced from the start pointer supplied (ie if anything was
+  successfully parsed), will leave an OP for the substring scanned
+  in yylval. Caller must intuit reason for not parsing further
+  by looking at the next characters herself.
+
   In patterns:
     backslashes:
       double-quoted style: \r and \n
@@ -835,17 +841,11 @@ scan_const(char *start)
     bool dorange = FALSE;			/* are we in a translit range? */
     I32 len;					/* ? */
 
-    /*
-      leave is the set of acceptably-backslashed characters.
-
-      I do *not* understand why there's the double hook here.
-    */
+    /* leaveit is the set of acceptably-backslashed characters */
     char *leaveit =
 	lex_inpat
 	    ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
-	    : (lex_inwhat & OP_TRANS)
-		? ""
-		: "";
+	    : "";
 
     while (s < send || dorange) {
         /* get transliterations out of the way (they're most literal) */
@@ -1032,7 +1032,7 @@ scan_const(char *start)
 	Renew(SvPVX(sv), SvLEN(sv), char);
     }
 
-    /* ??? */
+    /* return the substring (via yylval) only if we parsed anything */
     if (s > bufptr)
 	yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
     else