Integrate with Sarathy.

p4raw-id: //depot/cfgperl@5639

5 files changed, 109 insertions, 53 deletions

diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp
index 08e7436760..96e1bb44c4 100755
--- a/lib/ExtUtils/xsubpp
+++ b/lib/ExtUtils/xsubpp
@@ -273,7 +273,7 @@ $END = "!End!\n\n";		# "impossible" keyword (multiple newline)
 $BLOCK_re= '\s*(' . join('|', qw(
 	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
 	CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
-	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POST_CALL
+	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL
 	)) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -436,7 +436,7 @@ sub INPUT_handler {
 	    $func_args =~ s/\b($var_name)\b/&$1/;
 	}
 	if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/
-	    or $in_out{$var_name} and $in_out{$var_name} eq 'outlist'
+	    or $in_out{$var_name} and $in_out{$var_name} eq 'OUTLIST'
 	    and $var_init !~ /\S/) {
 	  if ($name_printed) {
 	    print ";\n";
@@ -522,7 +522,7 @@ EOF
 
 sub CLEANUP_handler() { print_section() } 
 sub PREINIT_handler() { print_section() } 
-sub POST_CALL_handler() { print_section() } 
+sub POSTCALL_handler() { print_section() } 
 sub INIT_handler()    { print_section() } 
 
 sub GetAliases
@@ -1041,10 +1041,10 @@ while (fetch_para()) {
 		next unless length $pre;
 		my $out_type;
 		my $inout_var;
-		if ($process_inout and s/^(in|in_outlist|outlist)\s+//) {
+		if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) {
 		    my $type = $1;
-		    $out_type = $type if $type ne 'in';
-		    $arg =~ s/^(in|in_outlist|outlist)\s+//;
+		    $out_type = $type if $type ne 'IN';
+		    $arg =~ s/^(IN|IN_OUTLIST|OUTLIST)\s+//;
 		}
 		if (/\W/) {	# Has a type
 		    push @arg_with_types, $arg;
@@ -1052,7 +1052,7 @@ while (fetch_para()) {
 		    $arg_types{$name} = $arg;
 		    $_ = "$name$default";
 		}
-		$out_vars{$_} = 1 if $out_type eq 'outlist';
+		$out_vars{$_} = 1 if $out_type eq 'OUTLIST';
 		push @in_out, $name if $out_type;
 		$in_out{$name} = $out_type if $out_type;
 	    }
@@ -1063,10 +1063,10 @@ while (fetch_para()) {
     } else {
 	@args = split(/\s*,\s*/, $orig_args);
 	for (@args) {
-	    if ($process_inout and s/^(in|in_outlist|outlist)\s+//) {
+	    if ($process_inout and s/^(IN|IN_OUTLIST|OUTLIST)\s+//) {
 		my $out_type = $1;
-		next if $out_type eq 'in';
-		$out_vars{$_} = 1 if $out_type eq 'outlist';
+		next if $out_type eq 'IN';
+		$out_vars{$_} = 1 if $out_type eq 'OUTLIST';
 		push @in_out, $name;
 		$in_out{$_} = $out_type;
 	    }
@@ -1278,7 +1278,7 @@ EOF
 	# $wantRETVAL set if 'RETVAL =' autogenerated
 	($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return;
 	undef %outargs ;
-	process_keyword("POST_CALL|OUTPUT|ALIAS|PROTOTYPE"); 
+	process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE"); 
 
 	# all OUTPUT done, so now push the return value on the stack
 	if ($gotRETVAL && $RETVAL_code) {
diff --git a/lib/bytes.pm b/lib/bytes.pm
index ae7b5fbf5a..f93d6158d9 100644
--- a/lib/bytes.pm
+++ b/lib/bytes.pm
@@ -32,7 +32,7 @@ bytes - Perl pragma to force byte semantics rather than character semantics
 =head1 DESCRIPTION
 
 WARNING: The implementation of Unicode support in Perl is incomplete.
-Expect sudden and unannounced changes!
+See L<perlunicode> for the exact details.
 
 The C<use bytes> pragma disables character semantics for the rest of the
 lexical scope in which it appears.  C<no bytes> can be used to reverse
diff --git a/lib/open.pm b/lib/open.pm
index da8a04453c..8f5c13833b 100644
--- a/lib/open.pm
+++ b/lib/open.pm
@@ -1,4 +1,27 @@
 package open;
+$open::hint_bits = 0x20000;
+
+sub import {
+    shift;
+    die "`use open' needs explicit list of disciplines" unless @_;
+    $^H |= $open::hint_bits;
+    while (@_) {
+	my $type = shift;
+	if ($type =~ /^(IN|OUT)\z/s) {
+	    my $discp = shift;
+	    unless ($discp =~ /^\s*:(raw|crlf)\s*\z/s) {
+		die "Unknown discipline '$discp'";
+	    }
+	    $^H{"open_$type"} = $discp;
+	}
+	else {
+	    die "Unknown discipline class '$type'";
+	}
+    }
+}
+
+1;
+__END__
 
 =head1 NAME
 
@@ -6,31 +29,48 @@ open - perl pragma to set default disciplines for input and output
 
 =head1 SYNOPSIS
 
-    use open IN => ":any", OUT => ":utf8";	# unimplemented
+    use open IN => ":crlf", OUT => ":raw";
 
 =head1 DESCRIPTION
 
-NOTE: This pragma is not yet implemented.
-
 The open pragma is used to declare one or more default disciplines for
-I/O operations.  Any constructors for file, socket, pipe, or directory
-handles found within the lexical scope of this pragma will use the
-declared default.
+I/O operations.  Any open() and readpipe() (aka qx//) operators found
+within the lexical scope of this pragma will use the declared defaults.
+Neither open() with an explicit set of disciplines, nor sysopen() are
+not influenced by this pragma.
+
+Only the two pseudo-disciplines ":raw" and ":crlf" are currently
+available.
+
+The ":raw" discipline corresponds to "binary mode" and the ":crlf"
+discipline corresponds to "text mode" on platforms that distinguish
+between the two modes when opening files (which is many DOS-like
+platforms, including Windows).  These two disciplines are currently
+no-ops on platforms where binmode() is a no-op, but will be
+supported everywhere in future.
 
-Handle constructors that are called with an explicit set of disciplines
-are not influenced by the declared defaults.
+=head1 UNIMPLEMENTED FUNCTIONALITY
 
-The default disciplines so declared are available by the special
-discipline name ":def", and can be used within handle constructors
-that allow disciplines to be specified.  This makes it possible to
-stack new disciplines over the default ones.
+Full-fledged support for I/O disciplines is currently unimplemented.
+When they are eventually supported, this pragma will serve as one of
+the interfaces to declare default disciplines for all I/O.
+
+In future, any default disciplines declared by this pragma will be
+available by the special discipline name ":def", and could be used
+within handle constructors that allow disciplines to be specified.
+This would make it possible to stack new disciplines over the default
+ones.
 
     open FH, "<:para :def", $file or die "can't open $file: $!";
 
+Socket and directory handles will also support disciplines in
+future.
+
+Full support for I/O disciplines will enable all of the supported
+disciplines to work on all platforms.
+
 =head1 SEE ALSO
 
-L<perlunicode>, L<perlfunc/"open">
+L<perlfunc/"binmode">, L<perlfunc/"open">, L<perlunicode>
 
 =cut
-
-1;
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index de75bd7d86..7c5b0a909c 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -2,7 +2,7 @@ package DB;
 
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 
-$VERSION = 1.05;
+$VERSION = 1.06;
 $header = "perl5db.pl version $VERSION";
 
 # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich)
@@ -530,7 +530,7 @@ EOP
 			}
 			next CMD; };
 		    $cmd =~ /^t$/ && do {
-			($trace & 1) ? ($trace &= ~1) : ($trace |= 1);
+			$trace ^= 1;
 			print $OUT "Trace = " .
 			    (($trace & 1) ? "on" : "off" ) . "\n";
 			next CMD; };
@@ -700,11 +700,14 @@ EOP
 				}
 			    }
 			}
+			
+			if (not $had_breakpoints{$file} &= ~1) {
+			    delete $had_breakpoints{$file};
+			}
 		      }
 		      undef %postponed;
 		      undef %postponed_file;
 		      undef %break_on_load;
-		      undef %had_breakpoints;
 		      next CMD; };
 		    $cmd =~ /^L$/ && do {
 		      my $file;
@@ -779,7 +782,7 @@ EOP
 			  $break_on_load{$::INC{$file}} = 1 if $::INC{$file};
 			  $file .= '.pm', redo unless $file =~ /\./;
 			}
-			$had_breakpoints{$file} = 1;
+			$had_breakpoints{$file} |= 1;
 			print $OUT "Will stop on load of `@{[join '\', `', sort keys %break_on_load]}'.\n";
 			next CMD; };
 		    $cmd =~ /^b\b\s*(postpone|compile)\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do {
@@ -805,7 +808,7 @@ EOP
 			if ($i) {
 			    local $filename = $file;
 			    local *dbline = $main::{'_<' . $filename};
-			    $had_breakpoints{$filename} = 1;
+			    $had_breakpoints{$filename} |= 1;
 			    $max = $#dbline;
 			    ++$i while $dbline[$i] == 0 && $i < $max;
 			    $dbline{$i} =~ s/^[^\0]*/$cond/;
@@ -814,21 +817,22 @@ EOP
 			}
 			next CMD; };
 		    $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do {
-			$i = ($1?$1:$line);
+			$i = $1 || $line;
 			$cond = $2 || '1';
 			if ($dbline[$i] == 0) {
 			    print $OUT "Line $i not breakable.\n";
 			} else {
-			    $had_breakpoints{$filename} = 1;
+			    $had_breakpoints{$filename} |= 1;
 			    $dbline{$i} =~ s/^[^\0]*/$cond/;
 			}
 			next CMD; };
-		    $cmd =~ /^d\b\s*(\d+)?/ && do {
-			$i = ($1?$1:$line);
+		    $cmd =~ /^d\b\s*(\d*)/ && do {
+			$i = $1 || $line;
 			$dbline{$i} =~ s/^[^\0]*//;
 			delete $dbline{$i} if $dbline{$i} eq '';
 			next CMD; };
 		    $cmd =~ /^A$/ && do {
+		      print $OUT "Deleting all actions...\n";
 		      my $file;
 		      for $file (keys %had_breakpoints) {
 			local *dbline = $main::{'_<' . $file};
@@ -841,6 +845,10 @@ EOP
 				delete $dbline{$i} if $dbline{$i} eq '';
 			    }
 			}
+			
+			if (not $had_breakpoints{$file} &= ~2) {
+			    delete $had_breakpoints{$file};
+			}
 		      }
 		      next CMD; };
 		    $cmd =~ /^O\s*$/ && do {
@@ -872,13 +880,19 @@ EOP
 		        $pretype = [], next CMD unless $1;
 			$pretype = [$1];
 			next CMD; };
