-- 
cgit v1.2.1

From f918391ded03d22879e8fcd17e6b286e48a04578 Mon Sep 17 00:00:00 2001
From: "H.Merijn Brand" <h.m.brand@xs4all.nl>
Date: Wed, 14 Apr 2010 16:14:16 +0200
Subject: Between parens is the unit name

Strip trailing blank. Manual fix after metaunit fix
3e6d782f8c2ac2b94d9f217b0a91989b144feca4
---
 Porting/Glossary | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Porting/Glossary b/Porting/Glossary
index 57626e55c2..e0df178db8 100644
--- a/Porting/Glossary
+++ b/Porting/Glossary
@@ -1621,8 +1621,8 @@ d_prctl (d_prctl.U):
 	This variable conditionally defines the HAS_PRCTL symbol, which
 	indicates to the C program that the prctl() routine is available.
 
-d_prctl_set_name (d_prctl_set_name.U):
-	This variable conditionally defines the HAS_PRCTL_SET_NAME symbol, 
+d_prctl_set_name (d_prctl.U):
+	This variable conditionally defines the HAS_PRCTL_SET_NAME symbol,
 	which indicates to the C program that the prctl() routine supports
 	the PR_SET_NAME option.
 
-- 
cgit v1.2.1


From cfbab81b96edaf7de871d0fa306f1723e15a56d7 Mon Sep 17 00:00:00 2001
From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Thu, 15 Apr 2010 09:35:07 +0200
Subject: Upgrade to CGI.pm 3.49

---
 MANIFEST                   |   1 +
 Porting/Maintainers.pl     |   2 +-
 cpan/CGI/Changes           |  20 +++++++++
 cpan/CGI/lib/CGI.pm        |  79 ++++++++++++++++++++------------
 cpan/CGI/lib/CGI/Carp.pm   |  53 ++++++++++------------
 cpan/CGI/lib/CGI/Cookie.pm |  21 +++++----
 cpan/CGI/lib/CGI/Fast.pm   |   8 +++-
 cpan/CGI/lib/CGI/Util.pm   |  29 +++++++++++-
 cpan/CGI/t/carp.t          | 110 ++++++++++++++++++++++++++++++++++++++++++---
 cpan/CGI/t/function.t      |   5 ---
 cpan/CGI/t/url.t           |  23 ++++++++++
 11 files changed, 270 insertions(+), 81 deletions(-)
 create mode 100644 cpan/CGI/t/url.t

diff --git a/MANIFEST b/MANIFEST
index da0c1f3fb2..c0de439def 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -224,6 +224,7 @@ cpan/CGI/t/unescapeHTML.t		See if CGI::unescapeHTML() works
 cpan/CGI/t/uploadInfo.t			See if CGI.pm works
 cpan/CGI/t/upload_post_text.txt		Test data for CGI.pm
 cpan/CGI/t/upload.t			See if CGI.pm works
+cpan/CGI/t/url.t			See if CGI.pm works
 cpan/CGI/t/user_agent.t			See if CGI->user_agent() works
 cpan/CGI/t/utf8.t			See if CGI.pm works
 cpan/CGI/t/util-58.t			See if 5.8-dependent features work
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index f37c89593f..1608efa19c 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -308,7 +308,7 @@ use File::Glob qw(:case);
     'CGI' =>
 	{
 	'MAINTAINER'	=> 'lstein',
-	'DISTRIBUTION'	=> 'LDS/CGI.pm-3.48.tar.gz',
+	'DISTRIBUTION'	=> 'LDS/CGI.pm-3.49.tar.gz',
 	'FILES'		=> q[cpan/CGI],
 	'EXCLUDED'	=> [ qr{^t/lib/Test},
 				qw( cgi-lib_porting.html
diff --git a/cpan/CGI/Changes b/cpan/CGI/Changes
index e7acabd0fa..fb1644ff64 100644
--- a/cpan/CGI/Changes
+++ b/cpan/CGI/Changes
@@ -1,3 +1,23 @@
+Version 3.49
+
+  [BUG FIXES]
+  1. Fix a regression since 3.44 involving a case when the header includes "Content-Length: 0". 
+     Thanks to Alex Vandiver (RT#51109)
+  2. Suppress uninitialized warnings under -w. Thanks to burak.  (RT#50301)
+  3. url() now uses virtual_port() instead of server_port(). Thanks to MKANAT and Yanick Champoux. (RT#51562)
+
+  [SECURITY]
+  1. embedded newlines are now filtered out of header values in header(). 
+     Thanks to Mark Stosberg and Yanick Champoux.
+
+  [DOCUMENTATION]
+  1. README was updated to reflect that CGI.pm was moved under ./lib. 
+     Thanks to Alex Vandiver.
+
+  [INTERNALS]
+  1. More tests were added for autoescape, thanks to Bob Kuo. (RT#25485)
+  2. Attempt to avoid test failures with t/fast, thanks to Steve Hay. (RT#49599)
+
 Version 3.48
 
   [BUG FIXES]
diff --git a/cpan/CGI/lib/CGI.pm b/cpan/CGI/lib/CGI.pm
index 0cba88172c..355b8d1805 100644
--- a/cpan/CGI/lib/CGI.pm
+++ b/cpan/CGI/lib/CGI.pm
@@ -19,7 +19,7 @@ use Carp 'croak';
 #   http://stein.cshl.org/WWW/software/CGI/
 
 $CGI::revision = '$Id: CGI.pm,v 1.266 2009/07/30 16:32:34 lstein Exp $';
-$CGI::VERSION='3.48';
+$CGI::VERSION='3.49';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -663,7 +663,7 @@ sub init {
 	  if ( $content_length > 0 ) {
 	    $self->read_from_client(\$query_string,$content_length,0);
 	  }
-	  else {
+	  elsif (not defined $ENV{CONTENT_LENGTH}) {
 	    $self->read_from_stdin(\$query_string);
 	    # should this be PUTDATA in case of PUT ?
 	    my($param) = $meth . 'DATA' ;
@@ -1542,6 +1542,16 @@ sub header {
                             'EXPIRES','NPH','CHARSET',
                             'ATTACHMENT','P3P'],@p);
 
+    # CR escaping for values, per RFC 822
+    for my $header ($type,$status,$cookie,$target,$expires,$nph,$charset,$attachment,$p3p,@other) {
+        if (defined $header) {
+            $header =~ s/
+                (?<=\n)    # For any character proceeded by a newline
+                (?=\S)     # ... that is not whitespace
+            / /xg;         # ... inject a leading space in the new line
+        }
+    }
+
     $nph     ||= $NPH;
 
     $type ||= 'text/html' unless defined($type);
@@ -1557,7 +1567,7 @@ sub header {
     # need to fix it up a little.
     for (@other) {
         # Don't use \s because of perl bug 21951
-        next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/;
+        next unless my($header,$value) = /([^ \r\n\t=]+)=\"?(.+?)\"?$/s;
         ($_ = $header) =~ s/^(\w)(.*)/"\u$1\L$2" . ': '.$self->unescapeHTML($value)/e;
     }
 
@@ -2566,6 +2576,7 @@ sub popup_menu {
     my(@values);
     @values = $self->_set_values_and_labels($values,\$labels,$name);
     $tabindex = $self->element_tab($tabindex);
+    $name = q{} if ! defined $name;
     $result = qq/<select name="$name" $tabindex$other>\n/;
     for (@values) {
         if (/<optgroup/) {
@@ -2626,7 +2637,7 @@ sub optgroup {
     @values = $self->_set_values_and_labels($values,\$labels,$name,$labeled,$novals);
     my($other) = @other ? " @other" : '';
 
-    $name=$self->_maybe_escapeHTML($name);
+    $name = $self->_maybe_escapeHTML($name) || q{};
     $result = qq/<optgroup label="$name"$other>\n/;
     for (@values) {
         if (/<optgroup/) {
@@ -2842,21 +2853,22 @@ sub url {
 #    $uri            =~ s/\Q$path\E$//      if defined $path;      # remove path
 
     if ($full) {
-	my $protocol = $self->protocol();
-	$url = "$protocol://";
-	my $vh = http('x_forwarded_host') || http('host') || '';
-        $vh =~ s/\:\d+$//;  # some clients add the port number (incorrectly). Get rid of it.
-	if ($vh) {
-	    $url .= $vh;
-	} else {
-	    $url .= server_name();
-	}
-        my $port = $self->server_port;
-	$url .= ":" . $port
-	  unless (lc($protocol) eq 'http'  && $port == 80)
-		|| (lc($protocol) eq 'https' && $port == 443);
+        my $protocol = $self->protocol();
+        $url = "$protocol://";
+        my $vh = http('x_forwarded_host') || http('host') || '';
+            $vh =~ s/\:\d+$//;  # some clients add the port number (incorrectly). Get rid of it.
+
+        $url .= $vh || server_name();
+
+        my $port = $self->virtual_port;
+
+        # add the port to the url unless it's the protocol's default port
+        $url .= ':' . $port unless (lc($protocol) eq 'http'  && $port == 80)
+                                or (lc($protocol) eq 'https' && $port == 443);
+
         return $url if $base;
-	$url .= $uri;
+
+        $url .= $uri;
     } elsif ($relative) {
 	($url) = $uri =~ m!([^/]+)$!;
     } elsif ($absolute) {
@@ -4759,7 +4771,7 @@ a short example of creating multiple session records:
 
    use CGI;
 
-   open (OUT,">>test.out") || die;
+   open (OUT,'>>','test.out') || die;
    $records = 5;
    for (0..$records) {
        my $q = CGI->new;
@@ -4769,7 +4781,7 @@ a short example of creating multiple session records:
    close OUT;
 
    # reopen for reading
-   open (IN,"test.out") || die;
+   open (IN,'<','test.out') || die;
    while (!eof(IN)) {
        my $q = CGI->new(\*IN);
        print $q->param('counter'),"\n";
@@ -5265,6 +5277,18 @@ In either case, the outgoing header will be formatted as:
 
   P3P: policyref="/w3c/p3p.xml" cp="CAO DSP LAW CURa"
 
+Note that if a header value contains a carriage return, a leading space will be
+added to each new line that doesn't already have one as specified by RFC2616
+section 4.2.  For example:
+
+    print header( -ingredients => "ham\neggs\nbacon" );
+
+will generate
+
+    Ingredients: ham
+     eggs
+     bacon
+
 =head2 GENERATING A REDIRECTION HEADER
 
    print $q->redirect('http://somewhere.else/in/movie/land');
@@ -6198,12 +6222,12 @@ handle for a file upload field like this:
   # undef may be returned if it's not a valid file handle
   if (defined $lightweight_fh) {
     # Upgrade the handle to one compatible with IO::Handle:
-     my $io_handle = $lightweight_fh->handle;
+    my $io_handle = $lightweight_fh->handle;
 
-	open (OUTFILE,">>/usr/local/web/users/feedback");
-   while ($bytesread = $io_handle->read($buffer,1024)) {
-	   print OUTFILE $buffer;
-	}
+    open (OUTFILE,'>>','/usr/local/web/users/feedback');
+    while ($bytesread = $io_handle->read($buffer,1024)) {
+      print OUTFILE $buffer;
+    }
   }
 
 In a list context, upload() will return an array of filehandles.
@@ -8024,13 +8048,12 @@ for suggestions and bug fixes.
 	}
 
 	sub do_work {
-	   my(@values,$key);
 
 	   print "<h2>Here are the current settings in this form</h2>";
 
-	   for $key (param) {
+	   for my $key (param) {
 	      print "<strong>$key</strong> -> ";
-	      @values = param($key);
+	      my @values = param($key);
 	      print join(", ",@values),"<br>\n";
 	  }
 	}
diff --git a/cpan/CGI/lib/CGI/Carp.pm b/cpan/CGI/lib/CGI/Carp.pm
index 381635e87e..5f9911b32e 100644
--- a/cpan/CGI/lib/CGI/Carp.pm
+++ b/cpan/CGI/lib/CGI/Carp.pm
@@ -423,35 +423,26 @@ sub ineval {
 sub die {
   my ($arg,@rest) = @_;
 
-  if ($DIE_HANDLER) {
-      &$DIE_HANDLER($arg,@rest);
-  }
+  &$DIE_HANDLER($arg,@rest) if $DIE_HANDLER;
 
-  if ( ineval() )  {
-    if (!ref($arg)) {
-      $arg = join("",($arg,@rest)) || "Died";
-      my($file,$line,$id) = id(1);
-      $arg .= " at $file line $line.\n" unless $arg=~/\n$/;
-      realdie($arg);
-    }
-    else {
-      realdie($arg,@rest);
-    }
-  }
+  # if called as die( $object, 'string' ),
+  # all is stringified, just like with
+  # the real 'die'
+  $arg = join '' => "$arg", @rest if @rest;
+
+  $arg ||= 'Died';
+
+  my($file,$line,$id) = id(1);
+
+  $arg .= " at $file line $line.\n" unless ref $arg or $arg=~/\n$/;
+
+  realdie $arg           if ineval();
+  &fatalsToBrowser($arg) if $WRAP;
+
+  $arg=~s/^/ stamp() /gme if $arg =~ /\n$/ or not exists $ENV{MOD_PERL};
+
+  $arg .= "\n" unless $arg =~ /\n$/;
 
-  if (!ref($arg)) {
-    $arg = join("", ($arg,@rest));
-    my($file,$line,$id) = id(1);
-    $arg .= " at $file line $line." unless $arg=~/\n$/;
-    &fatalsToBrowser($arg) if $WRAP;
-    if (($arg =~ /\n$/) || !exists($ENV{MOD_PERL})) {
-      my $stamp = stamp;
-      $arg=~s/^/$stamp/gm;
-    }
-    if ($arg !~ /\n$/) {
-      $arg .= "\n";
-    }
-  }
   realdie $arg;
 }
 
@@ -503,11 +494,15 @@ sub warningsToBrowser {
 
 # headers
 sub fatalsToBrowser {
-  my($msg) = @_;
+  my $msg = shift;
+
+  $msg = "$msg" if ref $msg;
+
   $msg=~s/&/&amp;/g;
   $msg=~s/>/&gt;/g;
   $msg=~s/</&lt;/g;
-  $msg=~s/\"/&quot;/g;
+  $msg=~s/"/&quot;/g;
+
   my($wm) = $ENV{SERVER_ADMIN} ? 
     qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
       "this site's webmaster";
diff --git a/cpan/CGI/lib/CGI/Cookie.pm b/cpan/CGI/lib/CGI/Cookie.pm
index 85a07f0bc0..7bc090d418 100644
--- a/cpan/CGI/lib/CGI/Cookie.pm
+++ b/cpan/CGI/lib/CGI/Cookie.pm
@@ -1,5 +1,8 @@
 package CGI::Cookie;
 
+use strict;
+use warnings;
+
 # See the bottom of this file for the POD documentation.  Search for the
 # string '=head'.
 
@@ -78,14 +81,13 @@ sub get_raw_cookie {
   $r ||= eval { $MOD_PERL == 2                    ? 
                   Apache2::RequestUtil->request() :
                   Apache->request } if $MOD_PERL;
-  if ($r) {
-    $raw_cookie = $r->headers_in->{'Cookie'};
-  } else {
-    if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
-      die "Run $r->subprocess_env; before calling fetch()";
-    }
-    $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
-  }
+
+  return $r->headers_in->{'Cookie'} if $r;
+
+  die "Run $r->subprocess_env; before calling fetch()" 
+    if $MOD_PERL and !exists $ENV{REQUEST_METHOD};
+    
+  return $ENV{HTTP_COOKIE} || $ENV{COOKIE};
 }
 
 
@@ -122,7 +124,8 @@ sub new {
   shift if ref $_[0]
         && eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
   my($name,$value,$path,$domain,$secure,$expires,$httponly) =
-    rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@_);
+    rearrange([ 'NAME', ['VALUE','VALUES'], qw/ PATH DOMAIN SECURE EXPIRES
+        HTTPONLY / ], @_);
   
   # Pull out our parameters.
   my @values;
diff --git a/cpan/CGI/lib/CGI/Fast.pm b/cpan/CGI/lib/CGI/Fast.pm
index 67d67ee685..e31dac3f50 100644
--- a/cpan/CGI/lib/CGI/Fast.pm
+++ b/cpan/CGI/lib/CGI/Fast.pm
@@ -1,6 +1,10 @@
 package CGI::Fast;
 use strict;
-$^W=1; # A way to say "use warnings" that's compatible with even older perls.
+
+# A way to say "use warnings" that's compatible with even older perls.
+# making it local will not affect the code that loads this module
+# and since we're not in a BLOCK, warnings are enabled until the EOF
+local $^W = 1;
 
 # See the bottom of this file for the POD documentation.  Search for the
 # string '=head'.
@@ -15,7 +19,7 @@ $^W=1; # A way to say "use warnings" that's compatible with even older perls.
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-$CGI::Fast::VERSION='1.07';
+$CGI::Fast::VERSION='1.08';
 
 use CGI;
 use FCGI;
diff --git a/cpan/CGI/lib/CGI/Util.pm b/cpan/CGI/lib/CGI/Util.pm
index 1f4201d064..eb639e40d5 100644
--- a/cpan/CGI/lib/CGI/Util.pm
+++ b/cpan/CGI/lib/CGI/Util.pm
@@ -244,11 +244,38 @@ sub unescape {
 # was always so and cannot be fixed without breaking the binary data case.
 # -- Stepan Kasal <skasal@redhat.com>
 #
+if ($] == 5.008) {
+   package utf8;
+
+   no warnings 'redefine'; # needed for Perl 5.8.1+
+
+   my $is_utf8_redefinition = <<'EOR';
+      sub is_utf8 {
+         my ($text) = @_;
+
+         my $ctext = pack q{C0a*}, $text;
+
+         return ($text ne $ctext) && ($ctext =~ m/^(
+          [\x09\x0A\x0D\x20-\x7E]
+          | [\xC2-\xDF][\x80-\xBF]
+          | \xE0[\xA0-\xBF][\x80-\xBF]
+          | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2}
+          | \xED[\x80-\x9F][\x80-\xBF]
+          | \xF0[\x90-\xBF][\x80-\xBF]{2}
+          | [\xF1-\xF3][\x80-\xBF]{3}
+          | \xF4[\x80-\x8F][\x80-\xBF]{2}
+          )*$/xo);
+      }
+EOR
+
+   eval $is_utf8_redefinition;
+}
+
 sub escape {
   shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
   my $toencode = shift;
   return undef unless defined($toencode);
-  utf8::encode($toencode) if ($] > 5.008001 && utf8::is_utf8($toencode));
+  utf8::encode($toencode) if ($] >= 5.008 && utf8::is_utf8($toencode));
     if ($EBCDIC) {
       $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
     } else {
diff --git a/cpan/CGI/t/carp.t b/cpan/CGI/t/carp.t
index ff5eaf498e..be6292867b 100644
--- a/cpan/CGI/t/carp.t
+++ b/cpan/CGI/t/carp.t
@@ -3,7 +3,7 @@
 
 use strict;
 
-use Test::More tests => 41;
+use Test::More tests => 59;
 use IO::Handle;
 
 BEGIN { use_ok('CGI::Carp') };
@@ -116,12 +116,13 @@ like($@,
 # Test that realwarn is called
 {
   local $^W = 0;
-  eval 'sub CGI::Carp::realdie {my $mess = shift; return $mess};';
-}
+  local *CGI::Carp::realdie = sub { my $mess = shift; return $mess };
 
-like(CGI::Carp::die('There is a problem'),
-     $stamp,
-     'CGI::Carp::die calls CORE::die, but adds stamp');
+    like(CGI::Carp::die('There is a problem'),
+        $stamp,
+        'CGI::Carp::die calls CORE::die, but adds stamp');
+
+}
 
 #-----------------------------------------------------------------------------
 # Test set_message
@@ -273,3 +274,100 @@ ok( defined buffer( $fh ),         '$fh returns proper filehandle');
 ok( defined buffer('::STDOUT'),    'STDIN returns proper filehandle');
 ok( defined buffer(*main::STDOUT), 'STDIN returns proper filehandle');
 ok(!defined buffer("WIBBLE"),      '"WIBBLE" doesn\'t returns proper filehandle');
+
+# Calling die with code refs with no WRAP
+{
+    local $CGI::Carp::WRAP = 0;
+
+    eval { CGI::Carp::die( 'regular string' ) };
+    like $@ => qr/regular string/, 'die with string';
+
+    eval { CGI::Carp::die( [ 1..10 ] ) };
+    like $@ => qr/ARRAY\(0x[\da-f]+\)/, 'die with array ref';
+
+    eval { CGI::Carp::die( { a => 1 } ) };
+    like $@ => qr/HASH\(0x[\da-f]+\)/, 'die with hash ref';
+
+    eval { CGI::Carp::die( sub { 'Farewell' } ) };
+    like $@ => qr/CODE\(0x[\da-f]+\)/, 'die with code ref';
+
+    eval { CGI::Carp::die( My::Plain::Object->new ) };
+    isa_ok $@, 'My::Plain::Object';
+
+    eval { CGI::Carp::die( My::Plain::Object->new, ' and another argument' ) };
+    like $@ => qr/My::Plain::Object/,     'object is stringified';
+    like $@ => qr/and another argument/, 'second argument is present';
+
+    eval { CGI::Carp::die( My::Stringified::Object->new ) };
+    isa_ok $@, 'My::Stringified::Object';
+
+    eval { CGI::Carp::die( My::Stringified::Object->new, ' and another argument' ) };
+    like $@ => qr/stringified/,          'object is stringified';
+    like $@ => qr/and another argument/, 'second argument is present';
+
+    eval { CGI::Carp::die() };
+    like $@ => qr/Died at/, 'die with no argument';
+}
+
+# Calling die with code refs when WRAPped
+{
+    local $CGI::Carp::WRAP = 1;
+    local *CGI::Carp::realdie = sub { return @_ };
+    local *STDOUT;
+
+    tie *STDOUT, 'StoreStuff';
+
+    my %result;   # store results because stdout is kidnapped
+
+    CGI::Carp::die( 'regular string' );
+    $result{string} .= $_ while <STDOUT>;
+
+    CGI::Carp::die( [ 1..10 ] );
+    $result{array_ref} .= $_ while <STDOUT>;
+
+    CGI::Carp::die( { a => 1 } );
+    $result{hash_ref} .= $_ while <STDOUT>;
+
+    CGI::Carp::die( sub { 'Farewell' } );
+    $result{code_ref} .= $_ while <STDOUT>;
+
+    CGI::Carp::die( My::Plain::Object->new );
+    $result{plain_object} .= $_ while <STDOUT>;
+
+    CGI::Carp::die( My::Stringified::Object->new );
+    $result{string_object} .= $_ while <STDOUT>;
+
+    CGI::Carp::die();
+    $result{no_args} .= $_ while <STDOUT>;
+
+    untie *STDOUT;
+
+    like $result{string}    => qr/regular string/, 'regular string, wrapped';
+    like $result{array_ref} => qr/ARRAY\(\w+?\)/,  'array ref, wrapped';
+    like $result{hash_ref}  => qr/HASH\(\w+?\)/,   'hash ref, wrapped';
+    like $result{code_ref}  => qr/CODE\(\w+?\)/,   'code ref, wrapped';
+    like $result{plain_object} => qr/My::Plain::Object/,
+      'plain object, wrapped';
+    like $result{string_object} => qr/stringified/,
+      'stringified object, wrapped';
+    like $result{no_args} => qr/Died at/, 'no args, wrapped';
+
+}
+
+{
+    package My::Plain::Object;
+
+    sub new {
+        return bless {}, shift;
+    }
+}
+
+{
+    package My::Stringified::Object;
+
+    use overload '""' => sub { 'stringified' };
+
+    sub new {
+        return bless {}, shift;
+    }
+}
diff --git a/cpan/CGI/t/function.t b/cpan/CGI/t/function.t
index 316b5858a6..101333953f 100644
--- a/cpan/CGI/t/function.t
+++ b/cpan/CGI/t/function.t
@@ -32,11 +32,6 @@ if ($^O eq 'VMS') { $CRLF = "\n"; }
 
 if (ord("\t") != 9) { $CRLF = "\r\n"; }
 
-# Web servers on EBCDIC hosts are typically set up to do an EBCDIC -> ASCII
-# translation hence CRLF is used as \r\n within CGI.pm on such machines.
-
-if (ord("\t") != 9) { $CRLF = "\r\n"; }
- 
 # Set up a CGI environment
 $ENV{REQUEST_METHOD}='GET';
 $ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
diff --git a/cpan/CGI/t/url.t b/cpan/CGI/t/url.t
new file mode 100644
index 0000000000..16e20b6fc1
--- /dev/null
+++ b/cpan/CGI/t/url.t
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More tests => 4;    # last test to print
+
+use CGI qw/ :all /;
+
+$ENV{HTTP_X_FORWARDED_HOST} = 'proxy:8484';
+$ENV{SERVER_PROTOCOL}       = 'HTTP/1.0';
+$ENV{SERVER_PORT}           = 8080;
+$ENV{SERVER_NAME}           = 'the.good.ship.lollypop.com';
+
+is virtual_port() => 8484, 'virtual_port()';
+is server_port()  => 8080, 'server_port()';
+
+is url() => 'http://proxy:8484', 'url()';
+
+# let's see if we do the defaults right
+
+$ENV{HTTP_X_FORWARDED_HOST} = 'proxy:80';
+
+is url() => 'http://proxy', 'url() with default port';
+
-- 
cgit v1.2.1


From 7dcb3b25fc4113f0eeb68d0d3c47ccedd5ff3f2a Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@khw-desktop.(none)>
Date: Tue, 13 Apr 2010 21:25:36 -0600
Subject: PATCH: [perl #72998] regex looping

If a character folds to multiple ones in case-insensitive matching,
it should not match just one of those, or the regular expression can
loop.  For example, \N{LATIN SMALL LIGATURE FF} folds to 'ff', and so
    "\N{LATIN SMALL LIGATURE FF}" =~ /f+/i
should match.  Prior to this patch, this function returned that there is
a match, but left the matching string  pointer at the beginning of the
"\N{LATIN SMALL LIGATURE FF}" because it doesn't make sense to match
just half a character, and at this level it doesn't know about the '+'.
This leaves things in an inconsistent state, with the reporting of a
match, but the input pointer unchanged, the result of which is a loop.

I don't know how to fix this so that it correctly matches, and there are
semantic issues with doing so.  For example, if
    "\N{LATIN SMALL LIGATURE FF}" =~ /ff/i
matches, then one would think that so should
    "\N{LATIN SMALL LIGATURE FF}" =~ /(f)(f)/i
But $1 and $2 don't really make sense here, since they both refer to the
half of the same character.

So this patch just returns failure if only a partial character is
matched.  That leaves things consistent, and solves the problem of
looping, so that Perl doesn't hang on such a construct, but leaves the
ultimate solution for another day.
---
 t/re/re.t | 10 +++++++++-
 utf8.c    |  3 ++-
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/t/re/re.t b/t/re/re.t
index 87965f20aa..249c6ddf22 100644
--- a/t/re/re.t
+++ b/t/re/re.t
@@ -51,6 +51,14 @@ if ('1234'=~/(?:(?<A>\d)|(?<C>!))(?<B>\d)(?<A>\d)(?<B>\d)/){
     }
     is(regnames_count(),3);
 }
+
+    { # Keep this test last, as whole script will be interrupted if times out
+        # Bug #72998; this can loop 
+        watchdog(2);
+        eval '"\x{100}\x{FB00}" =~ /\x{100}\N{U+66}+/i';
+        pass("Didn't loop");
+    }
+
 # New tests above this line, don't forget to update the test count below!
-BEGIN { plan tests => 18 }
+BEGIN { plan tests => 19 }
 # No tests here!
diff --git a/utf8.c b/utf8.c
index 9ed0663e19..1a6077c8d2 100644
--- a/utf8.c
+++ b/utf8.c
@@ -2609,7 +2609,8 @@ Perl_ibcmp_utf8(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const
 
      /* A match is defined by all the scans that specified
       * an explicit length reaching their final goals. */
-     match = (f1 == 0 || p1 == f1) && (f2 == 0 || p2 == f2);
+     match = (n1 == 0 && n2 == 0    /* Must not match partial char; Bug #72998 */
+	     && (f1 == 0 || p1 == f1) && (f2 == 0 || p2 == f2));
 
      if (match) {
 	  if (pe1)
-- 
cgit v1.2.1


From 036e1e65778b6e2b51a21e4ce6d5b694f2a3ba03 Mon Sep 17 00:00:00 2001
From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Thu, 15 Apr 2010 10:54:32 +0200
Subject: [perl #74372] := warning not in perldiag

Missing warning description noticed by Zefram
---
 pod/perldiag.pod | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 4e9f04b342..edccac1348 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -4880,6 +4880,14 @@ modifier is not presently meaningful in substitutions.
 use the /g modifier.  Currently, /c is meaningful only when /g is
 used.  (This may change in the future.)
 
+=item Use of := for an empty attribute list is deprecated
+
+(D deprecated) The construction C<my $x := 42> currently
+parses correctly in perl, being equivalent to C<my $x : = 42>
+(applying an empty attribute list to C<$x>). This useless
+construct is now deprecated, so C<:=> can be reclaimed as a new
+operator in the future.
+
 =item Use of freed value in iteration
 
 (F) Perhaps you modified the iterated array within the loop?
-- 
cgit v1.2.1


From 99671a4a235b4619f809b7dbf28bf972370ab181 Mon Sep 17 00:00:00 2001
From: Florian Ragwitz <rafl@debian.org>
Date: Thu, 18 Mar 2010 15:13:40 +0100
Subject: Remove 'delete &function' from perltodo.

It wouldn't add any new feature we don't already have and be inconsistent with
the behaviour of other things.
---
 pod/perltodo.pod | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/pod/perltodo.pod b/pod/perltodo.pod
index a16cf0d604..0a03bf4175 100644
--- a/pod/perltodo.pod
+++ b/pod/perltodo.pod
@@ -1046,11 +1046,6 @@ slices. This would be good to fix.
 The regexp optimiser is not optional. It should configurable to be, to allow
 its performance to be measured, and its bugs to be easily demonstrated.
 
-=head2 delete &function
-
-Allow to delete functions. One can already undef them, but they're still
-in the stash.
-
 =head2 C</w> regex modifier
 
 That flag would enable to match whole words, and also to interpolate
-- 
cgit v1.2.1


From db63319f533e643ef6aac622fcae9a2f7ceabb0d Mon Sep 17 00:00:00 2001
From: Florian Ragwitz <rafl@debian.org>
Date: Wed, 20 Jan 2010 17:12:34 +0100
Subject: Fix a minor perl5114delta error.

---
 pod/perl5114delta.pod | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/pod/perl5114delta.pod b/pod/perl5114delta.pod
index 3c0680112b..05a387f2d3 100644
--- a/pod/perl5114delta.pod
+++ b/pod/perl5114delta.pod
@@ -51,7 +51,7 @@ example U+FF10: FULLWIDTH DIGIT ZERO.
 
 =item C<less>
 
-Upgraded from version 0.03 to 0.03.
+Upgraded from version 0.02 to 0.03.
 
 This version introduces the C<stash_name> method to allow subclasses of less to
 pick where in %^H to store their stash.
-- 
cgit v1.2.1


From f2338a2e8347fc967ab6b9af21d948258b88e341 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Thu, 15 Apr 2010 10:20:50 +0100
Subject: use cBOOL for bool casts

bool b = (bool)some_int

doesn't necessarily do what you think. In some builds, bool is defined as
char, and that cast's behaviour is thus undefined. So this line in mg.c:

    const bool was_temp = (bool)SvTEMP(sv);

was actually setting was_temp to false even when the SVs_TEMP flag was set.
Fix this by replacing all the (bool) casts with a new cBOOL() cast macro
that (hopefully) does the right thing.
---
 av.c      |  2 +-
 handy.h   |  6 ++++++
 mg.c      |  4 ++--
 numeric.c |  6 +++---
 pp.c      |  2 +-
 regexec.c | 26 +++++++++++++-------------
 scope.c   |  2 +-
 sv.c      |  6 +++---
 toke.c    |  2 +-
 9 files changed, 31 insertions(+), 25 deletions(-)

diff --git a/av.c b/av.c
index a4d6ea2d06..fb853a648c 100644
--- a/av.c
+++ b/av.c
@@ -977,7 +977,7 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
             mg = mg_find(sv, PERL_MAGIC_tiedelem);
             if (mg) {
                 magic_existspack(sv, mg);
-                return (bool)SvTRUE(sv);
+                return cBOOL(SvTRUE(sv));
             }
 
         }
diff --git a/handy.h b/handy.h
index 81bf1e270d..ebe523fbec 100644
--- a/handy.h
+++ b/handy.h
@@ -110,6 +110,12 @@ Null SV pointer. (No longer available when C<PERL_CORE> is defined.)
 # define HAS_BOOL 1
 #endif
 
+/* a simple (bool) cast may not do the right thing: if bool is defined
+ * as char for example, then the cast from int is implementation-defined
+ */
+
+#define cBOOL(cbool) ((bool)!!(cbool))
+
 /* Try to figure out __func__ or __FUNCTION__ equivalent, if any.
  * XXX Should really be a Configure probe, with HAS__FUNCTION__
  *     and FUNCTION__ as results.
diff --git a/mg.c b/mg.c
index 3fb8ec43f4..4a8d7673a5 100644
--- a/mg.c
+++ b/mg.c
@@ -193,7 +193,7 @@ Perl_mg_get(pTHX_ SV *sv)
 {
     dVAR;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
-    const bool was_temp = (bool)SvTEMP(sv);
+    const bool was_temp = cBOOL(SvTEMP(sv));
     bool have_new = 0;
     MAGIC *newmg, *head, *cur, *mg;
     /* guard against sv having being freed midway by holding a private
@@ -2359,7 +2359,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	sv_setsv(PL_bodytarget, sv);
 	break;
     case '\003':	/* ^C */
-	PL_minus_c = (bool)SvIV(sv);
+	PL_minus_c = cBOOL(SvIV(sv));
 	break;
 
     case '\004':	/* ^D */
diff --git a/numeric.c b/numeric.c
index bfe67427a6..b116376916 100644
--- a/numeric.c
+++ b/numeric.c
@@ -142,7 +142,7 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     NV value_nv = 0;
 
     const UV max_div_2 = UV_MAX / 2;
-    const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
+    const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
     char bit;
 
@@ -259,7 +259,7 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     UV value = 0;
     NV value_nv = 0;
     const UV max_div_16 = UV_MAX / 16;
-    const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
+    const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
 
     PERL_ARGS_ASSERT_GROK_HEX;
@@ -373,7 +373,7 @@ Perl_grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
     UV value = 0;
     NV value_nv = 0;
     const UV max_div_8 = UV_MAX / 8;
-    const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
+    const bool allow_underscores = cBOOL(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
 
     PERL_ARGS_ASSERT_GROK_OCT;
diff --git a/pp.c b/pp.c
index 9565c6c473..2c5f69a6c8 100644
--- a/pp.c
+++ b/pp.c
@@ -1030,7 +1030,7 @@ PP(pp_pow)
 			   on same algorithm as above */
 			register UV result = 1;
 			register UV base = baseuv;
-			const bool odd_power = (bool)(power & 1);
+			const bool odd_power = cBOOL(power & 1);
 			if (odd_power) {
 			    result *= base;
 			}
diff --git a/regexec.c b/regexec.c
index 17a0dc69a4..a9b33354bd 100644
--- a/regexec.c
+++ b/regexec.c
@@ -193,7 +193,7 @@
                     LEAVE;                                                              \
                 }                                                                       \
                 if (!(OP(scan) == NAME                                                  \
-                    ? (bool)swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8)   \
+                    ? cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8))  \
                     : LCFUNC_utf8((U8*)locinput)))                                      \
                 {                                                                       \
                     sayNO;                                                              \
@@ -224,7 +224,7 @@
                     LEAVE;                                                              \
                 }                                                                       \
                 if ((OP(scan) == NAME                                                  \
-                    ? (bool)swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8)    \
+                    ? cBOOL(swash_fetch(CAT2(PL_utf8_,CLASS), (U8*)locinput, do_utf8))  \
                     : LCFUNC_utf8((U8*)locinput)))                                      \
                 {                                                                       \
                     sayNO;                                                              \
@@ -1179,7 +1179,7 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
     if ( (CoNd)                                        \
 	 && (ln == len ||                              \
 	     !ibcmp_utf8(s, &my_strend, 0,  do_utf8,   \
-			m, NULL, ln, (bool)UTF))       \
+			m, NULL, ln, cBOOL(UTF)))      \
 	 && (!reginfo || regtry(reginfo, &s)) )        \
 	goto got_it;                                   \
     else {                                             \
@@ -1190,7 +1190,7 @@ uvc, charid, foldlen, foldbuf, uniflags) STMT_START {                       \
 	      && (f == c1 || f == c2)                  \
 	      && (ln == len ||                         \
 	        !ibcmp_utf8(s, &my_strend, 0,  do_utf8,\
-			      m, NULL, ln, (bool)UTF)) \
+			      m, NULL, ln, cBOOL(UTF)))\
 	      && (!reginfo || regtry(reginfo, &s)) )   \
 	      goto got_it;                             \
     }                                                  \
@@ -1479,7 +1479,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 		LOAD_UTF8_CHARCLASS_ALNUM();
 		REXEC_FBC_UTF8_SCAN(
 		    if (tmp == !(OP(c) == BOUND ?
-				 (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
+				 cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) :
 				 isALNUM_LC_utf8((U8*)s)))
 		    {
 			tmp = !tmp;
@@ -1517,7 +1517,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s,
 		LOAD_UTF8_CHARCLASS_ALNUM();
 		REXEC_FBC_UTF8_SCAN(
 		    if (tmp == !(OP(c) == NBOUND ?
-				 (bool)swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
+				 cBOOL(swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) :
 				 isALNUM_LC_utf8((U8*)s)))
 			tmp = !tmp;
 		    else REXEC_FBC_TRYIT;
@@ -1872,7 +1872,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
     I32 end_shift = 0;			/* Same for the end. */		/* CC */
     I32 scream_pos = -1;		/* Internal iterator of scream. */
     char *scream_olds = NULL;
-    const bool do_utf8 = (bool)DO_UTF8(sv);
+    const bool do_utf8 = cBOOL(DO_UTF8(sv));
     I32 multiline;
     RXi_GET_DECL(prog,progi);
     regmatch_info reginfo;  /* create some info to pass to regtry etc */
@@ -3419,7 +3419,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		const char * const l = locinput;
 		char *e = PL_regeol;
 
-		if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
+		if (ibcmp_utf8(s, 0,  ln, cBOOL(UTF),
 			       l, &e, 0,  do_utf8)) {
 		     /* One more case for the sharp s:
 		      * pack("U0U*", 0xDF) =~ /ss/i,
@@ -4055,7 +4055,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 		/* NOTREACHED */
 	    }
 	    /* logical is 1,   /(?(?{...})X|Y)/ */
-	    sw = (bool)SvTRUE(ret);
+	    sw = cBOOL(SvTRUE(ret));
 	    logical = 0;
 	    break;
 	}
@@ -4156,11 +4156,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, regnode *prog)
 	    /*NOTREACHED*/	    
 	case GROUPP:
 	    n = ARG(scan);  /* which paren pair */
-	    sw = (bool)(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
+	    sw = cBOOL(*PL_reglastparen >= n && PL_regoffs[n].end != -1);
 	    break;
 	case NGROUPP:
 	    /* reg_check_named_buff_matched returns 0 for no match */
-	    sw = (bool)(0 < reg_check_named_buff_matched(rex,scan));
+	    sw = cBOOL(0 < reg_check_named_buff_matched(rex,scan));
 	    break;
         case INSUBP:
             n = ARG(scan);
@@ -5167,7 +5167,7 @@ NULL
 		    /* trivial fail */
 		    if (logical) {
 			logical = 0;
-			sw = 1 - (bool)ST.wanted;
+			sw = 1 - cBOOL(ST.wanted);
 		    }
 		    else if (ST.wanted)
 			sayNO;
@@ -5196,7 +5196,7 @@ NULL
 
 	case IFMATCH_A: /* body of (?...A) succeeded */
 	    if (ST.logical) {
-		sw = (bool)ST.wanted;
+		sw = cBOOL(ST.wanted);
 	    }
 	    else if (!ST.wanted)
 		sayNO;
diff --git a/scope.c b/scope.c
index 994151e676..2a9d2d0772 100644
--- a/scope.c
+++ b/scope.c
@@ -780,7 +780,7 @@ Perl_leave_scope(pTHX_ I32 base)
 	    break;
 	case SAVEt_BOOL:			/* bool reference */
 	    ptr = SSPOPPTR;
-	    *(bool*)ptr = (bool)SSPOPBOOL;
+	    *(bool*)ptr = cBOOL(SSPOPBOOL);
 	    break;
 	case SAVEt_I32:				/* I32 reference */
 	    ptr = SSPOPPTR;
diff --git a/sv.c b/sv.c
index 5759b2b4c6..21d0a8e9c2 100644
--- a/sv.c
+++ b/sv.c
@@ -3124,7 +3124,7 @@ Perl_sv_2bool(pTHX_ register SV *const sv)
 	if (SvAMAGIC(sv)) {
 	    SV * const tmpsv = AMG_CALLun(sv,bool_);
 	    if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
-		return (bool)SvTRUE(tmpsv);
+		return cBOOL(SvTRUE(tmpsv));
 	}
 	return SvRV(sv) != 0;
     }
@@ -11243,7 +11243,7 @@ Perl_sv_dup(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 			daux->xhv_riter = saux->xhv_riter;
 			daux->xhv_eiter = saux->xhv_eiter
 			    ? he_dup(saux->xhv_eiter,
-					(bool)!!HvSHAREKEYS(sstr), param) : 0;
+					cBOOL(HvSHAREKEYS(sstr)), param) : 0;
 			/* backref array needs refcnt=2; see sv_add_backref */
 			daux->xhv_backreferences =
 			    saux->xhv_backreferences
@@ -11696,7 +11696,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
 	    longval = (long)POPBOOL(ss,ix);
-	    TOPBOOL(nss,ix) = (bool)longval;
+	    TOPBOOL(nss,ix) = cBOOL(longval);
 	    break;
 	case SAVEt_SET_SVFLAGS:
 	    i = POPINT(ss,ix);
diff --git a/toke.c b/toke.c
index b6735cfe49..b5236dadbf 100644
--- a/toke.c
+++ b/toke.c
@@ -13700,7 +13700,7 @@ S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
     SV *const utf16_buffer = MUTABLE_SV(IoTOP_GV(filter));
     SV *const utf8_buffer = filter;
     IV status = IoPAGE(filter);
-    const bool reverse = (bool) IoLINES(filter);
+    const bool reverse = cBOOL(IoLINES(filter));
     I32 retval;
 
     /* As we're automatically added, at the lowest level, and hence only called
-- 
cgit v1.2.1


From d1515be42a17e7bb3fa584aea980f54524603f34 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Thu, 15 Apr 2010 10:29:56 +0100
Subject: mark two magic.t tests as TODO

fixing a bool cast bug exposes a hidden bug in @+ scope.
Mark as TODO for now.
---
 t/op/magic.t | 1 +
 1 file changed, 1 insertion(+)

diff --git a/t/op/magic.t b/t/op/magic.t
index 5a2733fd3a..ff5835232c 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -435,6 +435,7 @@ is "@+", "10 1 6 10";
 
 # Test for bug [perl #27839]
 {
+    local $TODO = "fixing a casting issue revealed broken behaviour in this test";
     my $x;
     sub f {
 	"abc" =~ /(.)./;
-- 
cgit v1.2.1


From f410a2119920dd04690025a349e79575cfb9c972 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 15 Apr 2010 11:37:53 +0100
Subject: Move PERL_ASYNC_CHECK() from the runloop to control flow OPs.

For the typical code this gives a 5% speedup, and removes the cost of "safe
signals". Tight looping code will show less gains, but should never be slower.

Subtle bugs might remain - there might be constructions that enter the runloop
(where signals used to be dispatched) but don't contain any PERL_ASYNC_CHECK()
calls themselves.
---
 cop.h    | 1 +
 dump.c   | 1 -
 pp_ctl.c | 7 +++++++
 pp_hot.c | 7 +++++++
 run.c    | 1 -
 scope.c  | 2 ++
 6 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/cop.h b/cop.h
index 6c51d73285..420a5d1790 100644
--- a/cop.h
+++ b/cop.h
@@ -592,6 +592,7 @@ struct block {
 /* Exit a block (RETURN and LAST). */
 #define POPBLOCK(cx,pm)							\
 	DEBUG_CX("POP");						\
+	PERL_ASYNC_CHECK();						\
 	cx = &cxstack[cxstack_ix--],					\
 	newsp		 = PL_stack_base + cx->blk_oldsp,		\
 	PL_curcop	 = cx->blk_oldcop,				\
diff --git a/dump.c b/dump.c
index bc1ba58ab1..d1fa26ecbf 100644
--- a/dump.c
+++ b/dump.c
@@ -2026,7 +2026,6 @@ Perl_runops_debug(pTHX)
 
     DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
     do {
-	PERL_ASYNC_CHECK();
 	if (PL_debug) {
 	    if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
 		PerlIO_printf(Perl_debug_log,
diff --git a/pp_ctl.c b/pp_ctl.c
index bbb2d1587c..e766d7dde3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -264,6 +264,9 @@ PP(pp_substcont)
     register REGEXP * const rx = cx->sb_rx;
     SV *nsv = NULL;
     REGEXP *old = PM_GETRE(pm);
+
+    PERL_ASYNC_CHECK();
+
     if(old != rx) {
 	if(old)
 	    ReREFCNT_dec(old);
@@ -1870,6 +1873,8 @@ PP(pp_dbstate)
     PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     FREETMPS;
 
+    PERL_ASYNC_CHECK();
+
     if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */
 	    || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
     {
@@ -2652,6 +2657,8 @@ PP(pp_goto)
     else
 	label = cPVOP->op_pv;
 
+    PERL_ASYNC_CHECK();
+
     if (label && *label) {
 	OP *gotoprobe = NULL;
 	bool leaving_eval = FALSE;
diff --git a/pp_hot.c b/pp_hot.c
index 70d35568fd..ff86b91f43 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -52,6 +52,7 @@ PP(pp_nextstate)
     TAINT_NOT;		/* Each statement is presumed innocent */
     PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
     FREETMPS;
+    PERL_ASYNC_CHECK();
     return NORMAL;
 }
 
@@ -98,6 +99,7 @@ PP(pp_gv)
 PP(pp_and)
 {
     dVAR; dSP;
+    PERL_ASYNC_CHECK();
     if (!SvTRUE(TOPs))
 	RETURN;
     else {
@@ -203,6 +205,7 @@ PP(pp_sassign)
 PP(pp_cond_expr)
 {
     dVAR; dSP;
+    PERL_ASYNC_CHECK();
     if (SvTRUEx(POPs))
 	RETURNOP(cLOGOP->op_other);
     else
@@ -416,6 +419,7 @@ PP(pp_preinc)
 PP(pp_or)
 {
     dVAR; dSP;
+    PERL_ASYNC_CHECK();
     if (SvTRUE(TOPs))
 	RETURN;
     else {
@@ -434,6 +438,7 @@ PP(pp_defined)
     const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN);
 
     if (is_dor) {
+	PERL_ASYNC_CHECK();
         sv = TOPs;
         if (!sv || !SvANY(sv)) {
 	    if (op_type == OP_DOR)
@@ -2077,6 +2082,8 @@ PP(pp_subst)
 #endif
     SV *nsv = NULL;
 
+    PERL_ASYNC_CHECK();
+
     /* known replacement string? */
     register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
     if (PL_op->op_flags & OPf_STACKED)
diff --git a/run.c b/run.c
index be280eeedb..20c711ae3a 100644
--- a/run.c
+++ b/run.c
@@ -38,7 +38,6 @@ Perl_runops_standard(pTHX)
 {
     dVAR;
     while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
-	PERL_ASYNC_CHECK();
     }
 
     TAINT_NOT;
diff --git a/scope.c b/scope.c
index 2a9d2d0772..6ee1254b60 100644
--- a/scope.c
+++ b/scope.c
@@ -1115,6 +1115,8 @@ Perl_leave_scope(pTHX_ I32 base)
     }
 
     PL_tainted = was;
+
+    PERL_ASYNC_CHECK();
 }
 
 void
-- 
cgit v1.2.1


From 339aac22c2768aa840858c042e33fbf04d4f51ed Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
Date: Thu, 15 Apr 2010 13:05:38 +0100
Subject: Avoid redundant reload of PL_op in the runloop.

(gcc, at least, generates suboptimal code without this dirty great hint)
---
 run.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/run.c b/run.c
index 20c711ae3a..eb465da57c 100644
--- a/run.c
+++ b/run.c
@@ -37,7 +37,8 @@ int
 Perl_runops_standard(pTHX)
 {
     dVAR;
-    while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
+    register OP *op = PL_op;
+    while ((PL_op = op = CALL_FPTR(op->op_ppaddr)(aTHX))) {
     }
 
     TAINT_NOT;
-- 
cgit v1.2.1


From b770e143548c6091e84d4ed5051d27d26e0f82e8 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 15 Apr 2010 14:03:08 +0100
Subject: Fix code before statement error introduced by f410a2119920dd04.

---
 pp_hot.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/pp_hot.c b/pp_hot.c
index ff86b91f43..6224f3db6a 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2081,11 +2081,11 @@ PP(pp_subst)
     bool is_cow;
 #endif
     SV *nsv = NULL;
+    /* known replacement string? */
+    register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
 
     PERL_ASYNC_CHECK();
 
-    /* known replacement string? */
-    register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
     if (PL_op->op_flags & OPf_STACKED)
 	TARG = POPs;
     else if (PL_op->op_private & OPpTARGET_MY)
-- 
cgit v1.2.1


From 208edbfe01f1e20448c7416e83a314e3969961c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avar@cpan.org>
Date: Thu, 15 Apr 2010 15:40:33 +0200
Subject: Simplify the perldelta howto by using Git features

`git-log' can generate a list of authors without perl's help and
`git-diff` can produce a diffstat without diffstat(1).
---
 Porting/how_to_write_a_perldelta.pod | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Porting/how_to_write_a_perldelta.pod b/Porting/how_to_write_a_perldelta.pod
index 5a55095f7d..6cae763b37 100644
--- a/Porting/how_to_write_a_perldelta.pod
+++ b/Porting/how_to_write_a_perldelta.pod
@@ -302,11 +302,11 @@ The list of people to thank goes here.
 
 You can find the list of committers and authors by:
 
-  % git log v5.11.1..HEAD | perl -nlwe '$seen{$1}++ if /^Author: ([^<]*)/; END { print for sort keys %seen }'
+  % git log --pretty='format:%an' v5.11.1..HEAD | sort | uniq
 
 And how many files where changed by:
 
-  % git diff v5.11.1..HEAD | diffstat
+  % git diff --stat=200,200 v5.11.1..HEAD
 
 =item Reporting Bugs
 
-- 
cgit v1.2.1


From b91a79b929f6eca75f18124340d2f0f89b9588a9 Mon Sep 17 00:00:00 2001
From: Steffen Mueller <smueller@cpan.org>
Date: Thu, 15 Apr 2010 11:12:04 +0200
Subject: Upgrade dist/threads to 1.77 from CPAN

While doing so fix a tiny, little POD error to prevent breakage of core
tests. (blead is upstream for threads.pm)
---
 Porting/Maintainers.pl  |  2 +-
 dist/threads/t/basic.t  | 11 ++++++----
 dist/threads/t/exit.t   | 10 ++++-----
 dist/threads/t/thread.t | 24 +++++++++++++++++++--
 dist/threads/threads.pm | 27 +++++++++++++++++-------
 dist/threads/threads.xs | 56 ++++++++++++++++++++++++++++++-------------------
 6 files changed, 90 insertions(+), 40 deletions(-)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 1608efa19c..5134cee959 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1559,7 +1559,7 @@ use File::Glob qw(:case);
     'threads' =>
 	{
 	'MAINTAINER'	=> 'jdhedden',
-	'DISTRIBUTION'	=> 'JDHEDDEN/threads-1.75.tar.gz',
+	'DISTRIBUTION'	=> 'JDHEDDEN/threads-1.77.tar.gz',
 	'FILES'		=> q[dist/threads],
 	'EXCLUDED'	=> [ qw(examples/pool.pl
 				t/pod.t
diff --git a/dist/threads/t/basic.t b/dist/threads/t/basic.t
index 19ce793374..f4d030b792 100644
--- a/dist/threads/t/basic.t
+++ b/dist/threads/t/basic.t
@@ -27,7 +27,7 @@ sub ok {
 
 BEGIN {
     $| = 1;
-    print("1..33\n");   ### Number of tests that will be run ###
+    print("1..34\n");   ### Number of tests that will be run ###
 };
 
 use threads;
@@ -153,14 +153,17 @@ $thrx = threads->object();
 ok(30, ! defined($thrx), 'No object');
 $thrx = threads->object(undef);
 ok(31, ! defined($thrx), 'No object');
-$thrx = threads->object(0);
-ok(32, ! defined($thrx), 'No object');
 
 threads->import('stringify');
 $thr1 = threads->create(sub {});
-ok(33, "$thr1" eq $thr1->tid(), 'Stringify');
+ok(32, "$thr1" eq $thr1->tid(), 'Stringify');
 $thr1->join();
 
+# ->object($tid) works like ->self() when $tid is thread's TID
+$thrx = threads->object(threads->tid());
+ok(33, defined($thrx), 'Main thread object');
+ok(34, 0 == $thrx->tid(), "Check so that tid for threads work for main thread");
+
 exit(0);
 
 # EOF
diff --git a/dist/threads/t/exit.t b/dist/threads/t/exit.t
index bb1cec0d5b..29c3dca0da 100644
--- a/dist/threads/t/exit.t
+++ b/dist/threads/t/exit.t
@@ -48,7 +48,7 @@ my $rc = $thr->join();
 ok(! defined($rc), 'Exited: threads->exit()');
 
 
-run_perl(prog => 'use threads 1.75;' .
+run_perl(prog => 'use threads 1.77;' .
                  'threads->exit(86);' .
                  'exit(99);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -98,7 +98,7 @@ $rc = $thr->join();
 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
 
 
-run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
+run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
                  'threads->create(sub { exit(99); })->join();' .
                  'exit(86);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -108,7 +108,7 @@ run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
     is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 }
 
-my $out = run_perl(prog => 'use threads 1.75;' .
+my $out = run_perl(prog => 'use threads 1.77;' .
                            'threads->create(sub {' .
                            '    exit(99);' .
                            '});' .
@@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 1.75;' .
 like($out, '1 finished and unjoined', "exit(status) in thread");
 
 
-$out = run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 1.77 qw(exit thread_only);' .
                         'threads->create(sub {' .
                         '   threads->set_thread_exit_only(0);' .
                         '   exit(99);' .
@@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 1.75 qw(exit thread_only);' .
 like($out, '1 finished and unjoined', "set_thread_exit_only(0)");
 
 
-run_perl(prog => 'use threads 1.75;' .
+run_perl(prog => 'use threads 1.77;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .
diff --git a/dist/threads/t/thread.t b/dist/threads/t/thread.t
index 6f33cd4256..b390215f16 100644
--- a/dist/threads/t/thread.t
+++ b/dist/threads/t/thread.t
@@ -20,7 +20,7 @@ BEGIN {
     }
 
     $| = 1;
-    print("1..34\n");   ### Number of tests that will be run ###
+    print("1..35\n");   ### Number of tests that will be run ###
 };
 
 print("ok 1 - Loaded\n");
@@ -161,7 +161,7 @@ package main;
 
 # bugid #24165
 
-run_perl(prog => 'use threads 1.75;' .
+run_perl(prog => 'use threads 1.77;' .
                  'sub a{threads->create(shift)} $t = a sub{};' .
                  '$t->tid; $t->join; $t->tid',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -304,6 +304,26 @@ SKIP: {
         "counts of calls to DESTROY");
 }
 
+# Bug 73330 - Apply magic to arg to ->object()
+{
+    my @tids :shared;
+
+    my $thr = threads->create(sub {
+                        lock(@tids);
+                        push(@tids, threads->tid());
+                        cond_signal(@tids);
+                    });
+
+    {
+        lock(@tids);
+        cond_wait(@tids) while (! @tids);
+    }
+
+    ok(threads->object($_), 'Got threads object') foreach (@tids);
+
+    $thr->join();
+}
+
 exit(0);
 
 # EOF
diff --git a/dist/threads/threads.pm b/dist/threads/threads.pm
index 4552e50959..b0c8fe3086 100644
--- a/dist/threads/threads.pm
+++ b/dist/threads/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.75';
+our $VERSION = '1.77';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 1.75
+This document describes threads version 1.77
 
 =head1 SYNOPSIS
 
@@ -361,9 +361,10 @@ key) will cause its ID to be used as the value:
 =item threads->object($tid)
 
 This will return the I<threads> object for the I<active> thread associated
-with the specified thread ID.  Returns C<undef> if there is no thread
-associated with the TID, if the thread is joined or detached, if no TID is
-specified or if the specified TID is undef.
+with the specified thread ID.  If C<$tid> is the value for the current thread,
+then this call works the same as C<-E<gt>self()>.  Otherwise, returns C<undef>
+if there is no thread associated with the TID, if the thread is joined or
+detached, if no TID is specified or if the specified TID is undef.
 
 =item threads->yield()
 
@@ -902,6 +903,18 @@ other threads are started afterwards.
 If the above does not work, or is not adequate for your application, then file
 a bug report on L<http://rt.cpan.org/Public/> against the problematic module.
 
+=item Memory consumption
+
+On most systems, frequent and continual creation and destruction of threads
+can lead to ever-increasing growth in the memory footprint of the Perl
+interpreter.  While it is simple to just launch threads and then
+C<-E<gt>join()> or C<-E<gt>detach()> them, for long-lived applications, it is
+better to maintain a pool of threads, and to reuse them for the work needed,
+using L<queues|Thread::Queue> to notify threads of pending work.  The CPAN
+distribution of this module contains a simple example
+(F<examples/pool_reuse.pl>) illustrating the creation, use and monitoring of a
+pool of I<reusable> threads.
+
 =item Current working directory
 
 On all platforms except MSWin32, the setting for the current working directory
@@ -975,7 +988,7 @@ involved, you may be able to work around this by returning a serialized
 version of the object (e.g., using L<Data::Dumper> or L<Storable>), and then
 reconstituting it in the joining thread.  If you're using Perl 5.10.0 or
 later, and if the class supports L<shared objects|threads::shared/"OBJECTS">,
-you can pass them via L<shared queues| Thread::Queue>.
+you can pass them via L<shared queues|Thread::Queue>.
 
 =item END blocks in threads
 
@@ -1021,7 +1034,7 @@ L<threads> Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/threads>
 
 Annotated POD for L<threads>:
-L<http://annocpan.org/~JDHEDDEN/threads-1.75/threads.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-1.77/threads.pm>
 
 Source repository:
 L<http://code.google.com/p/threads-shared/>
diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs
index 9e602a1bf4..b0f7dc8b00 100755
--- a/dist/threads/threads.xs
+++ b/dist/threads/threads.xs
@@ -52,7 +52,7 @@ typedef perl_os_thread pthread_t;
 
 /* Values for 'state' member */
 #define PERL_ITHR_DETACHED           1 /* Thread has been detached */
-#define PERL_ITHR_JOINED             2 /* Thread has been joined */
+#define PERL_ITHR_JOINED             2 /* Thread is being / has been joined */
 #define PERL_ITHR_FINISHED           4 /* Thread has finished execution */
 #define PERL_ITHR_THREAD_EXIT_ONLY   8 /* exit() only exits current thread */
 #define PERL_ITHR_NONVIABLE         16 /* Thread creation failed */
@@ -1409,6 +1409,7 @@ void
 ithread_object(...)
     PREINIT:
         char *classname;
+        SV *arg;
         UV tid;
         ithread *thread;
         int state;
@@ -1421,34 +1422,47 @@ ithread_object(...)
         }
         classname = (char *)SvPV_nolen(ST(0));
 
-        if ((items < 2) || ! SvOK(ST(1))) {
+        /* Turn $tid from PVLV to SV if needed (bug #73330) */
+        arg = ST(1);
+        SvGETMAGIC(arg);
+
+        if ((items < 2) || ! SvOK(arg)) {
             XSRETURN_UNDEF;
         }
 
         /* threads->object($tid) */
-        tid = SvUV(ST(1));
+        tid = SvUV(arg);
 
-        /* Walk through threads list */
-        MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
-        for (thread = MY_POOL.main_thread.next;
-             thread != &MY_POOL.main_thread;
-             thread = thread->next)
-        {
-            /* Look for TID */
-            if (thread->tid == tid) {
-                /* Ignore if detached or joined */
-                MUTEX_LOCK(&thread->mutex);
-                state = thread->state;
-                MUTEX_UNLOCK(&thread->mutex);
-                if (! (state & PERL_ITHR_UNCALLABLE)) {
-                    /* Put object on stack */
-                    ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
-                    have_obj = 1;
+        /* If current thread wants its own object, then behave the same as
+           ->self() */
+        thread = S_ithread_get(aTHX);
+        if (thread->tid == tid) {
+            ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
+            have_obj = 1;
+
+        } else {
+            /* Walk through threads list */
+            MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
+            for (thread = MY_POOL.main_thread.next;
+                 thread != &MY_POOL.main_thread;
+                 thread = thread->next)
+            {
+                /* Look for TID */
+                if (thread->tid == tid) {
+                    /* Ignore if detached or joined */
+                    MUTEX_LOCK(&thread->mutex);
+                    state = thread->state;
+                    MUTEX_UNLOCK(&thread->mutex);
+                    if (! (state & PERL_ITHR_UNCALLABLE)) {
+                        /* Put object on stack */
+                        ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, TRUE));
+                        have_obj = 1;
+                    }
+                    break;
                 }
-                break;
             }
+            MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
         }
-        MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
 
         if (! have_obj) {
             XSRETURN_UNDEF;
-- 
cgit v1.2.1


From 1a3f0f1d129333944296d9bd29d1641e7de1a13e Mon Sep 17 00:00:00 2001
From: Steffen Mueller <smueller@cpan.org>
Date: Thu, 15 Apr 2010 15:24:57 +0200
Subject: Upgrade to threads-shared-1.33

---
 Porting/Maintainers.pl        |  2 +-
 dist/threads-shared/shared.pm |  9 +++++----
 dist/threads-shared/shared.xs | 45 ++++++++++++++++++++++++++-----------------
 3 files changed, 33 insertions(+), 23 deletions(-)

diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index 5134cee959..771aade873 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -1573,7 +1573,7 @@ use File::Glob qw(:case);
     'threads::shared' =>
 	{
 	'MAINTAINER'	=> 'jdhedden',
-	'DISTRIBUTION'	=> 'JDHEDDEN/threads-shared-1.32.tar.gz',
+	'DISTRIBUTION'	=> 'JDHEDDEN/threads-shared-1.33.tar.gz',
 	'FILES'		=> q[dist/threads-shared],
 	'EXCLUDED'	=> [ qw(examples/class.pl
 				shared.h
diff --git a/dist/threads-shared/shared.pm b/dist/threads-shared/shared.pm
index 72192bc7a0..15e7a021be 100644
--- a/dist/threads-shared/shared.pm
+++ b/dist/threads-shared/shared.pm
@@ -7,7 +7,7 @@ use warnings;
 
 use Scalar::Util qw(reftype refaddr blessed);
 
-our $VERSION = '1.32';
+our $VERSION = '1.33';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -187,7 +187,7 @@ threads::shared - Perl extension for sharing data structures between threads
 
 =head1 VERSION
 
-This document describes threads::shared version 1.32
+This document describes threads::shared version 1.33
 
 =head1 SYNOPSIS
 
@@ -527,7 +527,8 @@ that the contents of hash-based objects will be lost due to the above
 mentioned limitation.  See F<examples/class.pl> (in the CPAN distribution of
 this module) for how to create a class that supports object sharing.
 
-Does not support C<splice> on arrays!
+Does not support C<splice> on arrays.  Does not support explicitly changing
+array lengths via $#array -- use C<push> and C<pop> instead.
 
 Taking references to the elements of shared arrays and hashes does not
 autovivify the elements, and neither does slicing a shared array/hash over
@@ -588,7 +589,7 @@ L<threads::shared> Discussion Forum on CPAN:
 L<http://www.cpanforum.com/dist/threads-shared>
 
 Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.32/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.33/shared.pm>
 
 Source repository:
 L<http://code.google.com/p/threads-shared/>
diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
index 7c9526e2bb..a1c6925f29 100644
--- a/dist/threads-shared/shared.xs
+++ b/dist/threads-shared/shared.xs
@@ -864,29 +864,32 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg)
 {
     dTHXc;
     SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
-    SV** svp;
+    SV** svp = NULL;
 
     ENTER_LOCK;
-    if (SvTYPE(saggregate) == SVt_PVAV) {
-        assert ( mg->mg_ptr == 0 );
-        SHARED_CONTEXT;
-        svp = av_fetch((AV*) saggregate, mg->mg_len, 0);
-    } else {
-        char *key = mg->mg_ptr;
-        I32 len = mg->mg_len;
-        assert ( mg->mg_ptr != 0 );
-        if (mg->mg_len == HEf_SVKEY) {
-            STRLEN slen;
-            key = SvPV((SV *)mg->mg_ptr, slen);
-            len = slen;
-            if (SvUTF8((SV *)mg->mg_ptr)) {
-                len = -len;
+    if (saggregate) {  /* During global destruction, underlying
+                          aggregate may no longer exist */
+        if (SvTYPE(saggregate) == SVt_PVAV) {
+            assert ( mg->mg_ptr == 0 );
+            SHARED_CONTEXT;
+            svp = av_fetch((AV*) saggregate, mg->mg_len, 0);
+        } else {
+            char *key = mg->mg_ptr;
+            I32 len = mg->mg_len;
+            assert ( mg->mg_ptr != 0 );
+            if (mg->mg_len == HEf_SVKEY) {
+                STRLEN slen;
+                key = SvPV((SV *)mg->mg_ptr, slen);
+                len = slen;
+                if (SvUTF8((SV *)mg->mg_ptr)) {
+                    len = -len;
+                }
             }
+            SHARED_CONTEXT;
+            svp = hv_fetch((HV*) saggregate, key, len, 0);
         }
-        SHARED_CONTEXT;
-        svp = hv_fetch((HV*) saggregate, key, len, 0);
+        CALLER_CONTEXT;
     }
-    CALLER_CONTEXT;
     if (svp) {
         /* Exists in the array */
         if (SvROK(*svp)) {
@@ -957,6 +960,12 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
     dTHXc;
     MAGIC *shmg;
     SV *saggregate = S_sharedsv_from_obj(aTHX_ mg->mg_obj);
+
+    /* Object may not exist during global destruction */
+    if (! saggregate) {
+        return (0);
+    }
+
     ENTER_LOCK;
     sharedsv_elem_mg_FETCH(aTHX_ sv, mg);
     if ((shmg = mg_find(sv, PERL_MAGIC_shared_scalar)))
-- 
cgit v1.2.1


From 30b05491367d1fecbb231575d1112420d410cafb Mon Sep 17 00:00:00 2001
From: Steffen Mueller <smueller@cpan.org>
Date: Thu, 15 Apr 2010 16:42:48 +0200
Subject: Bump threads version to 1.77_01

This is due to the POD fix of b91a79b929f6eca75f18124340d2f0f89b9588a9.
---
 dist/threads/threads.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/dist/threads/threads.pm b/dist/threads/threads.pm
index b0c8fe3086..883678935e 100644
--- a/dist/threads/threads.pm
+++ b/dist/threads/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '1.77';
+our $VERSION = '1.77_01';
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
-- 
cgit v1.2.1


From bb5bc4969d327481d130990eb06757413584aa24 Mon Sep 17 00:00:00 2001
From: Eric Brine <ikegami@adaelis.com>
Date: Sun, 17 Jan 2010 20:44:14 -0800
Subject: Add TODO test for RT#72016

---
 ext/IPC-Open3/t/IPC-Open3.t | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t
index 79d5cedde5..849b0baa2e 100644
--- a/ext/IPC-Open3/t/IPC-Open3.t
+++ b/ext/IPC-Open3/t/IPC-Open3.t
@@ -47,7 +47,7 @@ my ($pid, $reaped_pid);
 STDOUT->autoflush;
 STDERR->autoflush;
 
-print "1..22\n";
+print "1..23\n";
 
 # basic
 ok 1, $pid = open3 'WRITE', 'READ', 'ERROR', $perl, '-e', cmd_line(<<'EOF');
@@ -146,3 +146,25 @@ else {
 	print WRITE "ok 22\n";
 	waitpid $pid, 0;
 }
+
+# RT 72016
+eval{$pid = open3 'WRITE', 'READ', 'ERROR', '/non/existant/program'; };
+if (IPC::Open3::DO_SPAWN) {
+    if ($@ || waitpid($pid, 0) > 0) {
+	print "ok 23\n";
+    } else {
+	print "not ok 23\n";
+    }
+} else {
+    if ($@) {
+	# exec failure should throw exception in parent.
+	print "ok 23 # TODO RT 72016\n";
+    } else {
+	if (waitpid($pid, 0) > 0) {
+	    # exec failure currently appears as child error.
+	    print "not ok 23 # TODO RT 72016\n";
+	} else {
+	    print "not ok 23\n";
+	}
+    }
+}
-- 
cgit v1.2.1


From 8960aa876f446ad29b892204eeb41fc724123dcb Mon Sep 17 00:00:00 2001
From: Eric Brine <ikegami@adaelis.com>
Date: Mon, 18 Jan 2010 10:21:20 -0800
Subject: open3 errors in child croak parent RT#72016

Errors in open3 no longer appear to originate from the executed command on forking systems.
---
 ext/IPC-Open3/lib/IPC/Open3.pm | 145 +++++++++++++++++++++++++++--------------
 ext/IPC-Open3/t/IPC-Open3.t    |  11 +---
 2 files changed, 99 insertions(+), 57 deletions(-)

diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm
index 82c20ae828..c367758168 100644
--- a/ext/IPC-Open3/lib/IPC/Open3.pm
+++ b/ext/IPC-Open3/lib/IPC/Open3.pm
@@ -48,7 +48,7 @@ instead of a pipe(2) made.
 
 If either reader or writer is the null string, this will be replaced
 by an autogenerated filehandle.  If so, you must pass a valid lvalue
-in the parameter slot so it can be overwritten in the caller, or 
+in the parameter slot so it can be overwritten in the caller, or
 an exception will be raised.
 
 The filehandles may also be integers, in which case they are understood
@@ -68,9 +68,9 @@ C<open(FOO, "-|")> the child process will just be the forked Perl
 process rather than an external command.  This feature isn't yet
 supported on Win32 platforms.
 
-open3() does not wait for and reap the child process after it exits.  
+open3() does not wait for and reap the child process after it exits.
 Except for short programs where it's acceptable to let the operating system
-take care of this, you need to do this yourself.  This is normally as 
+take care of this, you need to do this yourself.  This is normally as
 simple as calling C<waitpid $pid, 0> when you're done with the process.
 Failing to do this can result in an accumulation of defunct or "zombie"
 processes.  See L<perlfunc/waitpid> for more information.
@@ -161,6 +161,18 @@ sub xpipe {
     pipe $_[0], $_[1] or croak "$Me: pipe($_[0], $_[1]) failed: $!";
 }
 
+sub xpipe_anon {
+    pipe $_[0], $_[1] or croak "$Me: pipe failed: $!";
+}
+
+sub xclose_on_exec {
+    require Fcntl;
+    my $flags = fcntl($_[0], &Fcntl::F_GETFD, 0)
+	or croak "$Me: fcntl failed: $!";
+    fcntl($_[0], &Fcntl::F_SETFD, $flags|&Fcntl::FD_CLOEXEC)
+	or croak "$Me: fcntl failed: $!";
+}
+
 # I tried using a * prototype character for the filehandle but it still
 # disallows a bearword while compiling under strict subs.
 
@@ -199,12 +211,12 @@ sub _open3 {
     unless (eval  {
 	$dad_wtr = $_[1] = gensym unless defined $dad_wtr && length $dad_wtr;
 	$dad_rdr = $_[2] = gensym unless defined $dad_rdr && length $dad_rdr;
-	1; }) 
+	1; })
     {
 	# must strip crud for croak to add back, or looks ugly
 	$@ =~ s/(?<=value attempted) at .*//s;
 	croak "$Me: $@";
-    } 
+    }
 
     $dad_err ||= $dad_rdr;
 
@@ -225,54 +237,89 @@ sub _open3 {
     xpipe $dad_rdr, $kid_wtr if !$dup_rdr;
     xpipe $dad_err, $kid_err if !$dup_err && $dad_err ne $dad_rdr;
 
-    $kidpid = DO_SPAWN ? -1 : xfork;
-    if ($kidpid == 0) {		# Kid
-	# A tie in the parent should not be allowed to cause problems.
-	untie *STDIN;
-	untie *STDOUT;
-	# If she wants to dup the kid's stderr onto her stdout I need to
-	# save a copy of her stdout before I put something else there.
-	if ($dad_rdr ne $dad_err && $dup_err
-		&& xfileno($dad_err) == fileno(STDOUT)) {
-	    my $tmp = gensym;
-	    xopen($tmp, ">&$dad_err");
-	    $dad_err = $tmp;
-	}
+    if (!DO_SPAWN) {
+	# Used to communicate exec failures.
+	xpipe my $stat_r, my $stat_w;
+
+	$kidpid = xfork;
+	if ($kidpid == 0) {  # Kid
+	    eval {
+		# A tie in the parent should not be allowed to cause problems.
+		untie *STDIN;
+		untie *STDOUT;
+
+		close $stat_r;
+		xclose_on_exec $stat_w;
+
+		# If she wants to dup the kid's stderr onto her stdout I need to
+		# save a copy of her stdout before I put something else there.
+		if ($dad_rdr ne $dad_err && $dup_err
+			&& xfileno($dad_err) == fileno(STDOUT)) {
+		    my $tmp = gensym;
+		    xopen($tmp, ">&$dad_err");
+		    $dad_err = $tmp;
+		}
+
+		if ($dup_wtr) {
+		    xopen \*STDIN,  "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr);
+		} else {
+		    xclose $dad_wtr;
+		    xopen \*STDIN,  "<&=" . fileno $kid_rdr;
+		}
+		if ($dup_rdr) {
+		    xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr);
+		} else {
+		    xclose $dad_rdr;
+		    xopen \*STDOUT, ">&=" . fileno $kid_wtr;
+		}
+		if ($dad_rdr ne $dad_err) {
+		    if ($dup_err) {
+			# I have to use a fileno here because in this one case
+			# I'm doing a dup but the filehandle might be a reference
+			# (from the special case above).
+			xopen \*STDERR, ">&" . xfileno($dad_err)
+			    if fileno(STDERR) != xfileno($dad_err);
+		    } else {
+			xclose $dad_err;
+			xopen \*STDERR, ">&=" . fileno $kid_err;
+		    }
+		} else {
+		    xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
+		}
+		return 0 if ($cmd[0] eq '-');
+		exec @cmd or do {
+		    local($")=(" ");
+		    croak "$Me: exec of @cmd failed";
+		};
+	    };
+
+	    my $bang = 0+$!;
+	    my $err = $@;
+	    utf8::encode $err if $] >= 5.008;
+	    print $stat_w pack('IIa*', $bang, length($err), $err);
+	    close $stat_w;
 
-	if ($dup_wtr) {
-	    xopen \*STDIN,  "<&$dad_wtr" if fileno(STDIN) != xfileno($dad_wtr);
-	} else {
-	    xclose $dad_wtr;
-	    xopen \*STDIN,  "<&=" . fileno $kid_rdr;
-	}
-	if ($dup_rdr) {
-	    xopen \*STDOUT, ">&$dad_rdr" if fileno(STDOUT) != xfileno($dad_rdr);
-	} else {
-	    xclose $dad_rdr;
-	    xopen \*STDOUT, ">&=" . fileno $kid_wtr;
+	    eval { require POSIX; POSIX::_exit(255); };
+	    exit 255;
 	}
-	if ($dad_rdr ne $dad_err) {
-	    if ($dup_err) {
-		# I have to use a fileno here because in this one case
-		# I'm doing a dup but the filehandle might be a reference
-		# (from the special case above).
-		xopen \*STDERR, ">&" . xfileno($dad_err)
-		    if fileno(STDERR) != xfileno($dad_err);
-	    } else {
-		xclose $dad_err;
-		xopen \*STDERR, ">&=" . fileno $kid_err;
+	else {  # Parent
+	    close $stat_w;
+	    my $to_read = length(pack('I', 0)) * 2;
+	    my $bytes_read = read($stat_r, my $buf = '', $to_read);
+	    if ($bytes_read) {
+		(my $bang, $to_read) = unpack('II', $buf);
+		read($stat_r, my $err = '', $to_read);
+		if ($err) {
+		    utf8::decode $err if $] >= 5.008;
+		} else {
+		    $err = "$Me: " . ($! = $bang);
+		}
+		$! = $bang;
+		die($err);
 	    }
-	} else {
-	    xopen \*STDERR, ">&STDOUT" if fileno(STDERR) != fileno(STDOUT);
 	}
-	return 0 if ($cmd[0] eq '-');
-	local($")=(" ");
-	exec @cmd or do {
-	    carp "$Me: exec of @cmd failed";
-	    eval { require POSIX; POSIX::_exit(255); };
-	    exit 255;
-	};
-    } elsif (DO_SPAWN) {
+    }
+    else {  # DO_SPAWN
 	# All the bookkeeping of coincidence between handles is
 	# handled in spawn_with_handles.
 
diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t
index 849b0baa2e..23ca8e5602 100644
--- a/ext/IPC-Open3/t/IPC-Open3.t
+++ b/ext/IPC-Open3/t/IPC-Open3.t
@@ -157,14 +157,9 @@ if (IPC::Open3::DO_SPAWN) {
     }
 } else {
     if ($@) {
-	# exec failure should throw exception in parent.
-	print "ok 23 # TODO RT 72016\n";
+	print "ok 23\n";
     } else {
-	if (waitpid($pid, 0) > 0) {
-	    # exec failure currently appears as child error.
-	    print "not ok 23 # TODO RT 72016\n";
-	} else {
-	    print "not ok 23\n";
-	}
+	waitpid($pid, 0);
+	print "not ok 23\n";
     }
 }
-- 
cgit v1.2.1


From 17fddc5cffca4f968d3565ff012c0cfb3af40d68 Mon Sep 17 00:00:00 2001
From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Thu, 15 Apr 2010 16:46:40 +0200
Subject: Bump $VERSION of IPC::Open3 to 1.06

---
 ext/IPC-Open3/lib/IPC/Open3.pm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm
index c367758168..50ae61eb32 100644
--- a/ext/IPC-Open3/lib/IPC/Open3.pm
+++ b/ext/IPC-Open3/lib/IPC/Open3.pm
@@ -9,7 +9,7 @@ require Exporter;
 use Carp;
 use Symbol qw(gensym qualify);
 
-$VERSION	= 1.05;
+$VERSION	= 1.06;
 @ISA		= qw(Exporter);
 @EXPORT		= qw(open3);
 
-- 
cgit v1.2.1


From 7636ea95c57762930accf4358f7c0c2dec086b5e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avar@cpan.org>
Date: Thu, 15 Apr 2010 17:12:04 +0000
Subject: Set the legacy process name with prctl() on assignment to $0 on Linux

Ever since perl 4.000 we've only set the POSIX process name via
argv[0]. Unfortunately on Linux the POSIX name isn't used by utilities
like top(1), ps(1) and killall(1).

Now when we set C<$0 = "hello"> both C<qx[ps h $$]> (POSIX) and
C<qx[ps hc $$]> (legacy) will say "hello", instead of the latter being
"perl" as was previously the case.

See also the March 9 2010 thread "Why doesn't assignment to $0 on
Linux also call prctl()?" on perl5-porters.
---
 handy.h         |  3 +--
 mg.c            | 11 +++++++++++
 pod/perlvar.pod |  7 +++++++
 t/op/magic.t    | 33 ++++++++++++++++++++++++++++++++-
 4 files changed, 51 insertions(+), 3 deletions(-)

diff --git a/handy.h b/handy.h
index ebe523fbec..1ff7fde5b9 100644
--- a/handy.h
+++ b/handy.h
@@ -214,8 +214,7 @@ typedef U64TYPE U64;
  * GMTIME_MAX	GMTIME_MIN	LOCALTIME_MAX	LOCALTIME_MIN
  * HAS_CTIME64	HAS_LOCALTIME64	HAS_GMTIME64	HAS_DIFFTIME64
  * HAS_MKTIME64	HAS_ASCTIME64	HAS_GETADDRINFO	HAS_GETNAMEINFO
- * HAS_INETNTOP	HAS_INETPTON	CHARBITS	HAS_PRCTL_SET_NAME
- * HAS_PRCTL
+ * HAS_INETNTOP	HAS_INETPTON	CHARBITS	HAS_PRCTL
  * Not (yet) used at top level, but mention them for metaconfig
  */
 
diff --git a/mg.c b/mg.c
index 4a8d7673a5..0341f6e9d6 100644
--- a/mg.c
+++ b/mg.c
@@ -57,6 +57,10 @@ tie.
 #  include <sys/pstat.h>
 #endif
 
+#ifdef HAS_PRCTL_SET_NAME
+#  include <sys/prctl.h>
+#endif
+
 #if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
 Signal_t Perl_csighandler(int sig, siginfo_t *, void *);
 #else
@@ -2823,6 +2827,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	    PL_origargv[0][PL_origalen-1] = 0;
 	    for (i = 1; i < PL_origargc; i++)
 		PL_origargv[i] = 0;
+#ifdef HAS_PRCTL_SET_NAME
+	    /* Set the legacy process name in addition to the POSIX name on Linux */
+	    if (prctl(PR_SET_NAME, (unsigned long)s, 0, 0, 0) != 0) {
+		/* diag_listed_as: SKIPME */
+		Perl_croak(aTHX_ "Can't set $0 with prctl(): %s", Strerror(errno));
+	    }
+#endif
 	}
 #endif
 	UNLOCK_DOLLARZERO_MUTEX;
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index febf15f65f..0dd2e1e2f1 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -1026,6 +1026,13 @@ have their own copies of it.
 If the program has been given to perl via the switches C<-e> or C<-E>,
 C<$0> will contain the string C<"-e">.
 
+On Linux as of perl 5.14 the legacy process name will be set with
+L<prctl(2)>, in addition to altering the POSIX name via C<argv[0]> as
+perl has done since version 4.000. Now system utilities that read the
+legacy process name such as ps, top and killall will recognize the
+name you set when assigning to C<$0>. The string you supply will be
+cut off at 16 bytes, this is a limitation imposed by Linux.
+
 =item $[
 X<$[>
 
diff --git a/t/op/magic.t b/t/op/magic.t
index ff5835232c..bef4922719 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -12,7 +12,7 @@ BEGIN {
 use warnings;
 use Config;
 
-plan (tests => 81);
+plan (tests => 83);
 
 $Is_MSWin32  = $^O eq 'MSWin32';
 $Is_NetWare  = $^O eq 'NetWare';
@@ -347,6 +347,37 @@ SKIP: {
 	}
 }
 
+# Check that assigning to $0 on Linux sets the process name with both
+# argv[0] assignment and by calling prctl()
+{
+  SKIP: {
+    skip "We don't have prctl() here", 2 unless $Config{d_prctl_set_name};
+
+    # We don't really need these tests. prctl() is tested in the
+    # Kernel, but test it anyway for our sanity. If something doesn't
+    # work (like if the system doesn't have a ps(1) for whatever
+    # reason) just bail out gracefully.
+    my $maybe_ps = sub {
+        my ($cmd) = @_;
+        local ($?, $!);
+
+        no warnings;
+        my $res = `$cmd`;
+        skip "Couldn't shell out to `$cmd', returned code $?", 2 if $?;
+        return $res;
+    };
+
+    my $name = "Good Morning, Dave";
+    $0 = $name;
+
+    chomp(my $argv0 = $maybe_ps->("ps h $$"));
+    chomp(my $prctl = $maybe_ps->("ps hc $$"));
+
+    like($argv0, $name, "Set process name through argv[0] ($argv0)");
+    like($prctl, substr($name, 0, 15), "Set process name through prctl() ($prctl)");
+  }
+}
+
 {
     my $ok = 1;
     my $warn = '';
-- 
cgit v1.2.1


From 64a8e22bd3d2ce17911ed64f88d590eaef21ce1f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=C3=86var=20Arnfj=C3=B6r=C3=B0=20Bjarmason?= <avar@cpan.org>
Date: Thu, 15 Apr 2010 20:06:24 +0200
Subject: Point submitters to perlbug@perl.org, not perl5-porters@perl.org

We usually want patches in RT. Patches should only go to perl5-porters
if they're intended purely for discussion.
---
 pod/perlrepository.pod | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/pod/perlrepository.pod b/pod/perlrepository.pod
index 731735dd7e..eb748df2a0 100644
--- a/pod/perlrepository.pod
+++ b/pod/perlrepository.pod
@@ -359,10 +359,13 @@ Now you should create a patch file for all your local changes:
   % git format-patch origin
   0001-Rename-Leon-Brocard-to-Orange-Brocard.patch
 
-You should now send an email to perl5-porters@perl.org with a
-description of your changes, and include this patch file as an
-attachment.  (See the next section for how to configure and use git to
-send these emails for you.)
+You should now send an email to either perlbug@perl.org or
+perl5-porters@perl.org with a description of your changes, and include
+this patch file as an attachment. The perlbug address is preferred,
+but use perl5-porters for patches intended for discussion.
+
+See the next section for how to configure and use git to send these
+emails for you.
 
 If you want to delete your temporary branch, you may do so with:
 
@@ -375,8 +378,12 @@ If you want to delete your temporary branch, you may do so with:
 
 =head2 Using git to send patch emails
 
-In your ~/git/perl repository, set the destination email to the
-perl5-porters mailing list.
+In your ~/git/perl repository, set the destination email to perl's bug
+tracker:
+
+  $ git config sendemail.to perlbug@perl.org
+
+Or maybe perl5-porters (discussed above):
 
   $ git config sendemail.to perl5-porters@perl.org
 
@@ -742,8 +749,8 @@ The same patch as above, using github might look like this:
   % git push origin orange
 
 The orange branch has been pushed to GitHub, so you should now send an
-email to perl5-porters@perl.org with a description of your changes and
-the following information:
+email (see L</SUBMITTING A PATCH>) with a description of your changes
+and the following information:
 
   http://github.com/USERNAME/perl/tree/orange
   git@github.com:USERNAME/perl.git branch orange
-- 
cgit v1.2.1


From 5dec12c4fe365d1f431b0a1b786bfae24693e847 Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Sat, 27 Mar 2010 21:38:34 +0200
Subject: Fix a test failure in perl5db.t when Term::ReadLine::Gnu is installed

With Term::ReadLine::Gnu on @INC, the debugger output will include
terminal escape sequences even when empty otherwise. This makes
lib/perl5db.t test 7 ("proxy constant subroutines") fail.

Most of the other tests are already run with ReadLine support disabled, so
bring this one in line too.
---
 lib/perl5db.t | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/perl5db.t b/lib/perl5db.t
index 59acd7a059..3f68759efe 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -143,7 +143,7 @@ SKIP: {
 {
     rc(
         qq|
-        &parse_options("NonStop=0 TTY=db.out LineInfo=db.out");
+        &parse_options("NonStop=0 ReadLine=0 TTY=db.out LineInfo=db.out");
         \n|,
 
         qq|
-- 
cgit v1.2.1


From d34e9bd940817db5ea805b524c18753a4f24a180 Mon Sep 17 00:00:00 2001
From: "Michael G. Schwern" <schwern@pobox.com>
Date: Thu, 15 Apr 2010 21:29:43 +0200
Subject: Fix Data::Dumper's Fix Terse(1) + Indent(2)

RT #73604: When $Data::Dumper::Terse is true, the indentation is thrown
off. It appears to be acting as if the $VAR1 = is still there.
---
 dist/Data-Dumper/Dumper.pm |  2 +-
 dist/Data-Dumper/Dumper.xs |  4 ++--
 dist/Data-Dumper/t/terse.t | 22 ++++++++++++++++++++++
 3 files changed, 25 insertions(+), 3 deletions(-)
 create mode 100644 dist/Data-Dumper/t/terse.t

diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 0eb8bf74fd..91b335bc88 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -234,7 +234,7 @@ sub Dumpperl {
     my $valstr;
     {
       local($s->{apad}) = $s->{apad};
-      $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2;
+      $s->{apad} .= ' ' x (length($name) + 3) if $s->{indent} >= 2 and !$s->{terse};
       $valstr = $s->_dump($val, $name);
     }
 
diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index e3867a1838..f2c18211c8 100644
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -1179,7 +1179,7 @@ Data_Dumper_Dumpxs(href, ...)
 			sv_catpvn(name, tmpbuf, nchars);
 		    }
 		
-		    if (indent >= 2) {
+		    if (indent >= 2 && !terse) {
 			SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
 			newapad = newSVsv(apad);
 			sv_catsv(newapad, tmpsv);
@@ -1193,7 +1193,7 @@ Data_Dumper_Dumpxs(href, ...)
 			    freezer, toaster, purity, deepcopy, quotekeys,
 			    bless, maxdepth, sortkeys);
 		
-		    if (indent >= 2)
+		    if (indent >= 2 && !terse)
 			SvREFCNT_dec(newapad);
 
 		    postlen = av_len(postav);
diff --git a/dist/Data-Dumper/t/terse.t b/dist/Data-Dumper/t/terse.t
new file mode 100644
index 0000000000..8d3ad48894
--- /dev/null
+++ b/dist/Data-Dumper/t/terse.t
@@ -0,0 +1,22 @@
+#!perl
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+
+use Data::Dumper;
+
+my $hash = { foo => 42 };
+
+for my $useperl (0..1) {
+    my $dumper = Data::Dumper->new([$hash]);
+    $dumper->Terse(1);
+    $dumper->Indent(2);
+    $dumper->Useperl($useperl);
+
+    is $dumper->Dump, <<'WANT', "Terse(1), Indent(2), Useperl($useperl)";
+{
+  'foo' => 42
+}
+WANT
+}
-- 
cgit v1.2.1


From 88ac1adb99f10f85af3c62c753fa26a9bd90c4b1 Mon Sep 17 00:00:00 2001
From: Steffen Mueller <smueller@cpan.org>
Date: Thu, 15 Apr 2010 21:57:15 +0200
Subject: Upgrade Data::Dumper to 2.126 CPAN release

No significant changes, just synchronization to the exact release.
---
 dist/Data-Dumper/Changes   | 6 ++++++
 dist/Data-Dumper/Dumper.pm | 4 ++--
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/dist/Data-Dumper/Changes b/dist/Data-Dumper/Changes
index 4efe854ec4..257e7f57d9 100644
--- a/dist/Data-Dumper/Changes
+++ b/dist/Data-Dumper/Changes
@@ -6,6 +6,12 @@ HISTORY - public release history for Data::Dumper
 
 =over 8
 
+=item 2.126 (Apr 15 2010)
+
+Fix Data::Dumper's Fix Terse(1) + Indent(2):
+perl-RT #73604: When $Data::Dumper::Terse is true, the indentation is thrown
+off. It appears to be acting as if the $VAR1 = is still there.
+
 =item 2.125 (Aug  8 2009)
 
 CPAN distribution fixes (meta information for META.yml).
diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 91b335bc88..5967642315 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -9,7 +9,7 @@
 
 package Data::Dumper;
 
-$VERSION = '2.125'; # Don't forget to set version and release date in POD!
+$VERSION = '2.126'; # Don't forget to set version and release date in POD!
 
 #$| = 1;
 
@@ -1297,7 +1297,7 @@ modify it under the same terms as Perl itself.
 
 =head1 VERSION
 
-Version 2.125  (Aug  8 2009)
+Version 2.126  (Apr 15 2010)
 
 =head1 SEE ALSO
 
-- 
cgit v1.2.1


From 4bdcd28f79941508a8c93ba2f2708d7a6cd03bc2 Mon Sep 17 00:00:00 2001
From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Thu, 15 Apr 2010 22:40:32 +0200
Subject: Add new Data::Dumper test file to MANIFEST

---
 MANIFEST | 1 +
 1 file changed, 1 insertion(+)

diff --git a/MANIFEST b/MANIFEST
index c0de439def..eae0fffbb0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2607,6 +2607,7 @@ dist/Data-Dumper/t/freezer.t	See if $Data::Dumper::Freezer works
 dist/Data-Dumper/Todo		Data pretty printer, futures
 dist/Data-Dumper/t/overload.t	See if Data::Dumper works for overloaded data
 dist/Data-Dumper/t/pair.t	See if Data::Dumper pair separator works
+dist/Data-Dumper/t/terse.t	See if Data::Dumper terse option works
 dist/ExtUtils-Install/Changes				ExtUtils-Install change log
 dist/ExtUtils-Install/lib/ExtUtils/Installed.pm		Information on installed extensions
 dist/ExtUtils-Install/lib/ExtUtils/Install.pm		Handles 'make install' on extensions
-- 
cgit v1.2.1