-		    $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do {
-			$i = $1; $j = $3;
-			if ($dbline[$i] == 0) {
-			    print $OUT "Line $i may not have an action.\n";
+		    $cmd =~ /^a\b\s*(\d*)\s*(.*)/ && do {
+			$i = $1 || $line; $j = $2;
+			if (length $j) {
+			    if ($dbline[$i] == 0) {
+				print $OUT "Line $i may not have an action.\n";
+			    } else {
+				$had_breakpoints{$filename} |= 2;
+				$dbline{$i} =~ s/\0[^\0]*//;
+				$dbline{$i} .= "\0" . action($j);
+			    }
 			} else {
 			    $dbline{$i} =~ s/\0[^\0]*//;
-			    $dbline{$i} .= "\0" . action($j);
+			    delete $dbline{$i} if $dbline{$i} eq '';
 			}
 			next CMD; };
 		    $cmd =~ /^n$/ && do {
@@ -906,7 +920,7 @@ EOP
 			    if ($i) {
 			        $filename = $file;
 				*dbline = $main::{'_<' . $filename};
-				$had_breakpoints{$filename}++;
+				$had_breakpoints{$filename} |= 1;
 				$max = $#dbline;
 				++$i while $dbline[$i] == 0 && $i < $max;
 			    } else {
@@ -1086,7 +1100,7 @@ EOP
 			next CMD; };
 		    $cmd =~ /^$rc+\s*(-)?(\d+)?$/ && do {
 			pop(@hist) if length($cmd) > 1;
-			$i = $1 ? ($#hist-($2?$2:1)) : ($2?$2:$#hist);
+			$i = $1 ? ($#hist-($2||1)) : ($2||$#hist);
 			$cmd = $hist[$i];
 			print $OUT $cmd, "\n";
 			redo CMD; };
@@ -1301,7 +1315,7 @@ sub postponed_sub {
       $i += $offset;
       local *dbline = $main::{'_<' . $file};
       local $^W = 0;		# != 0 is magical below
-      $had_breakpoints{$file}++;
+      $had_breakpoints{$file} |= 1;
       my $max = $#dbline;
       ++$i until $dbline[$i] != 0 or $i >= $max;
       $dbline{$i} = delete $postponed{$subname};
@@ -1329,7 +1343,7 @@ sub postponed {
     if $break_on_load{$filename};
   print $LINEINFO ' ' x $stack_depth, "Package $filename.\n" if $frame;
   return unless $postponed_file{$filename};
-  $had_breakpoints{$filename}++;
+  $had_breakpoints{$filename} |= 1;
   #%dbline = %{$postponed_file{$filename}}; # Cannot be done: unsufficient magic
   my $key;
   for $key (keys %{$postponed_file{$filename}}) {
@@ -1821,7 +1835,7 @@ B<l> I<min>B<+>I<incr>	List I<incr>+1 lines starting at I<min>.
 B<l> I<min>B<->I<max>	List lines I<min> through I<max>.
 B<l> I<line>		List single I<line>.
 B<l> I<subname>	List first window of lines from subroutine.
-B<l> I<$var>	List first window of lines from subroutine referenced by I<$var>.
+B<l> I<\$var>		List first window of lines from subroutine referenced by I<\$var>.
 B<l>		List next window of lines.
 B<->		List previous window of lines.
 B<w> [I<line>]	List window around I<line>.
@@ -1844,7 +1858,7 @@ B<b> [I<line>] [I<condition>]
 		I<condition> breaks if it evaluates to true, defaults to '1'.
 B<b> I<subname> [I<condition>]
 		Set breakpoint at first line of subroutine.
-B<b> I<$var>	Set breakpoint at first line of subroutine referenced by I<$var>.
+B<b> I<\$var>		Set breakpoint at first line of subroutine referenced by I<\$var>.
 B<b> B<load> I<filename> Set breakpoint on `require'ing the given file.
 B<b> B<postpone> I<subname> [I<condition>]
 		Set breakpoint at first line of subroutine after 
@@ -1854,10 +1868,12 @@ B<b> B<compile> I<subname>
 B<d> [I<line>]	Delete the breakpoint for I<line>.
 B<D>		Delete all breakpoints.
 B<a> [I<line>] I<command>
-		Set an action to be done before the I<line> is executed.
+		Set an action to be done before the I<line> is executed;
+		I<line> defaults to the current execution line.
 		Sequence is: check for breakpoint/watchpoint, print line
 		if necessary, do action, prompt user if necessary,
-		execute expression.
+		execute line.
+B<a> [I<line>]	Delete the action for I<line>.
 B<A>		Delete all actions.
 B<W> I<expr>		Add a global watch-expression.
 B<W>		Delete all watch-expressions.
@@ -1877,14 +1893,14 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
     I<signalLevel> I<warnLevel> I<dieLevel>:	level of verbosity;
     I<inhibit_exit>		Allows stepping off the end of the script.
     I<ImmediateStop>		Debugger should stop as early as possible.
-    I<RemotePort>:		Remote hostname:port for remote debugging
+    I<RemotePort>:			Remote hostname:port for remote debugging
   The following options affect what happens with B<V>, B<X>, and B<x> commands:
     I<arrayDepth>, I<hashDepth>:	print only first N elements ('' for all);
     I<compactDump>, I<veryCompact>:	change style of array and hash dump;
     I<globPrint>:			whether to print contents of globs;
     I<DumpDBFiles>:		dump arrays holding debugged files;
     I<DumpPackages>:		dump symbol tables of packages;
-    I<DumpReused>:		dump contents of \"reused\" addresses;
+    I<DumpReused>:			dump contents of \"reused\" addresses;
     I<quote>, I<HighBit>, I<undefPrint>:	change style of string dump;
     I<bareStringify>:		Do not print the overload-stringified value;
   Option I<PrintRet> affects printing of return value after B<r> command,
@@ -1899,7 +1915,7 @@ B<O> [I<opt>[B<=>I<val>]] [I<opt>B<\">I<val>B<\">] [I<opt>B<?>]...
 B<<> I<expr>		Define Perl command to run before each prompt.
 B<<<> I<expr>		Add to the list of Perl commands to run before each prompt.
 B<>> I<expr>		Define Perl command to run after each prompt.
-B<>>B<>> I<expr>	Add to the list of Perl commands to run after each prompt.
+B<>>B<>> I<expr>		Add to the list of Perl commands to run after each prompt.
 B<{> I<db_command>	Define debugger command to run before each prompt.
 B<{{> I<db_command>	Add to the list of debugger commands to run before each prompt.
 B<$prc> I<number>	Redo a previous command (default previous command).
diff --git a/lib/utf8.pm b/lib/utf8.pm
index c362a1c516..17ec37bbe2 100644
--- a/lib/utf8.pm
+++ b/lib/utf8.pm
@@ -31,7 +31,7 @@ utf8 - Perl pragma to enable/disable UTF-8 in source code
 =head1 DESCRIPTION
 
 WARNING: The implementation of Unicode support in Perl is incomplete.
-Expect sudden and unannounced changes!
+See L<perlunicode> for the exact details.
 
 The C<use utf8> pragma tells the Perl parser to allow UTF-8 in the
 program text in the current lexical scope.  The C<no utf8> pragma