- new upstream version
- release number must be high, because of stale version numbers of some of the subpackages - drop upstreamed patches - update the versions of bundled modules - shorten the paths in @INC - build without DEBUGGING - implement compatibility measures for the above two changes, for a short transition period - provide perl(:MODULE_COMPAT_5.10.0), for that transition period only
This commit is contained in:
parent
357706338a
commit
2e4674016a
@ -1 +1 @@
|
||||
perl-5.10.0.tar.gz
|
||||
perl-5.10.1.tar.bz2
|
||||
|
@ -1,425 +0,0 @@
|
||||
Fix issue with (nested) definition lists in lib/Pod/Html.pm
|
||||
- <dt> tags are not closed
|
||||
- generated code contains spurious </li> closing tags
|
||||
- when other (definition) lists are nested in a definition list, the
|
||||
indentation of sublevels gets messed up because of incorrect
|
||||
placement of <dt> tags
|
||||
|
||||
http://rt.perl.org/rt3/Public/Bug/Display.html?id=45211
|
||||
|
||||
Upstream change 32727.
|
||||
diff -Naur --exclude=debian perl-5.10.0.orig/lib/Pod/Html.pm perl-5.10.0/lib/Pod/Html.pm
|
||||
--- perl-5.10.0.orig/lib/Pod/Html.pm 2007-11-18 02:26:23.000000000 +1100
|
||||
+++ perl-5.10.0/lib/Pod/Html.pm 2007-11-25 22:17:02.000000000 +1100
|
||||
@@ -246,8 +246,8 @@
|
||||
my $Doindex;
|
||||
|
||||
my $Backlink;
|
||||
-my($Listlevel, @Listend);
|
||||
-my $After_Lpar;
|
||||
+my($Listlevel, @Listtype);
|
||||
+my $ListNewTerm;
|
||||
use vars qw($Ignore); # need to localize it later.
|
||||
|
||||
my(%Items_Named, @Items_Seen);
|
||||
@@ -286,7 +286,7 @@
|
||||
$Htmldir = ""; # The directory to which the html pages
|
||||
# will (eventually) be written.
|
||||
$Htmlfile = ""; # write to stdout by default
|
||||
- $Htmlfileurl = "" ; # The url that other files would use to
|
||||
+ $Htmlfileurl = ""; # The url that other files would use to
|
||||
# refer to this file. This is only used
|
||||
# to make relative urls that point to
|
||||
# other files.
|
||||
@@ -302,8 +302,9 @@
|
||||
$Doindex = 1; # non-zero if we should generate an index
|
||||
$Backlink = ''; # text for "back to top" links
|
||||
$Listlevel = 0; # current list depth
|
||||
- @Listend = (); # the text to use to end the list.
|
||||
- $After_Lpar = 0; # set to true after a par in an =item
|
||||
+ @Listtype = (); # list types for open lists
|
||||
+ $ListNewTerm = 0; # indicates new term in definition list; used
|
||||
+ # to correctly open/close <dd> tags
|
||||
$Ignore = 1; # whether or not to format text. we don't
|
||||
# format text until we hit our first pod
|
||||
# directive.
|
||||
@@ -519,7 +520,6 @@
|
||||
|
||||
# now convert this file
|
||||
my $after_item; # set to true after an =item
|
||||
- my $need_dd = 0;
|
||||
warn "Converting input file $Podfile\n" if $Verbose;
|
||||
foreach my $i (0..$#poddata){
|
||||
$_ = $poddata[$i];
|
||||
@@ -527,7 +527,6 @@
|
||||
if (/^(=.*)/s) { # is it a pod directive?
|
||||
$Ignore = 0;
|
||||
$after_item = 0;
|
||||
- $need_dd = 0;
|
||||
$_ = $1;
|
||||
if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
|
||||
process_begin($1, $2);
|
||||
@@ -543,12 +542,12 @@
|
||||
if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading
|
||||
process_head( $1, $2, $Doindex && $index );
|
||||
} elsif (/^=item\s*(.*\S)?/sm) { # =item text
|
||||
- $need_dd = process_item( $1 );
|
||||
+ process_item( $1 );
|
||||
$after_item = 1;
|
||||
} elsif (/^=over\s*(.*)/) { # =over N
|
||||
process_over();
|
||||
} elsif (/^=back/) { # =back
|
||||
- process_back($need_dd);
|
||||
+ process_back();
|
||||
} elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for
|
||||
process_for($1,$2);
|
||||
} else {
|
||||
@@ -563,8 +562,14 @@
|
||||
next if $Ignore;
|
||||
next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
|
||||
print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html';
|
||||
- print HTML "<dd>\n" if $need_dd;
|
||||
my $text = $_;
|
||||
+
|
||||
+ # Open tag for definition list as we have something to put in it
|
||||
+ if( $ListNewTerm ){
|
||||
+ print HTML "<dd>\n";
|
||||
+ $ListNewTerm = 0;
|
||||
+ }
|
||||
+
|
||||
if( $text =~ /\A\s+/ ){
|
||||
process_pre( \$text );
|
||||
print HTML "<pre>\n$text</pre>\n";
|
||||
@@ -594,12 +599,8 @@
|
||||
}
|
||||
## end of experimental
|
||||
|
||||
- if( $after_item ){
|
||||
- $After_Lpar = 1;
|
||||
- }
|
||||
print HTML "<p>$text</p>\n";
|
||||
}
|
||||
- print HTML "</dd>\n" if $need_dd;
|
||||
$after_item = 0;
|
||||
}
|
||||
}
|
||||
@@ -1074,12 +1075,12 @@
|
||||
|
||||
# figure out what kind of item it is.
|
||||
# Build string for referencing this item.
|
||||
- if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
|
||||
+ if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bulleted list
|
||||
next unless $1;
|
||||
$item = $1;
|
||||
} elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
|
||||
$item = $1;
|
||||
- } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
|
||||
+ } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # definition list
|
||||
$item = $1;
|
||||
} else {
|
||||
next;
|
||||
@@ -1099,12 +1100,7 @@
|
||||
$tag =~ /head([1-6])/;
|
||||
my $level = $1;
|
||||
|
||||
- if( $Listlevel ){
|
||||
- warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet;
|
||||
- while( $Listlevel ){
|
||||
- process_back();
|
||||
- }
|
||||
- }
|
||||
+ finish_list();
|
||||
|
||||
print HTML "<p>\n";
|
||||
if( $level == 1 && ! $Top ){
|
||||
@@ -1143,19 +1139,32 @@
|
||||
$name = anchorify($name);
|
||||
print HTML qq{<a name="$name" class="item">}, process_text( \$otext ), '</a>';
|
||||
}
|
||||
- print HTML "</strong>\n";
|
||||
+ print HTML "</strong>";
|
||||
undef( $EmittedItem );
|
||||
}
|
||||
|
||||
-sub emit_li {
|
||||
+sub new_listitem {
|
||||
my( $tag ) = @_;
|
||||
+ # Open tag for definition list as we have something to put in it
|
||||
+ if( ($tag ne 'dl') && ($ListNewTerm) ){
|
||||
+ print HTML "<dd>\n";
|
||||
+ $ListNewTerm = 0;
|
||||
+ }
|
||||
+
|
||||
if( $Items_Seen[$Listlevel]++ == 0 ){
|
||||
- push( @Listend, "</$tag>" );
|
||||
+ # start of new list
|
||||
+ push( @Listtype, "$tag" );
|
||||
print HTML "<$tag>\n";
|
||||
+ } else {
|
||||
+ # if this is not the first item, close the previous one
|
||||
+ if ( $tag eq 'dl' ){
|
||||
+ print HTML "</dd>\n" unless $ListNewTerm;
|
||||
+ } else {
|
||||
+ print HTML "</li>\n";
|
||||
+ }
|
||||
}
|
||||
- my $emitted = $tag eq 'dl' ? 'dt' : 'li';
|
||||
- print HTML "<$emitted>";
|
||||
- return $emitted;
|
||||
+ my $opentag = $tag eq 'dl' ? 'dt' : 'li';
|
||||
+ print HTML "<$opentag>";
|
||||
}
|
||||
|
||||
#
|
||||
@@ -1163,7 +1172,6 @@
|
||||
#
|
||||
sub process_item {
|
||||
my( $otext ) = @_;
|
||||
- my $need_dd = 0; # set to 1 if we need a <dd></dd> after an item
|
||||
|
||||
# lots of documents start a list without doing an =over. this is
|
||||
# bad! but, the proper thing to do seems to be to just assume
|
||||
@@ -1173,43 +1181,41 @@
|
||||
process_over();
|
||||
}
|
||||
|
||||
- # formatting: insert a paragraph if preceding item has >1 paragraph
|
||||
- if( $After_Lpar ){
|
||||
- print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
|
||||
- $After_Lpar = 0;
|
||||
- }
|
||||
-
|
||||
# remove formatting instructions from the text
|
||||
my $text = depod( $otext );
|
||||
|
||||
- my $emitted; # the tag actually emitted, used for closing
|
||||
-
|
||||
# all the list variants:
|
||||
if( $text =~ /\A\*/ ){ # bullet
|
||||
- $emitted = emit_li( 'ul' );
|
||||
+ new_listitem( 'ul' );
|
||||
if ($text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text
|
||||
my $tag = $1;
|
||||
$otext =~ s/\A\*\s+//;
|
||||
emit_item_tag( $otext, $tag, 1 );
|
||||
+ print HTML "\n";
|
||||
}
|
||||
|
||||
} elsif( $text =~ /\A\d+/ ){ # numbered list
|
||||
- $emitted = emit_li( 'ol' );
|
||||
+ new_listitem( 'ol' );
|
||||
if ($text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text
|
||||
my $tag = $1;
|
||||
$otext =~ s/\A\d+\.?\s*//;
|
||||
emit_item_tag( $otext, $tag, 1 );
|
||||
+ print HTML "\n";
|
||||
}
|
||||
|
||||
} else { # definition list
|
||||
- $emitted = emit_li( 'dl' );
|
||||
+ # new_listitem takes care of opening the <dt> tag
|
||||
+ new_listitem( 'dl' );
|
||||
if ($text =~ /\A(.+)\Z/s ){ # should have text
|
||||
emit_item_tag( $otext, $text, 1 );
|
||||
+ # write the definition term and close <dt> tag
|
||||
+ print HTML "</dt>\n";
|
||||
}
|
||||
- $need_dd = 1;
|
||||
+ # trigger opening a <dd> tag for the actual definition; will not
|
||||
+ # happen if next paragraph is also a definition term (=item)
|
||||
+ $ListNewTerm = 1;
|
||||
}
|
||||
print HTML "\n";
|
||||
- return $need_dd;
|
||||
}
|
||||
|
||||
#
|
||||
@@ -1219,30 +1225,31 @@
|
||||
# start a new list
|
||||
$Listlevel++;
|
||||
push( @Items_Seen, 0 );
|
||||
- $After_Lpar = 0;
|
||||
}
|
||||
|
||||
#
|
||||
# process_back - process a pod back tag and convert it to HTML format.
|
||||
#
|
||||
sub process_back {
|
||||
- my $need_dd = shift;
|
||||
if( $Listlevel == 0 ){
|
||||
warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph. ignoring.\n" unless $Quiet;
|
||||
return;
|
||||
}
|
||||
|
||||
- # close off the list. note, I check to see if $Listend[$Listlevel] is
|
||||
+ # close off the list. note, I check to see if $Listtype[$Listlevel] is
|
||||
# defined because an =item directive may have never appeared and thus
|
||||
- # $Listend[$Listlevel] may have never been initialized.
|
||||
+ # $Listtype[$Listlevel] may have never been initialized.
|
||||
$Listlevel--;
|
||||
- if( defined $Listend[$Listlevel] ){
|
||||
- print HTML $need_dd ? "</dd>\n" : "</li>\n" if $After_Lpar;
|
||||
- print HTML $Listend[$Listlevel];
|
||||
- print HTML "\n";
|
||||
- pop( @Listend );
|
||||
+ if( defined $Listtype[$Listlevel] ){
|
||||
+ if ( $Listtype[$Listlevel] eq 'dl' ){
|
||||
+ print HTML "</dd>\n" unless $ListNewTerm;
|
||||
+ } else {
|
||||
+ print HTML "</li>\n";
|
||||
+ }
|
||||
+ print HTML "</$Listtype[$Listlevel]>\n";
|
||||
+ pop( @Listtype );
|
||||
+ $ListNewTerm = 0;
|
||||
}
|
||||
- $After_Lpar = 0;
|
||||
|
||||
# clean up item count
|
||||
pop( @Items_Seen );
|
||||
@@ -2025,9 +2032,11 @@
|
||||
# after the entire pod file has been read and converted.
|
||||
#
|
||||
sub finish_list {
|
||||
- while ($Listlevel > 0) {
|
||||
- print HTML "</dl>\n";
|
||||
- $Listlevel--;
|
||||
+ if( $Listlevel ){
|
||||
+ warn "$0: $Podfile: unterminated list(s) at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet;
|
||||
+ while( $Listlevel ){
|
||||
+ process_back();
|
||||
+ }
|
||||
}
|
||||
}
|
||||
|
||||
diff -Naur --exclude=debian perl-5.10.0.orig/lib/Pod/t/htmllink.t perl-5.10.0/lib/Pod/t/htmllink.t
|
||||
--- perl-5.10.0.orig/lib/Pod/t/htmllink.t 2007-11-18 02:26:23.000000000 +1100
|
||||
+++ perl-5.10.0/lib/Pod/t/htmllink.t 2007-11-25 22:17:02.000000000 +1100
|
||||
@@ -108,24 +108,21 @@
|
||||
<h2><a name="section_three">section three</a></h2>
|
||||
<p>This is section three.</p>
|
||||
<dl>
|
||||
-<dt><strong><a name="item1" class="item">item1</a></strong>
|
||||
+<dt><strong><a name="item1" class="item">item1</a></strong></dt>
|
||||
|
||||
<dd>
|
||||
<p>This is item one.</p>
|
||||
</dd>
|
||||
-</li>
|
||||
-<dt><strong><a name="item_2" class="item">item 2</a></strong>
|
||||
+<dt><strong><a name="item_2" class="item">item 2</a></strong></dt>
|
||||
|
||||
<dd>
|
||||
<p>This is item two.</p>
|
||||
</dd>
|
||||
-</li>
|
||||
-<dt><strong><a name="item_three" class="item">item three</a></strong>
|
||||
+<dt><strong><a name="item_three" class="item">item three</a></strong></dt>
|
||||
|
||||
<dd>
|
||||
<p>This is item three.</p>
|
||||
</dd>
|
||||
-</li>
|
||||
</dl>
|
||||
|
||||
</body>
|
||||
diff -Naur --exclude=debian perl-5.10.0.orig/lib/Pod/t/htmlview.pod perl-5.10.0/lib/Pod/t/htmlview.pod
|
||||
--- perl-5.10.0.orig/lib/Pod/t/htmlview.pod 2007-11-18 02:26:23.000000000 +1100
|
||||
+++ perl-5.10.0/lib/Pod/t/htmlview.pod 2007-11-25 22:17:02.000000000 +1100
|
||||
@@ -110,7 +110,7 @@
|
||||
|
||||
=head1 TESTING FOR AND BEGIN
|
||||
|
||||
-=for html <br>
|
||||
+=for html <br />
|
||||
<p>
|
||||
blah blah
|
||||
</p>
|
||||
diff -Naur --exclude=debian perl-5.10.0.orig/lib/Pod/t/htmlview.t perl-5.10.0/lib/Pod/t/htmlview.t
|
||||
--- perl-5.10.0.orig/lib/Pod/t/htmlview.t 2007-11-18 02:26:23.000000000 +1100
|
||||
+++ perl-5.10.0/lib/Pod/t/htmlview.t 2007-11-25 22:17:02.000000000 +1100
|
||||
@@ -86,17 +86,15 @@
|
||||
<h2><a name="new__"><code>new()</code></a></h2>
|
||||
<p>Constructor method. Accepts the following config options:</p>
|
||||
<dl>
|
||||
-<dt><strong><a name="foo" class="item">foo</a></strong>
|
||||
+<dt><strong><a name="foo" class="item">foo</a></strong></dt>
|
||||
|
||||
<dd>
|
||||
<p>The foo item.</p>
|
||||
</dd>
|
||||
-</li>
|
||||
-<dt><strong><a name="bar" class="item">bar</a></strong>
|
||||
+<dt><strong><a name="bar" class="item">bar</a></strong></dt>
|
||||
|
||||
<dd>
|
||||
<p>The bar item.</p>
|
||||
-</dd>
|
||||
<p>This is a list within a list</p>
|
||||
<ul>
|
||||
<li>
|
||||
@@ -106,30 +104,36 @@
|
||||
<p>The waz item.</p>
|
||||
</li>
|
||||
</ul>
|
||||
-<dt><strong><a name="baz" class="item">baz</a></strong>
|
||||
+</dd>
|
||||
+<dt><strong><a name="baz" class="item">baz</a></strong></dt>
|
||||
|
||||
<dd>
|
||||
<p>The baz item.</p>
|
||||
</dd>
|
||||
-</li>
|
||||
</dl>
|
||||
<p>Title on the same line as the =item + * bullets</p>
|
||||
<ul>
|
||||
<li><strong><a name="black_cat" class="item"><code>Black</code> Cat</a></strong>
|
||||
|
||||
+</li>
|
||||
<li><strong><a name="sat_on_the" class="item">Sat <em>on</em> the</a></strong>
|
||||
|
||||
+</li>
|
||||
<li><strong><a name="mat" class="item">Mat<!></a></strong>
|
||||
|
||||
+</li>
|
||||
</ul>
|
||||
<p>Title on the same line as the =item + numerical bullets</p>
|
||||
<ol>
|
||||
<li><strong><a name="cat" class="item">Cat</a></strong>
|
||||
|
||||
+</li>
|
||||
<li><strong><a name="sat" class="item">Sat</a></strong>
|
||||
|
||||
+</li>
|
||||
<li><strong><a name="mat2" class="item">Mat</a></strong>
|
||||
|
||||
+</li>
|
||||
</ol>
|
||||
<p>No bullets, no title</p>
|
||||
<dl>
|
||||
@@ -137,17 +141,14 @@
|
||||
<dd>
|
||||
<p>Cat</p>
|
||||
</dd>
|
||||
-</li>
|
||||
<dt>
|
||||
<dd>
|
||||
<p>Sat</p>
|
||||
</dd>
|
||||
-</li>
|
||||
<dt>
|
||||
<dd>
|
||||
<p>Mat</p>
|
||||
</dd>
|
||||
-</li>
|
||||
</dl>
|
||||
<p>
|
||||
</p>
|
||||
@@ -157,7 +158,7 @@
|
||||
</p>
|
||||
<hr />
|
||||
<h1><a name="testing_for_and_begin">TESTING FOR AND BEGIN</a></h1>
|
||||
-<br>
|
||||
+<br />
|
||||
<p>
|
||||
blah blah
|
||||
</p><p>intermediate text</p>
|
184
07_fix_nullok
184
07_fix_nullok
@ -1,184 +0,0 @@
|
||||
Change 33287 by nicholas@nicholas-pecuchet on 2008/02/12 11:52:30
|
||||
|
||||
In Perl_load_module_nocontext(), ver can actually be NULL.
|
||||
In Perl_hv_copy_hints_hv(), ohv can actually be NULL.
|
||||
In Perl_sortsv(), Perl_sortsv_flags() and S_qsortsvu(), array can be
|
||||
NULL (if the number of elements to sort is <= 1).
|
||||
In Perl_save_nogv(), gv can not be NULL.
|
||||
In Perl_sv_cmp() and Perl_sv_cmp_locale(), both SVs can be NULL.
|
||||
In Perl_ptr_table_fetch(), the sv can be NULL.
|
||||
In PerlIO_set_ptrcnt(), ptr can be NULL.
|
||||
|
||||
diff -Naur --exclude=debian perl-5.10.0.orig/embed.fnc perl-5.10.0/embed.fnc
|
||||
--- perl-5.10.0.orig/embed.fnc 2007-12-18 21:47:07.000000000 +1100
|
||||
+++ perl-5.10.0/embed.fnc 2008-03-09 19:38:30.000000000 +1100
|
||||
@@ -140,7 +140,7 @@
|
||||
Afnp |OP* |die_nocontext |NN const char* pat|...
|
||||
Afnp |void |deb_nocontext |NN const char* pat|...
|
||||
Afnp |char* |form_nocontext |NN const char* pat|...
|
||||
-Anp |void |load_module_nocontext|U32 flags|NN SV* name|NN SV* ver|...
|
||||
+Anp |void |load_module_nocontext|U32 flags|NN SV* name|NULLOK SV* ver|...
|
||||
Afnp |SV* |mess_nocontext |NN const char* pat|...
|
||||
Afnp |void |warn_nocontext |NN const char* pat|...
|
||||
Afnp |void |warner_nocontext|U32 err|NN const char* pat|...
|
||||
@@ -296,7 +296,7 @@
|
||||
Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags
|
||||
Apd |HV* |gv_stashsv |NULLOK SV* sv|I32 flags
|
||||
Apd |void |hv_clear |NULLOK HV* tb
|
||||
-poM |HV * |hv_copy_hints_hv|NN HV *const ohv
|
||||
+poM |HV * |hv_copy_hints_hv|NULLOK HV *const ohv
|
||||
Ap |void |hv_delayfree_ent|NN HV* hv|NULLOK HE* entry
|
||||
Abmd |SV* |hv_delete |NULLOK HV* tb|NN const char* key|I32 klen \
|
||||
|I32 flags
|
||||
@@ -486,8 +486,8 @@
|
||||
Afp |SV* |mess |NN const char* pat|...
|
||||
Ap |SV* |vmess |NN const char* pat|NULLOK va_list* args
|
||||
EXp |void |qerror |NN SV* err
|
||||
-Apd |void |sortsv |NN SV** array|size_t num_elts|NN SVCOMPARE_t cmp
|
||||
-Apd |void |sortsv_flags |NN SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U32 flags
|
||||
+Apd |void |sortsv |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp
|
||||
+Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U32 flags
|
||||
Apd |int |mg_clear |NN SV* sv
|
||||
Apd |int |mg_copy |NN SV* sv|NN SV* nsv|NULLOK const char* key|I32 klen
|
||||
pd |void |mg_localize |NN SV* sv|NN SV* nsv
|
||||
@@ -768,7 +768,7 @@
|
||||
Ap |void |save_list |NN SV** sarg|I32 maxsarg
|
||||
Ap |void |save_long |NN long* longp
|
||||
Ap |void |save_mortalizesv|NN SV* sv
|
||||
-Ap |void |save_nogv |NULLOK GV* gv
|
||||
+Ap |void |save_nogv |NN GV* gv
|
||||
p |void |save_op
|
||||
Ap |SV* |save_scalar |NN GV* gv
|
||||
Ap |void |save_pptr |NN char** pptr
|
||||
@@ -842,8 +842,8 @@
|
||||
pd |I32 |sv_clean_all
|
||||
pd |void |sv_clean_objs
|
||||
Apd |void |sv_clear |NN SV* sv
|
||||
-Apd |I32 |sv_cmp |NN SV* sv1|NN SV* sv2
|
||||
-Apd |I32 |sv_cmp_locale |NN SV* sv1|NN SV* sv2
|
||||
+Apd |I32 |sv_cmp |NULLOK SV* sv1|NULLOK SV* sv2
|
||||
+Apd |I32 |sv_cmp_locale |NULLOK SV* sv1|NULLOK SV* sv2
|
||||
#if defined(USE_LOCALE_COLLATE)
|
||||
Apd |char* |sv_collxfrm |NN SV* sv|NN STRLEN* nxp
|
||||
#endif
|
||||
@@ -1094,7 +1094,7 @@
|
||||
Ap |yy_parser*|parser_dup |NN const yy_parser *proto|NN CLONE_PARAMS* param
|
||||
#endif
|
||||
Apa |PTR_TBL_t*|ptr_table_new
|
||||
-ApR |void* |ptr_table_fetch|NN PTR_TBL_t *tbl|NN const void *sv
|
||||
+ApR |void* |ptr_table_fetch|NN PTR_TBL_t *tbl|NULLOK const void *sv
|
||||
Ap |void |ptr_table_store|NN PTR_TBL_t *tbl|NULLOK const void *oldsv|NN void *newsv
|
||||
Ap |void |ptr_table_split|NN PTR_TBL_t *tbl
|
||||
Ap |void |ptr_table_clear|NULLOK PTR_TBL_t *tbl
|
||||
@@ -1352,7 +1352,7 @@
|
||||
s |I32 |sortcv |NN SV *a|NN SV *b
|
||||
s |I32 |sortcv_xsub |NN SV *a|NN SV *b
|
||||
s |I32 |sortcv_stacked |NN SV *a|NN SV *b
|
||||
-s |void |qsortsvu |NN SV** array|size_t num_elts|NN SVCOMPARE_t compare
|
||||
+s |void |qsortsvu |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t compare
|
||||
#endif
|
||||
|
||||
#if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT)
|
||||
@@ -1623,7 +1623,8 @@
|
||||
Ap |int |PerlIO_flush |NULLOK PerlIO *f
|
||||
Ap |void |PerlIO_clearerr |NULLOK PerlIO *f
|
||||
Ap |void |PerlIO_set_cnt |NULLOK PerlIO *f|int cnt
|
||||
-Ap |void |PerlIO_set_ptrcnt |NULLOK PerlIO *f|NN STDCHAR *ptr|int cnt
|
||||
+Ap |void |PerlIO_set_ptrcnt |NULLOK PerlIO *f|NULLOK STDCHAR *ptr \
|
||||
+ |int cnt
|
||||
Ap |void |PerlIO_setlinebuf |NULLOK PerlIO *f
|
||||
Ap |SSize_t|PerlIO_read |NULLOK PerlIO *f|NN void *buf|Size_t count
|
||||
Ap |SSize_t|PerlIO_write |NULLOK PerlIO *f|NN const void *buf|Size_t count
|
||||
diff -Naur --exclude=debian perl-5.10.0.orig/proto.h perl-5.10.0/proto.h
|
||||
--- perl-5.10.0.orig/proto.h 2007-12-18 21:47:08.000000000 +1100
|
||||
+++ perl-5.10.0/proto.h 2008-03-09 19:49:22.000000000 +1100
|
||||
@@ -260,8 +260,7 @@
|
||||
__attribute__nonnull__(1);
|
||||
|
||||
PERL_CALLCONV void Perl_load_module_nocontext(U32 flags, SV* name, SV* ver, ...)
|
||||
- __attribute__nonnull__(2)
|
||||
- __attribute__nonnull__(3);
|
||||
+ __attribute__nonnull__(2);
|
||||
|
||||
PERL_CALLCONV SV* Perl_mess_nocontext(const char* pat, ...)
|
||||
__attribute__format__(__printf__,1,2)
|
||||
@@ -678,9 +677,7 @@
|
||||
|
||||
PERL_CALLCONV HV* Perl_gv_stashsv(pTHX_ SV* sv, I32 flags);
|
||||
PERL_CALLCONV void Perl_hv_clear(pTHX_ HV* tb);
|
||||
-PERL_CALLCONV HV * Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
|
||||
- __attribute__nonnull__(pTHX_1);
|
||||
-
|
||||
+PERL_CALLCONV HV * Perl_hv_copy_hints_hv(pTHX_ HV *const ohv);
|
||||
PERL_CALLCONV void Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry)
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
|
||||
@@ -1303,11 +1300,9 @@
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
|
||||
PERL_CALLCONV void Perl_sortsv(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t cmp)
|
||||
- __attribute__nonnull__(pTHX_1)
|
||||
__attribute__nonnull__(pTHX_3);
|
||||
|
||||
PERL_CALLCONV void Perl_sortsv_flags(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t cmp, U32 flags)
|
||||
- __attribute__nonnull__(pTHX_1)
|
||||
__attribute__nonnull__(pTHX_3);
|
||||
|
||||
PERL_CALLCONV int Perl_mg_clear(pTHX_ SV* sv)
|
||||
@@ -2079,7 +2074,9 @@
|
||||
PERL_CALLCONV void Perl_save_mortalizesv(pTHX_ SV* sv)
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
|
||||
-PERL_CALLCONV void Perl_save_nogv(pTHX_ GV* gv);
|
||||
+PERL_CALLCONV void Perl_save_nogv(pTHX_ GV* gv)
|
||||
+ __attribute__nonnull__(pTHX_1);
|
||||
+
|
||||
PERL_CALLCONV void Perl_save_op(pTHX);
|
||||
PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv)
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
@@ -2263,14 +2260,8 @@
|
||||
PERL_CALLCONV void Perl_sv_clear(pTHX_ SV* sv)
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
|
||||
-PERL_CALLCONV I32 Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2)
|
||||
- __attribute__nonnull__(pTHX_1)
|
||||
- __attribute__nonnull__(pTHX_2);
|
||||
-
|
||||
-PERL_CALLCONV I32 Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2)
|
||||
- __attribute__nonnull__(pTHX_1)
|
||||
- __attribute__nonnull__(pTHX_2);
|
||||
-
|
||||
+PERL_CALLCONV I32 Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2);
|
||||
+PERL_CALLCONV I32 Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2);
|
||||
#if defined(USE_LOCALE_COLLATE)
|
||||
PERL_CALLCONV char* Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp)
|
||||
__attribute__nonnull__(pTHX_1)
|
||||
@@ -2936,8 +2927,7 @@
|
||||
|
||||
PERL_CALLCONV void* Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
|
||||
__attribute__warn_unused_result__
|
||||
- __attribute__nonnull__(pTHX_1)
|
||||
- __attribute__nonnull__(pTHX_2);
|
||||
+ __attribute__nonnull__(pTHX_1);
|
||||
|
||||
PERL_CALLCONV void Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
|
||||
__attribute__nonnull__(pTHX_1)
|
||||
@@ -3625,7 +3615,6 @@
|
||||
__attribute__nonnull__(pTHX_2);
|
||||
|
||||
STATIC void S_qsortsvu(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t compare)
|
||||
- __attribute__nonnull__(pTHX_1)
|
||||
__attribute__nonnull__(pTHX_3);
|
||||
|
||||
#endif
|
||||
@@ -4245,9 +4234,7 @@
|
||||
PERL_CALLCONV int Perl_PerlIO_flush(pTHX_ PerlIO *f);
|
||||
PERL_CALLCONV void Perl_PerlIO_clearerr(pTHX_ PerlIO *f);
|
||||
PERL_CALLCONV void Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt);
|
||||
-PERL_CALLCONV void Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, int cnt)
|
||||
- __attribute__nonnull__(pTHX_2);
|
||||
-
|
||||
+PERL_CALLCONV void Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, int cnt);
|
||||
PERL_CALLCONV void Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f);
|
||||
PERL_CALLCONV SSize_t Perl_PerlIO_read(pTHX_ PerlIO *f, void *buf, Size_t count)
|
||||
__attribute__nonnull__(pTHX_2);
|
@ -1,16 +0,0 @@
|
||||
Fix a typo in the predefined common protocols to make "udp" resolve
|
||||
without netbase. Upstream change 33554.
|
||||
|
||||
diff --git a/ext/IO/lib/IO/Socket/INET.pm b/ext/IO/lib/IO/Socket/INET.pm
|
||||
index f8bb338..2f0e5d1 100644
|
||||
--- a/ext/IO/lib/IO/Socket/INET.pm
|
||||
+++ b/ext/IO/lib/IO/Socket/INET.pm
|
||||
@@ -27,7 +27,7 @@ my %socket_type = ( tcp => SOCK_STREAM,
|
||||
);
|
||||
my %proto_number;
|
||||
$proto_number{tcp} = Socket::IPPROTO_TCP() if defined &Socket::IPPROTO_TCP;
|
||||
-$proto_number{upd} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP;
|
||||
+$proto_number{udp} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP;
|
||||
$proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
|
||||
my %proto_name = reverse %proto_number;
|
||||
|
@ -1,62 +0,0 @@
|
||||
Fix a segmentation fault with 'debugperl -Dm'. Upstream change 33388.
|
||||
|
||||
diff --git a/perl.c b/perl.c
|
||||
index e0bc0e7..c5a2070 100644
|
||||
--- a/perl.c
|
||||
+++ b/perl.c
|
||||
@@ -1364,10 +1364,17 @@ perl_free(pTHXx)
|
||||
*/
|
||||
const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
|
||||
if (!s || atoi(s) == 0) {
|
||||
+ const U32 old_debug = PL_debug;
|
||||
/* Emulate the PerlHost behaviour of free()ing all memory allocated in this
|
||||
thread at thread exit. */
|
||||
+ if (DEBUG_m_TEST) {
|
||||
+ PerlIO_puts(Perl_debug_log, "Disabling memory debugging as we "
|
||||
+ "free this thread's memory\n");
|
||||
+ PL_debug &= ~ DEBUG_m_FLAG;
|
||||
+ }
|
||||
while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
|
||||
safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
|
||||
+ PL_debug = old_debug;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
diff --git a/util.c b/util.c
|
||||
index 62fd7ba..d8796cf 100644
|
||||
--- a/util.c
|
||||
+++ b/util.c
|
||||
@@ -178,11 +178,11 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
|
||||
ptr = (Malloc_t)PerlMem_realloc(where,size);
|
||||
PERL_ALLOC_CHECK(ptr);
|
||||
|
||||
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
|
||||
- DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
|
||||
-
|
||||
- if (ptr != NULL) {
|
||||
+ /* MUST do this fixup first, before doing ANYTHING else, as anything else
|
||||
+ might allocate memory/free/move memory, and until we do the fixup, it
|
||||
+ may well be chasing (and writing to) free memory. */
|
||||
#ifdef PERL_TRACK_MEMPOOL
|
||||
+ if (ptr != NULL) {
|
||||
struct perl_memory_debug_header *const header
|
||||
= (struct perl_memory_debug_header *)ptr;
|
||||
|
||||
@@ -198,7 +198,17 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
|
||||
header->prev->next = header;
|
||||
|
||||
ptr = (Malloc_t)((char*)ptr+sTHX);
|
||||
+ }
|
||||
#endif
|
||||
+
|
||||
+ /* In particular, must do that fixup above before logging anything via
|
||||
+ *printf(), as it can reallocate memory, which can cause SEGVs. */
|
||||
+
|
||||
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++));
|
||||
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size));
|
||||
+
|
||||
+
|
||||
+ if (ptr != NULL) {
|
||||
return ptr;
|
||||
}
|
||||
else if (PL_nomemok)
|
@ -1,60 +0,0 @@
|
||||
Allow the quote mark delimiter also for those #include directives chased with
|
||||
"h2ph -a". Debian bug #479762.
|
||||
|
||||
Also add the directory prefix of the current file when the quote syntax is
|
||||
used; 'require' will only look in @INC, not the current directory.
|
||||
|
||||
Upstream change 33835.
|
||||
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
|
||||
index 0bfea18..a3ff285 100644
|
||||
--- a/utils/h2ph.PL
|
||||
+++ b/utils/h2ph.PL
|
||||
@@ -85,7 +85,7 @@ sub reindent($) {
|
||||
}
|
||||
|
||||
my ($t, $tab, %curargs, $new, $eval_index, $dir, $name, $args, $outfile);
|
||||
-my ($incl, $incl_type, $next);
|
||||
+my ($incl, $incl_type, $incl_quote, $next);
|
||||
while (defined (my $file = next_file())) {
|
||||
if (-l $file and -d $file) {
|
||||
link_if_possible($file) if ($opt_l);
|
||||
@@ -186,9 +186,10 @@ while (defined (my $file = next_file())) {
|
||||
print OUT $t,"unless(defined(\&$name)) {\n sub $name () {\t",$new,";}\n}\n";
|
||||
}
|
||||
}
|
||||
- } elsif (/^(include|import|include_next)\s*[<\"](.*)[>\"]/) {
|
||||
+ } elsif (/^(include|import|include_next)\s*([<\"])(.*)[>\"]/) {
|
||||
$incl_type = $1;
|
||||
- $incl = $2;
|
||||
+ $incl_quote = $2;
|
||||
+ $incl = $3;
|
||||
if (($incl_type eq 'include_next') ||
|
||||
($opt_e && exists($bad_file{$incl}))) {
|
||||
$incl =~ s/\.h$/.ph/;
|
||||
@@ -221,6 +222,10 @@ while (defined (my $file = next_file())) {
|
||||
"warn(\$\@) if \$\@;\n");
|
||||
} else {
|
||||
$incl =~ s/\.h$/.ph/;
|
||||
+ # copy the prefix in the quote syntax (#include "x.h") case
|
||||
+ if ($incl !~ m|/| && $incl_quote eq q{"} && $file =~ m|^(.*)/|) {
|
||||
+ $incl = "$1/$incl";
|
||||
+ }
|
||||
print OUT $t,"require '$incl';\n";
|
||||
}
|
||||
} elsif (/^ifdef\s+(\w+)/) {
|
||||
@@ -724,8 +729,13 @@ sub queue_includes_from
|
||||
$line .= <HEADER>;
|
||||
}
|
||||
|
||||
- if ($line =~ /^#\s*include\s+<(.*?)>/) {
|
||||
- push(@ARGV, $1) unless $Is_converted{$1};
|
||||
+ if ($line =~ /^#\s*include\s+([<"])(.*?)[>"]/) {
|
||||
+ my ($delimiter, $new_file) = ($1, $2);
|
||||
+ # copy the prefix in the quote syntax (#include "x.h") case
|
||||
+ if ($delimiter eq q{"} && $file =~ m|^(.*)/|) {
|
||||
+ $new_file = "$1/$new_file";
|
||||
+ }
|
||||
+ push(@ARGV, $new_file) unless $Is_converted{$new_file};
|
||||
}
|
||||
}
|
||||
close HEADER;
|
@ -1,156 +0,0 @@
|
||||
Disable the "v-string in use/require is non-portable" warning (again).
|
||||
|
||||
Upstream change 32910, Debian bug #479863
|
||||
|
||||
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
|
||||
index 77ae15f..7092830 100644
|
||||
--- a/ext/B/B/Deparse.pm
|
||||
+++ b/ext/B/B/Deparse.pm
|
||||
@@ -1456,7 +1456,6 @@ sub declare_hints {
|
||||
my %ignored_hints = (
|
||||
'open<' => 1,
|
||||
'open>' => 1,
|
||||
- 'v_string' => 1,
|
||||
);
|
||||
|
||||
sub declare_hinthash {
|
||||
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
|
||||
index 1dd79a3..29d3cd6 100644
|
||||
--- a/pod/perldiag.pod
|
||||
+++ b/pod/perldiag.pod
|
||||
@@ -4935,18 +4935,6 @@ the version number.
|
||||
(W misc) The version string contains invalid characters at the end, which
|
||||
are being ignored.
|
||||
|
||||
-=item v-string in use/require is non-portable
|
||||
-
|
||||
-(W portable) The use of v-strings is non-portable to older, pre-5.6, Perls.
|
||||
-If you want your scripts to be backward portable, use the floating
|
||||
-point version number: for example, instead of C<use 5.6.1> say
|
||||
-C<use 5.006_001>. This of course won't make older Perls suddenly start
|
||||
-understanding newer features, but at least they will show a sensible
|
||||
-error message indicating the required minimum version.
|
||||
-
|
||||
-This warning is suppressed if the C<use 5.x.y> is preceded by a
|
||||
-C<use 5.006> (see C<use VERSION> in L<perlfunc/use>).
|
||||
-
|
||||
=item Warning: something's wrong
|
||||
|
||||
(W) You passed warn() an empty string (the equivalent of C<warn "">) or
|
||||
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
|
||||
index a779b3b..d64e7a1 100644
|
||||
--- a/pod/perlfunc.pod
|
||||
+++ b/pod/perlfunc.pod
|
||||
@@ -6855,22 +6855,16 @@ of perl older than the specified one.
|
||||
|
||||
Specifying VERSION as a literal of the form v5.6.1 should generally be
|
||||
avoided, because it leads to misleading error messages under earlier
|
||||
-versions of Perl that do not support this syntax. The equivalent numeric
|
||||
-version should be used instead.
|
||||
-
|
||||
-Alternatively, you can use a numeric version C<use 5.006> followed by a
|
||||
-v-string version like C<use v5.10.1>, to avoid the unintuitive C<use
|
||||
-5.010_001>. (older perl versions fail gracefully at the first C<use>,
|
||||
-later perl versions understand the v-string syntax in the second).
|
||||
+versions of Perl (that is, prior to 5.6.0) that do not support this
|
||||
+syntax. The equivalent numeric version should be used instead.
|
||||
|
||||
use v5.6.1; # compile time version check
|
||||
use 5.6.1; # ditto
|
||||
use 5.006_001; # ditto; preferred for backwards compatibility
|
||||
- use 5.006; use 5.6.1; # ditto, for compatibility and readability
|
||||
|
||||
This is often useful if you need to check the current Perl version before
|
||||
-C<use>ing library modules that have changed in incompatible ways from
|
||||
-older versions of Perl. (We try not to do this more than we have to.)
|
||||
+C<use>ing library modules that won't work with older versions of Perl.
|
||||
+(We try not to do this more than we have to.)
|
||||
|
||||
Also, if the specified perl version is greater than or equal to 5.9.5,
|
||||
C<use VERSION> will also load the C<feature> pragma and enable all
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index 64157f3..7a377f0 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -3076,14 +3076,6 @@ PP(pp_require)
|
||||
|
||||
sv = POPs;
|
||||
if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
|
||||
- if ( SvVOK(sv) && ckWARN(WARN_PORTABLE) ) { /* require v5.6.1 */
|
||||
- HV * hinthv = GvHV(PL_hintgv);
|
||||
- SV ** ptr = NULL;
|
||||
- if (hinthv) ptr = hv_fetchs(hinthv, "v_string", FALSE);
|
||||
- if ( !(ptr && *ptr && SvIOK(*ptr) && SvIV(*ptr)) )
|
||||
- Perl_warner(aTHX_ packWARN(WARN_PORTABLE),
|
||||
- "v-string in use/require non-portable");
|
||||
- }
|
||||
sv = new_version(sv);
|
||||
if (!sv_derived_from(PL_patchlevel, "version"))
|
||||
upg_version(PL_patchlevel, TRUE);
|
||||
@@ -3135,26 +3127,14 @@ PP(pp_require)
|
||||
|
||||
/* We do this only with use, not require. */
|
||||
if (PL_compcv &&
|
||||
- /* If we request a version >= 5.6.0, then v-string are OK
|
||||
- so set $^H{v_string} to suppress the v-string warning */
|
||||
- vcmp(sv, sv_2mortal(upg_version(newSVnv(5.006), FALSE))) >= 0) {
|
||||
- HV * hinthv = GvHV(PL_hintgv);
|
||||
- if( hinthv ) {
|
||||
- SV *hint = newSViv(1);
|
||||
- (void)hv_stores(hinthv, "v_string", hint);
|
||||
- /* This will call through to Perl_magic_sethint() which in turn
|
||||
- sets PL_hints correctly. */
|
||||
- SvSETMAGIC(hint);
|
||||
- }
|
||||
/* If we request a version >= 5.9.5, load feature.pm with the
|
||||
* feature bundle that corresponds to the required version. */
|
||||
- if (vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
|
||||
+ vcmp(sv, sv_2mortal(upg_version(newSVnv(5.009005), FALSE))) >= 0) {
|
||||
SV *const importsv = vnormal(sv);
|
||||
*SvPVX_mutable(importsv) = ':';
|
||||
ENTER;
|
||||
Perl_load_module(aTHX_ 0, newSVpvs("feature"), NULL, importsv, NULL);
|
||||
LEAVE;
|
||||
- }
|
||||
}
|
||||
|
||||
RETPUSHYES;
|
||||
diff --git a/t/lib/warnings/pp_ctl b/t/lib/warnings/pp_ctl
|
||||
index 923d54c..afaf0a7 100644
|
||||
--- a/t/lib/warnings/pp_ctl
|
||||
+++ b/t/lib/warnings/pp_ctl
|
||||
@@ -222,18 +222,6 @@ EXPECT
|
||||
Use of uninitialized value $foo in print at (eval 1) line 1.
|
||||
########
|
||||
# pp_ctl.c
|
||||
-use warnings 'portable';
|
||||
-eval 'use 5.6.1';
|
||||
-EXPECT
|
||||
-v-string in use/require non-portable at (eval 1) line 2.
|
||||
-########
|
||||
-# pp_ctl.c
|
||||
-use warnings 'portable';
|
||||
-eval 'use v5.6.1';
|
||||
-EXPECT
|
||||
-v-string in use/require non-portable at (eval 1) line 2.
|
||||
-########
|
||||
-# pp_ctl.c
|
||||
use warnings;
|
||||
{
|
||||
no warnings;
|
||||
@@ -245,15 +233,3 @@ EXPECT
|
||||
use warnings;
|
||||
eval 'use 5.006; use 5.10.0';
|
||||
EXPECT
|
||||
-########
|
||||
-# pp_ctl.c
|
||||
-use warnings;
|
||||
-eval '{use 5.006;} use 5.10.0';
|
||||
-EXPECT
|
||||
-v-string in use/require non-portable at (eval 1) line 2.
|
||||
-########
|
||||
-# pp_ctl.c
|
||||
-use warnings;
|
||||
-eval 'use vars; use 5.10.0';
|
||||
-EXPECT
|
||||
-v-string in use/require non-portable at (eval 1) line 2.
|
@ -1,22 +0,0 @@
|
||||
Fix a segmentation fault occurring in the mod_perl2 test suite. (Closes: #475498)
|
||||
|
||||
Upstream change #33807 backported from blead.
|
||||
|
||||
[perl #52740]
|
||||
diff --git a/sv.c b/sv.c
|
||||
index 718e305..fe36438 100644
|
||||
--- a/sv.c
|
||||
+++ b/sv.c
|
||||
@@ -3557,8 +3557,10 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
|
||||
GvMULTI_on(dstr);
|
||||
return;
|
||||
}
|
||||
- glob_assign_glob(dstr, sstr, dtype);
|
||||
- return;
|
||||
+ if (isGV_with_GP(sstr)) {
|
||||
+ glob_assign_glob(dstr, sstr, dtype);
|
||||
+ return;
|
||||
+ }
|
||||
}
|
||||
|
||||
if (dtype >= SVt_PV) {
|
@ -1,42 +0,0 @@
|
||||
Fix the PerlIO_teardown prototype to suppress a compiler warning. (Closes: #479540)
|
||||
|
||||
Part of upstream change 33370, also in maint-5.10.
|
||||
diff --git a/perl.h b/perl.h
|
||||
index e48f768..abcae45 100644
|
||||
--- a/perl.h
|
||||
+++ b/perl.h
|
||||
@@ -3966,7 +3966,7 @@ typedef Sighandler_t Sigsave_t;
|
||||
#endif
|
||||
|
||||
#ifdef USE_PERLIO
|
||||
-EXTERN_C void PerlIO_teardown();
|
||||
+EXTERN_C void PerlIO_teardown(void);
|
||||
# ifdef USE_ITHREADS
|
||||
# define PERLIO_INIT MUTEX_INIT(&PL_perlio_mutex)
|
||||
# define PERLIO_TERM \
|
||||
diff --git a/perlio.c b/perlio.c
|
||||
index 76fe225..b94acb0 100644
|
||||
--- a/perlio.c
|
||||
+++ b/perlio.c
|
||||
@@ -2413,7 +2413,7 @@ PerlIO_cleanup(pTHX)
|
||||
}
|
||||
}
|
||||
|
||||
-void PerlIO_teardown() /* Call only from PERL_SYS_TERM(). */
|
||||
+void PerlIO_teardown(void) /* Call only from PERL_SYS_TERM(). */
|
||||
{
|
||||
dVAR;
|
||||
#if 0
|
||||
diff --git a/perliol.h b/perliol.h
|
||||
index 756db2d..caba999 100644
|
||||
--- a/perliol.h
|
||||
+++ b/perliol.h
|
||||
@@ -170,7 +170,7 @@ PERL_EXPORT_C void PerlIO_list_free(pTHX_ PerlIO_list_t *list);
|
||||
|
||||
/* PerlIO_teardown doesn't need exporting, but the EXTERN_C is needed
|
||||
* for compiling as C++. Must also match with what perl.h says. */
|
||||
-EXTERN_C void PerlIO_teardown();
|
||||
+EXTERN_C void PerlIO_teardown(void);
|
||||
|
||||
/*--------------------------------------------------------------------------------------*/
|
||||
/* Generic, or stub layer functions */
|
@ -1,20 +0,0 @@
|
||||
Remove numeric overloading of Getopt::Long callback functions. (Closes: #479434)
|
||||
|
||||
The numeric overloading introduced in Getopt::Long 2.36 broke
|
||||
lintian and libvcp-perl.
|
||||
|
||||
Dual-lived module, fixed on the CPAN side in 2.37_01.
|
||||
|
||||
[rt.cpan.org #35759]
|
||||
diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
|
||||
index f44e615..b5f94b1 100644
|
||||
--- a/lib/Getopt/Long.pm
|
||||
+++ b/lib/Getopt/Long.pm
|
||||
@@ -1483,7 +1483,6 @@ sub name {
|
||||
use overload
|
||||
# Treat this object as an oridinary string for legacy API.
|
||||
'""' => \&name,
|
||||
- '0+' => sub { 0 },
|
||||
fallback => 1;
|
||||
|
||||
1;
|
@ -1,47 +0,0 @@
|
||||
Fix Math::BigFloat::sqrt() breaking with too many digits. (Closes: #417528)
|
||||
|
||||
Dual-lived module, fixed on the CPAN side in 1.89.
|
||||
|
||||
Integrated with the other 1.89 changes in blead as change 33715
|
||||
and maint-5.10 as change 33821.
|
||||
|
||||
[rt.cpan.org #34459]
|
||||
diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm
|
||||
index 6e1ecc8..1c1fba8 100644
|
||||
--- a/lib/Math/BigFloat.pm
|
||||
+++ b/lib/Math/BigFloat.pm
|
||||
@@ -2142,8 +2142,9 @@ sub bsqrt
|
||||
# But we need at least $scale digits, so calculate how many are missing
|
||||
my $shift = $scale - $digits;
|
||||
|
||||
- # That should never happen (we take care of integer guesses above)
|
||||
- # $shift = 0 if $shift < 0;
|
||||
+ # This happens if the input had enough digits
|
||||
+ # (we take care of integer guesses above)
|
||||
+ $shift = 0 if $shift < 0;
|
||||
|
||||
# Multiply in steps of 100, by shifting left two times the "missing" digits
|
||||
my $s2 = $shift * 2;
|
||||
diff --git a/lib/Math/BigInt/t/mbimbf.t b/lib/Math/BigInt/t/mbimbf.t
|
||||
index fae3c8c..88201e1 100644
|
||||
--- a/lib/Math/BigInt/t/mbimbf.t
|
||||
+++ b/lib/Math/BigInt/t/mbimbf.t
|
||||
@@ -32,7 +32,7 @@ BEGIN
|
||||
print "# INC = @INC\n";
|
||||
|
||||
plan tests => 684
|
||||
- + 23; # own tests
|
||||
+ + 26; # own tests
|
||||
}
|
||||
|
||||
use Math::BigInt 1.70;
|
||||
@@ -100,3 +100,9 @@ $x = Math::BigFloat->new(100);
|
||||
$x = $x->blog(Math::BigInt->new(10));
|
||||
|
||||
ok ($x,2);
|
||||
+
|
||||
+for my $i (80,88,100) {
|
||||
+ $x = Math::BigFloat->new("1." . ("0" x $i) . "1");
|
||||
+ $x = $x->bsqrt;
|
||||
+ ok ($x, 1);
|
||||
+}
|
@ -1,20 +0,0 @@
|
||||
Fix tainted usage of $ENV{TMPDIR} as an sprintf format in CGI.pm. (Closes: #494679)
|
||||
|
||||
[rt.perl.org #50322]
|
||||
Bleadperl change 33143.
|
||||
|
||||
Note that the inconsistent usage of backslashes doesn't matter, as
|
||||
the whole thing is eval'd in.
|
||||
diff --git a/lib/CGI.pm b/lib/CGI.pm
|
||||
index c0158cb..1bc74a3 100644
|
||||
--- a/lib/CGI.pm
|
||||
+++ b/lib/CGI.pm
|
||||
@@ -4032,7 +4032,7 @@ sub new {
|
||||
my $filename;
|
||||
find_tempdir() unless -w $TMPDIRECTORY;
|
||||
for (my $i = 0; $i < $MAXTRIES; $i++) {
|
||||
- last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
|
||||
+ last if ! -f ($filename = sprintf("\%s${SL}CGItemp%d",$TMPDIRECTORY,$sequence++));
|
||||
}
|
||||
# check that it is a more-or-less valid filename
|
||||
return unless $filename =~ m!^([a-zA-Z0-9_ \'\":/.\$\\-]+)$!;
|
@ -1,20 +0,0 @@
|
||||
Fix Sys::Syslog slowness when logging with non-native mechanisms. (Closes: #498776)
|
||||
|
||||
Revert the 0.25 second timeout change that was added in 0.19 to address
|
||||
an OSX problem with UDP sockets and ICMP responses.
|
||||
|
||||
Fixed upstream in Sys::Syslog 0.25, which changes the timeout default
|
||||
to 0 again on non-OSX hosts and makes it configurable with setlogsock().
|
||||
diff --git a/ext/Sys/Syslog/Syslog.pm b/ext/Sys/Syslog/Syslog.pm
|
||||
index 899f25b..7037e18 100644
|
||||
--- a/ext/Sys/Syslog/Syslog.pm
|
||||
+++ b/ext/Sys/Syslog/Syslog.pm
|
||||
@@ -741,7 +741,7 @@ sub connection_ok {
|
||||
|
||||
my $rin = '';
|
||||
vec($rin, fileno(SYSLOG), 1) = 1;
|
||||
- my $ret = select $rin, undef, $rin, 0.25;
|
||||
+ my $ret = select $rin, undef, $rin, 0;
|
||||
return ($ret ? 0 : 1);
|
||||
}
|
||||
|
@ -1,32 +0,0 @@
|
||||
Fix memory corruption with in-place sorting. (Closes: #498769)
|
||||
|
||||
[perl #54758]
|
||||
|
||||
Fixed in bleadperl by change 33937.
|
||||
diff --git a/pp_sort.c b/pp_sort.c
|
||||
index 582b811..1d38bc3 100644
|
||||
--- a/pp_sort.c
|
||||
+++ b/pp_sort.c
|
||||
@@ -1553,11 +1553,12 @@ PP(pp_sort)
|
||||
max = AvFILL(av) + 1;
|
||||
if (SvMAGICAL(av)) {
|
||||
MEXTEND(SP, max);
|
||||
- p2 = SP;
|
||||
for (i=0; i < max; i++) {
|
||||
SV **svp = av_fetch(av, i, FALSE);
|
||||
*SP++ = (svp) ? *svp : NULL;
|
||||
}
|
||||
+ SP--;
|
||||
+ p1 = p2 = SP - (max-1);
|
||||
}
|
||||
else {
|
||||
if (SvREADONLY(av))
|
||||
@@ -1713,7 +1714,7 @@ PP(pp_sort)
|
||||
SvREADONLY_off(av);
|
||||
else if (av && !sorting_av) {
|
||||
/* simulate pp_aassign of tied AV */
|
||||
- SV** const base = ORIGMARK+1;
|
||||
+ SV** const base = MARK+1;
|
||||
for (i=0; i < max; i++) {
|
||||
base[i] = newSVsv(base[i]);
|
||||
}
|
@ -1,18 +0,0 @@
|
||||
Revert an incorrect substitution optimization introduced in 5.10.0. (Closes: #501178)
|
||||
|
||||
[perl #52658]
|
||||
|
||||
Bug introduced by upstream change 26334, reverted with change 33685 in blead
|
||||
and 33732 in maint-5.10.
|
||||
diff --git a/pp_ctl.c b/pp_ctl.c
|
||||
index 7a377f0..88269a7 100644
|
||||
--- a/pp_ctl.c
|
||||
+++ b/pp_ctl.c
|
||||
@@ -218,7 +218,6 @@ PP(pp_substcont)
|
||||
if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
|
||||
cx->sb_rxtainted |= 2;
|
||||
sv_catsv(dstr, POPs);
|
||||
- FREETMPS; /* Prevent excess tmp stack */
|
||||
|
||||
/* Are we done */
|
||||
if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
|
@ -1,67 +0,0 @@
|
||||
Fix 'Unknown error' messages with attribute.pm. (Closes: #488088)
|
||||
|
||||
[perl #49472]
|
||||
blead change 33265
|
||||
|
||||
From: Dave Mitchell <davem@fdisolutions.com>
|
||||
Date: Sat, 9 Feb 2008 14:56:23 +0000
|
||||
Subject: [PATCH] [perl #49472] Attributes + Unkown Error
|
||||
An errored attribute sub still processes the attributes,
|
||||
which require's attribute.pm, so make sure the error state is
|
||||
passed to the new require
|
||||
|
||||
p4raw-id: //depot/perl@33265
|
||||
---
|
||||
t/comp/require.t | 16 +++++++++++++++-
|
||||
toke.c | 1 +
|
||||
2 files changed, 16 insertions(+), 1 deletions(-)
|
||||
|
||||
diff --git a/t/comp/require.t b/t/comp/require.t
|
||||
index af5e4b2..0746b3b 100755
|
||||
--- a/t/comp/require.t
|
||||
+++ b/t/comp/require.t
|
||||
@@ -15,7 +15,7 @@ krunch.pm krunch.pmc whap.pm whap.pmc);
|
||||
|
||||
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
|
||||
my $Is_UTF8 = (${^OPEN} || "") =~ /:utf8/;
|
||||
-my $total_tests = 49;
|
||||
+my $total_tests = 50;
|
||||
if ($Is_EBCDIC || $Is_UTF8) { $total_tests -= 3; }
|
||||
print "1..$total_tests\n";
|
||||
|
||||
@@ -258,6 +258,20 @@ EOT
|
||||
}
|
||||
}
|
||||
|
||||
+# [perl #49472] Attributes + Unkown Error
|
||||
+
|
||||
+{
|
||||
+ do_require
|
||||
+ 'use strict;sub MODIFY_CODE_ATTRIBUTE{} sub f:Blah {$nosuchvar}';
|
||||
+ my $err = $@;
|
||||
+ $err .= "\n" unless $err =~ /\n$/;
|
||||
+ unless ($err =~ /Global symbol "\$nosuchvar" requires /) {
|
||||
+ $err =~ s/^/# /mg;
|
||||
+ print "${err}not ";
|
||||
+ }
|
||||
+ print "ok ", ++$i, " [perl #49472]\n";
|
||||
+}
|
||||
+
|
||||
##########################################
|
||||
# What follows are UTF-8 specific tests. #
|
||||
# Add generic tests before this point. #
|
||||
diff --git a/toke.c b/toke.c
|
||||
index 2ae8b75..ecee902 100644
|
||||
--- a/toke.c
|
||||
+++ b/toke.c
|
||||
@@ -692,6 +692,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
|
||||
#else
|
||||
parser->nexttoke = 0;
|
||||
#endif
|
||||
+ parser->error_count = oparser ? oparser->error_count : 0;
|
||||
parser->copline = NOLINE;
|
||||
parser->lex_state = LEX_NORMAL;
|
||||
parser->expect = XSTATE;
|
||||
--
|
||||
1.5.6.5
|
||||
|
140
32891.patch
140
32891.patch
@ -1,140 +0,0 @@
|
||||
--- perl-5.10.0/op.c 2007-12-18 05:47:07.000000000 -0500
|
||||
+++ perl-5.10.0/op.c 2007-12-31 11:15:57.000000000 -0500
|
||||
@@ -3992,6 +3992,7 @@
|
||||
static const char no_list_state[] = "Initialization of state variables"
|
||||
" in list context currently forbidden";
|
||||
OP *curop;
|
||||
+ bool maybe_common_vars = TRUE;
|
||||
|
||||
PL_modcount = 0;
|
||||
/* Grandfathering $[ assignment here. Bletch.*/
|
||||
@@ -4009,6 +4010,65 @@
|
||||
o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
|
||||
o->op_private = (U8)(0 | (flags >> 8));
|
||||
|
||||
+ if ((left->op_type == OP_LIST
|
||||
+ || (left->op_type == OP_NULL && left->op_targ == OP_LIST)))
|
||||
+ {
|
||||
+ OP* lop = ((LISTOP*)left)->op_first;
|
||||
+ maybe_common_vars = FALSE;
|
||||
+ while (lop) {
|
||||
+ if (lop->op_type == OP_PADSV ||
|
||||
+ lop->op_type == OP_PADAV ||
|
||||
+ lop->op_type == OP_PADHV ||
|
||||
+ lop->op_type == OP_PADANY) {
|
||||
+ if (!(lop->op_private & OPpLVAL_INTRO))
|
||||
+ maybe_common_vars = TRUE;
|
||||
+
|
||||
+ if (lop->op_private & OPpPAD_STATE) {
|
||||
+ if (left->op_private & OPpLVAL_INTRO) {
|
||||
+ /* Each variable in state($a, $b, $c) = ... */
|
||||
+ }
|
||||
+ else {
|
||||
+ /* Each state variable in
|
||||
+ (state $a, my $b, our $c, $d, undef) = ... */
|
||||
+ }
|
||||
+ yyerror(no_list_state);
|
||||
+ } else {
|
||||
+ /* Each my variable in
|
||||
+ (state $a, my $b, our $c, $d, undef) = ... */
|
||||
+ }
|
||||
+ } else if (lop->op_type == OP_UNDEF ||
|
||||
+ lop->op_type == OP_PUSHMARK) {
|
||||
+ /* undef may be interesting in
|
||||
+ (state $a, undef, state $c) */
|
||||
+ } else {
|
||||
+ /* Other ops in the list. */
|
||||
+ maybe_common_vars = TRUE;
|
||||
+ }
|
||||
+ lop = lop->op_sibling;
|
||||
+ }
|
||||
+ }
|
||||
+ else if ((left->op_private & OPpLVAL_INTRO)
|
||||
+ && ( left->op_type == OP_PADSV
|
||||
+ || left->op_type == OP_PADAV
|
||||
+ || left->op_type == OP_PADHV
|
||||
+ || left->op_type == OP_PADANY))
|
||||
+ {
|
||||
+ maybe_common_vars = FALSE;
|
||||
+ if (left->op_private & OPpPAD_STATE) {
|
||||
+ /* All single variable list context state assignments, hence
|
||||
+ state ($a) = ...
|
||||
+ (state $a) = ...
|
||||
+ state @a = ...
|
||||
+ state (@a) = ...
|
||||
+ (state @a) = ...
|
||||
+ state %a = ...
|
||||
+ state (%a) = ...
|
||||
+ (state %a) = ...
|
||||
+ */
|
||||
+ yyerror(no_list_state);
|
||||
+ }
|
||||
+ }
|
||||
+
|
||||
/* PL_generation sorcery:
|
||||
* an assignment like ($a,$b) = ($c,$d) is easier than
|
||||
* ($a,$b) = ($c,$a), since there is no need for temporary vars.
|
||||
@@ -4023,7 +4083,7 @@
|
||||
* to store these values, evil chicanery is done with SvUVX().
|
||||
*/
|
||||
|
||||
- {
|
||||
+ if (maybe_common_vars) {
|
||||
OP *lastop = o;
|
||||
PL_generation++;
|
||||
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
|
||||
@@ -4084,54 +4144,6 @@
|
||||
o->op_private |= OPpASSIGN_COMMON;
|
||||
}
|
||||
|
||||
- if ((left->op_type == OP_LIST
|
||||
- || (left->op_type == OP_NULL && left->op_targ == OP_LIST))) {
|
||||
- OP* lop = ((LISTOP*)left)->op_first;
|
||||
- while (lop) {
|
||||
- if (lop->op_type == OP_PADSV ||
|
||||
- lop->op_type == OP_PADAV ||
|
||||
- lop->op_type == OP_PADHV ||
|
||||
- lop->op_type == OP_PADANY) {
|
||||
- if (lop->op_private & OPpPAD_STATE) {
|
||||
- if (left->op_private & OPpLVAL_INTRO) {
|
||||
- /* Each variable in state($a, $b, $c) = ... */
|
||||
- }
|
||||
- else {
|
||||
- /* Each state variable in
|
||||
- (state $a, my $b, our $c, $d, undef) = ... */
|
||||
- }
|
||||
- yyerror(no_list_state);
|
||||
- } else {
|
||||
- /* Each my variable in
|
||||
- (state $a, my $b, our $c, $d, undef) = ... */
|
||||
- }
|
||||
- } else {
|
||||
- /* Other ops in the list. undef may be interesting in
|
||||
- (state $a, undef, state $c) */
|
||||
- }
|
||||
- lop = lop->op_sibling;
|
||||
- }
|
||||
- }
|
||||
- else if (((left->op_private & (OPpLVAL_INTRO | OPpPAD_STATE))
|
||||
- == (OPpLVAL_INTRO | OPpPAD_STATE))
|
||||
- && ( left->op_type == OP_PADSV
|
||||
- || left->op_type == OP_PADAV
|
||||
- || left->op_type == OP_PADHV
|
||||
- || left->op_type == OP_PADANY))
|
||||
- {
|
||||
- /* All single variable list context state assignments, hence
|
||||
- state ($a) = ...
|
||||
- (state $a) = ...
|
||||
- state @a = ...
|
||||
- state (@a) = ...
|
||||
- (state @a) = ...
|
||||
- state %a = ...
|
||||
- state (%a) = ...
|
||||
- (state %a) = ...
|
||||
- */
|
||||
- yyerror(no_list_state);
|
||||
- }
|
||||
-
|
||||
if (right && right->op_type == OP_SPLIT && !PL_madskills) {
|
||||
OP* tmpop = ((LISTOP*)right)->op_first;
|
||||
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
|
@ -1,43 +0,0 @@
|
||||
Stop t/op/fork.t relying on rand(). (Closes: #317843)
|
||||
|
||||
[perl #53238]
|
||||
blead change 33749
|
||||
|
||||
From: David Dick <perlbug-followup@perl.org>
|
||||
Date: Tue, 22 Apr 2008 21:12:42 -0700
|
||||
Subject: [PATCH] [perl #53238] Patch to stop t/op/fork.t relying on rand
|
||||
From: David Dick (via RT) <perlbug-followup@perl.org>
|
||||
Message-ID: <rt-3.6.HEAD-23612-1208949161-1511.53238-75-0@perl.org>
|
||||
|
||||
p4raw-id: //depot/perl@33749
|
||||
---
|
||||
t/op/fork.t | 8 +++-----
|
||||
1 files changed, 3 insertions(+), 5 deletions(-)
|
||||
|
||||
diff --git a/t/op/fork.t b/t/op/fork.t
|
||||
index 7318449..a19b260 100755
|
||||
--- a/t/op/fork.t
|
||||
+++ b/t/op/fork.t
|
||||
@@ -445,16 +445,14 @@ pipe(RDR,WTR) or die $!;
|
||||
my $pid = fork;
|
||||
die "fork: $!" if !defined $pid;
|
||||
if ($pid == 0) {
|
||||
- my $rand_child = rand;
|
||||
close RDR;
|
||||
- print WTR $rand_child, "\n";
|
||||
+ print WTR "STRING_FROM_CHILD\n";
|
||||
close WTR;
|
||||
} else {
|
||||
- my $rand_parent = rand;
|
||||
close WTR;
|
||||
- chomp(my $rand_child = <RDR>);
|
||||
+ chomp(my $string_from_child = <RDR>);
|
||||
close RDR;
|
||||
- print $rand_child ne $rand_parent, "\n";
|
||||
+ print $string_from_child eq "STRING_FROM_CHILD", "\n";
|
||||
}
|
||||
EXPECT
|
||||
1
|
||||
--
|
||||
1.5.6.5
|
||||
|
@ -1,17 +0,0 @@
|
||||
Fix memory leak with qr//. (Closes: #503975)
|
||||
|
||||
Adapted from upstream change 34506.
|
||||
diff --git a/pp_hot.c b/pp_hot.c
|
||||
index 57fa328..4a4e9e8 100644
|
||||
--- a/pp_hot.c
|
||||
+++ b/pp_hot.c
|
||||
@@ -1198,6 +1198,9 @@ PP(pp_qr)
|
||||
if (rx->extflags & RXf_TAINTED)
|
||||
SvTAINTED_on(rv);
|
||||
sv_magic(sv,(SV*)ReREFCNT_inc(rx), PERL_MAGIC_qr,0,0);
|
||||
+ if (pkg) {
|
||||
+ SvREFCNT_dec(pkg);
|
||||
+ }
|
||||
XPUSHs(rv);
|
||||
RETURN;
|
||||
}
|
@ -1,35 +0,0 @@
|
||||
Make File::Temp warn on cleaning up the current working directory at exit instead of bailing out. (Closes: #479317)
|
||||
|
||||
Adapted from File-Temp 0.21.
|
||||
[rt.cpan.org #35779]
|
||||
diff --git a/lib/File/Temp.pm b/lib/File/Temp.pm
|
||||
index b933963..ccc2316 100644
|
||||
--- a/lib/File/Temp.pm
|
||||
+++ b/lib/File/Temp.pm
|
||||
@@ -890,7 +890,12 @@ sub _can_do_level {
|
||||
@{ $dirs_to_unlink{$$} } : () );
|
||||
foreach my $dir (@dirs) {
|
||||
if (-d $dir) {
|
||||
- rmtree($dir, $DEBUG, 0);
|
||||
+ # Some versions of rmtree will abort if you attempt to remove
|
||||
+ # the directory you are sitting in. We protect that and turn it
|
||||
+ # into a warning. We do this because this occurs during
|
||||
+ # cleanup and so can not be caught by the user.
|
||||
+ eval { rmtree($dir, $DEBUG, 0); };
|
||||
+ warn $@ if ($@ && $^W);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -2234,6 +2239,12 @@ srand(EXPR) in each child else all the children will attempt to walk
|
||||
through the same set of random file names and may well cause
|
||||
themselves to give up if they exceed the number of retry attempts.
|
||||
|
||||
+=head2 Directory removal
|
||||
+
|
||||
+Note that if you have chdir'ed into the temporary directory and it is
|
||||
+subsequently cleaned up in the END block, then you will get a warning
|
||||
+from File::Path::rmtree().
|
||||
+
|
||||
=head2 BINMODE
|
||||
|
||||
The file returned by File::Temp will have been opened in binary mode
|
@ -1,22 +0,0 @@
|
||||
Fix $? when dumping core. (Closes: #509041)
|
||||
|
||||
WCOREDUMP is in <sys/wait.h>
|
||||
|
||||
Without this, $? & 128 doesn't get set properly on some (glibc) systems
|
||||
when dumping core.
|
||||
diff --git a/perl.h b/perl.h
|
||||
index abcae45..ebf57cd 100644
|
||||
--- a/perl.h
|
||||
+++ b/perl.h
|
||||
@@ -663,6 +663,11 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
|
||||
# include <unistd.h>
|
||||
#endif
|
||||
|
||||
+/* for WCOREDUMP */
|
||||
+#ifdef I_SYS_WAIT
|
||||
+# include <sys/wait.h>
|
||||
+#endif
|
||||
+
|
||||
#ifdef __SYMBIAN32__
|
||||
# undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */
|
||||
#endif
|
@ -1,44 +0,0 @@
|
||||
Fix a memory leak with Scalar::Util::weaken(). (Closes: #506324)
|
||||
|
||||
Upstream change 34209:
|
||||
|
||||
DBI memory leak in 5.10.0 due to change 26530
|
||||
|
||||
A weakref to a HV would leak, because the xhv_backreferences
|
||||
array is created with a refcount of 2 (to avoid premature freeing
|
||||
during global destruction), but the RC was only decremented once
|
||||
when the parent HV was freed.
|
||||
Also, when thread cloned, the new array was being created with a
|
||||
RC of 1, rather than 2, which coincidentally worked due to the
|
||||
first bug.
|
||||
|
||||
p4raw-id: //depot/perl@34209
|
||||
diff --git a/hv.c b/hv.c
|
||||
index c8279d8..80adc1f 100644
|
||||
--- a/hv.c
|
||||
+++ b/hv.c
|
||||
@@ -1961,6 +1961,7 @@ Perl_hv_kill_backrefs(pTHX_ HV *hv) {
|
||||
if (av) {
|
||||
HvAUX(hv)->xhv_backreferences = 0;
|
||||
Perl_sv_kill_backrefs(aTHX_ (SV*) hv, av);
|
||||
+ SvREFCNT_dec(av);
|
||||
}
|
||||
}
|
||||
|
||||
diff --git a/sv.c b/sv.c
|
||||
index fe36438..7eb088b 100644
|
||||
--- a/sv.c
|
||||
+++ b/sv.c
|
||||
@@ -10265,10 +10265,11 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
|
||||
daux->xhv_eiter = saux->xhv_eiter
|
||||
? he_dup(saux->xhv_eiter,
|
||||
(bool)!!HvSHAREKEYS(sstr), param) : 0;
|
||||
+ /* backref array needs refcnt=2; see sv_add_backref */
|
||||
daux->xhv_backreferences =
|
||||
saux->xhv_backreferences
|
||||
? (AV*) SvREFCNT_inc(
|
||||
- sv_dup((SV*)saux->xhv_backreferences, param))
|
||||
+ sv_dup_inc((SV*)saux->xhv_backreferences, param))
|
||||
: 0;
|
||||
|
||||
daux->xhv_mro_meta = saux->xhv_mro_meta
|
@ -1,37 +0,0 @@
|
||||
diff -up perl-5.10.0/lib/Archive/Extract.pm.BAD perl-5.10.0/lib/Archive/Extract.pm
|
||||
--- perl-5.10.0/lib/Archive/Extract.pm.BAD 2009-03-10 15:25:06.000000000 -0400
|
||||
+++ perl-5.10.0/lib/Archive/Extract.pm 2009-03-10 15:25:11.000000000 -0400
|
||||
@@ -550,12 +550,19 @@ sub _untar_bin {
|
||||
$self->bin_tar, '-tf', '-'] :
|
||||
[$self->bin_tar, '-tf', $self->archive];
|
||||
|
||||
- ### run the command ###
|
||||
+ ### run the command
|
||||
+ ### newer versions of 'tar' (1.21 and up) now print record size
|
||||
+ ### to STDERR as well if v OR t is given (used to be both). This
|
||||
+ ### is a 'feature' according to the changelog, so we must now only
|
||||
+ ### inspect STDOUT, otherwise, failures like these occur:
|
||||
+ ### nntp.perl.org/group/perl.cpan.testers/2009/02/msg3230366.html
|
||||
my $buffer = '';
|
||||
- unless( scalar run( command => $cmd,
|
||||
+ my @out = run( command => $cmd,
|
||||
buffer => \$buffer,
|
||||
- verbose => $DEBUG )
|
||||
- ) {
|
||||
+ verbose => $DEBUG );
|
||||
+
|
||||
+ ### command was unsuccessful
|
||||
+ unless( $out[0] ) {
|
||||
return $self->_error(loc(
|
||||
"Error listing contents of archive '%1': %2",
|
||||
$self->archive, $buffer ));
|
||||
@@ -578,7 +585,8 @@ sub _untar_bin {
|
||||
\s+ [\d,.]+ \s tape \s blocks
|
||||
|x ? $1 : $_);
|
||||
|
||||
- } split $/, $buffer;
|
||||
+ ### only STDOUT, see above
|
||||
+ } map { split $/, $_ } @{$out[3]};
|
||||
|
||||
### store the files that are in the archive ###
|
||||
$self->files(\@files);
|
@ -1,218 +0,0 @@
|
||||
http://www.nntp.perl.org/group/perl.perl5.changes/2008/04/msg21478.html
|
||||
- minus the change in Module::CoreList that we are upgrading
|
||||
|
||||
--- perl/Porting/Maintainers.pm#2~33194~ 2008-02-02 09:05:25.000000000 -0800
|
||||
+++ perl/Porting/Maintainers.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -14,11 +14,12 @@
|
||||
require "Maintainers.pl";
|
||||
use vars qw(%Modules %Maintainers);
|
||||
|
||||
-use vars qw(@ISA @EXPORT_OK);
|
||||
+use vars qw(@ISA @EXPORT_OK $VERSION);
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT_OK = qw(%Modules %Maintainers
|
||||
get_module_files get_module_pat
|
||||
show_results process_options);
|
||||
+$VERSION = 0.02;
|
||||
require Exporter;
|
||||
|
||||
use File::Find;
|
||||
@@ -107,9 +108,12 @@
|
||||
my @Files;
|
||||
|
||||
if ($Opened) {
|
||||
- my @raw = `p4 opened`;
|
||||
+ @Files = `p4 opened`;
|
||||
die if $?;
|
||||
- @Files = map {s!#.*!!s; s!^//depot/.*?/perl/!!; $_} @raw;
|
||||
+ foreach (@Files) {
|
||||
+ s!#.*!!s;
|
||||
+ s!^//depot/(?:perl|.*?/perl)/!!;
|
||||
+ }
|
||||
} else {
|
||||
@Files = @ARGV;
|
||||
}
|
||||
|
||||
--- perl/ext/B/B/Concise.pm#2~33126~ 2008-01-30 07:26:23.000000000 -0800
|
||||
+++ perl/ext/B/B/Concise.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -14,7 +14,7 @@
|
||||
|
||||
use Exporter (); # use #5
|
||||
|
||||
-our $VERSION = "0.74";
|
||||
+our $VERSION = "0.75";
|
||||
our @ISA = qw(Exporter);
|
||||
our @EXPORT_OK = qw( set_style set_style_standard add_callback
|
||||
concise_subref concise_cv concise_main
|
||||
|
||||
--- perl/ext/Devel/DProf/DProf.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/Devel/DProf/DProf.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -230,7 +230,7 @@
|
||||
|
||||
use XSLoader ();
|
||||
|
||||
-$Devel::DProf::VERSION = '20050603.00'; # this version not authorized by
|
||||
+$Devel::DProf::VERSION = '20080331.00'; # this version not authorized by
|
||||
# Dean Roehrich. See "Changes" file.
|
||||
|
||||
XSLoader::load 'Devel::DProf', $Devel::DProf::VERSION;
|
||||
|
||||
--- perl/ext/Devel/Peek/Peek.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/Devel/Peek/Peek.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -3,7 +3,7 @@
|
||||
|
||||
package Devel::Peek;
|
||||
|
||||
-$VERSION = '1.03';
|
||||
+$VERSION = '1.04';
|
||||
$XS_VERSION = $VERSION;
|
||||
$VERSION = eval $VERSION;
|
||||
|
||||
|
||||
--- perl/ext/POSIX/POSIX.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/POSIX/POSIX.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -4,7 +4,7 @@
|
||||
|
||||
our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
|
||||
|
||||
-our $VERSION = "1.13";
|
||||
+our $VERSION = "1.14";
|
||||
|
||||
use AutoLoader;
|
||||
|
||||
|
||||
--- perl/ext/PerlIO/encoding/encoding.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/PerlIO/encoding/encoding.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -1,7 +1,7 @@
|
||||
package PerlIO::encoding;
|
||||
|
||||
use strict;
|
||||
-our $VERSION = '0.10';
|
||||
+our $VERSION = '0.11';
|
||||
our $DEBUG = 0;
|
||||
$DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n";
|
||||
|
||||
|
||||
--- perl/ext/PerlIO/scalar/scalar.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/PerlIO/scalar/scalar.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -1,5 +1,5 @@
|
||||
package PerlIO::scalar;
|
||||
-our $VERSION = '0.05';
|
||||
+our $VERSION = '0.06';
|
||||
use XSLoader ();
|
||||
XSLoader::load 'PerlIO::scalar';
|
||||
1;
|
||||
|
||||
--- perl/ext/PerlIO/via/via.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/PerlIO/via/via.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -1,5 +1,5 @@
|
||||
package PerlIO::via;
|
||||
-our $VERSION = '0.04';
|
||||
+our $VERSION = '0.05';
|
||||
use XSLoader ();
|
||||
XSLoader::load 'PerlIO::via';
|
||||
1;
|
||||
|
||||
--- perl/ext/Socket/Socket.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/Socket/Socket.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -1,7 +1,7 @@
|
||||
package Socket;
|
||||
|
||||
our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
|
||||
-$VERSION = "1.80";
|
||||
+$VERSION = "1.81";
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
||||
--- perl/lib/ExtUtils/Embed.pm#2~33574~ 2008-03-26 09:37:45.000000000 -0700
|
||||
+++ perl/lib/ExtUtils/Embed.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -19,7 +19,7 @@
|
||||
use strict;
|
||||
|
||||
# This is not a dual-life module, so no need for development version numbers
|
||||
-$VERSION = '1.27';
|
||||
+$VERSION = '1.28';
|
||||
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(&xsinit &ldopts
|
||||
|
||||
--- perl/lib/Fatal.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/lib/Fatal.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -5,7 +5,7 @@
|
||||
use strict;
|
||||
our($AUTOLOAD, $Debug, $VERSION);
|
||||
|
||||
-$VERSION = 1.05;
|
||||
+$VERSION = 1.06;
|
||||
|
||||
$Debug = 0 unless defined $Debug;
|
||||
|
||||
@@ -106,7 +106,7 @@
|
||||
$proto = eval { prototype "CORE::$name" };
|
||||
die "$name is neither a builtin, nor a Perl subroutine"
|
||||
if $@;
|
||||
- die "Cannot make a non-overridable builtin fatal"
|
||||
+ die "Cannot make the non-overridable builtin $name fatal"
|
||||
if not defined $proto;
|
||||
$core = 1;
|
||||
$call = "CORE::$name";
|
||||
|
||||
--- perl/lib/Fatal.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/lib/Fatal.t 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -3,7 +3,7 @@
|
||||
BEGIN {
|
||||
chdir 't' if -d 't';
|
||||
@INC = '../lib';
|
||||
- print "1..15\n";
|
||||
+ print "1..16\n";
|
||||
}
|
||||
|
||||
use strict;
|
||||
@@ -34,3 +34,9 @@
|
||||
eval { my $a = opendir FOO, 'lkjqweriuapofukndajsdlfjnvcvn' };
|
||||
print "not " if $@ =~ /^Can't open/;
|
||||
print "ok $i\n"; ++$i;
|
||||
+
|
||||
+eval { Fatal->import(qw(print)) };
|
||||
+if ($@ !~ m{Cannot make the non-overridable builtin print fatal}) {
|
||||
+ print "not ";
|
||||
+}
|
||||
+print "ok $i\n"; ++$i;
|
||||
|
||||
--- perl/lib/File/Basename.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/lib/File/Basename.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -54,7 +54,7 @@
|
||||
require Exporter;
|
||||
@ISA = qw(Exporter);
|
||||
@EXPORT = qw(fileparse fileparse_set_fstype basename dirname);
|
||||
-$VERSION = "2.76";
|
||||
+$VERSION = "2.77";
|
||||
|
||||
fileparse_set_fstype($^O);
|
||||
|
||||
|
||||
--- perl/lib/File/Find.pm#2~33162~ 2008-01-31 14:54:31.000000000 -0800
|
||||
+++ perl/lib/File/Find.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -3,7 +3,7 @@
|
||||
use strict;
|
||||
use warnings;
|
||||
use warnings::register;
|
||||
-our $VERSION = '1.12';
|
||||
+our $VERSION = '1.13';
|
||||
require Exporter;
|
||||
require Cwd;
|
||||
|
||||
|
||||
--- perl/os2/OS2/REXX/REXX.pm#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/os2/OS2/REXX/REXX.pm 2008-04-03 09:03:24.000000000 -0700
|
||||
@@ -11,7 +11,7 @@
|
||||
# Other items we are prepared to export if requested
|
||||
@EXPORT_OK = qw(drop register);
|
||||
|
||||
-$VERSION = '1.03';
|
||||
+$VERSION = '1.04';
|
||||
|
||||
# We cannot just put OS2::DLL in @ISA, since some scripts would use
|
||||
# function interface, not method interface...
|
||||
|
@ -1,222 +0,0 @@
|
||||
--- perl/ext/B/t/concise-xs.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/B/t/concise-xs.t 2008-05-20 05:48:04.000000000 -0700
|
||||
@@ -177,7 +177,10 @@
|
||||
},
|
||||
|
||||
POSIX => { dflt => 'constant', # all but 252/589
|
||||
- skip => [qw/ _POSIX_JOB_CONTROL /], # platform varying
|
||||
+ skip => [qw/ _POSIX_JOB_CONTROL /, # platform varying
|
||||
+ # Might be XS or imported from Fcntl, depending on your
|
||||
+ # perl version:
|
||||
+ qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /],
|
||||
perl => [qw/ import croak AUTOLOAD /],
|
||||
|
||||
XS => [qw/ write wctomb wcstombs uname tzset tzname
|
||||
|
||||
--- perl/ext/POSIX/Makefile.PL#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/ext/POSIX/Makefile.PL 2008-05-20 05:48:04.000000000 -0700
|
||||
@@ -48,13 +48,11 @@
|
||||
MAX_INPUT MB_LEN_MAX MSG_CTRUNC MSG_DONTROUTE MSG_EOR MSG_OOB MSG_PEEK
|
||||
MSG_TRUNC MSG_WAITALL NAME_MAX NCCS NGROUPS_MAX NOFLSH OPEN_MAX OPOST
|
||||
PARENB PARMRK PARODD PATH_MAX PIPE_BUF RAND_MAX R_OK SCHAR_MAX
|
||||
- SCHAR_MIN SEEK_CUR SEEK_END SEEK_SET SHRT_MAX SHRT_MIN SIGABRT SIGALRM
|
||||
+ SCHAR_MIN SHRT_MAX SHRT_MIN SIGABRT SIGALRM
|
||||
SIGCHLD SIGCONT SIGFPE SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT
|
||||
SIGSEGV SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU
|
||||
SIGUSR1 SIGUSR2 SIG_BLOCK SIG_SETMASK SIG_UNBLOCK SSIZE_MAX
|
||||
- STDERR_FILENO STDIN_FILENO STDOUT_FILENO STREAM_MAX
|
||||
- S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
|
||||
- S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR TCIFLUSH TCIOFF
|
||||
+ STDERR_FILENO STDIN_FILENO STDOUT_FILENO STREAM_MAX TCIFLUSH TCIOFF
|
||||
TCIOFLUSH TCION TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW
|
||||
TMP_MAX TOSTOP TZNAME_MAX VEOF VEOL VERASE VINTR VKILL VMIN VQUIT
|
||||
VSTART VSTOP VSUSP VTIME WNOHANG WUNTRACED W_OK X_OK
|
||||
|
||||
--- perl/ext/POSIX/POSIX.pm#2~33640~ 2008-04-03 09:03:24.000000000 -0700
|
||||
+++ perl/ext/POSIX/POSIX.pm 2008-05-20 05:48:04.000000000 -0700
|
||||
@@ -4,7 +4,7 @@
|
||||
|
||||
our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
|
||||
|
||||
-our $VERSION = "1.14";
|
||||
+our $VERSION = "1.15";
|
||||
|
||||
use AutoLoader;
|
||||
|
||||
@@ -13,7 +13,10 @@
|
||||
use Fcntl qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK F_SETFD
|
||||
F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK O_ACCMODE O_APPEND
|
||||
O_CREAT O_EXCL O_NOCTTY O_NONBLOCK O_RDONLY O_RDWR O_TRUNC
|
||||
- O_WRONLY);
|
||||
+ O_WRONLY SEEK_CUR SEEK_END SEEK_SET
|
||||
+ S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG
|
||||
+ S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU S_ISGID S_ISUID
|
||||
+ S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR);
|
||||
|
||||
# Grandfather old foo_h form to new :foo_h form
|
||||
my $loaded;
|
||||
@@ -32,9 +35,9 @@
|
||||
|
||||
XSLoader::load 'POSIX', $VERSION;
|
||||
|
||||
-my %NON_CONSTS = (map {($_,1)}
|
||||
- qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS
|
||||
- WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
|
||||
+my %NON_CONSTS
|
||||
+ = (map {($_,1)} qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG
|
||||
+ WTERMSIG));
|
||||
|
||||
sub AUTOLOAD {
|
||||
no strict;
|
||||
|
||||
--- perl/ext/POSIX/POSIX.xs#2~33119~ 2008-01-30 02:06:52.000000000 -0800
|
||||
+++ perl/ext/POSIX/POSIX.xs 2008-05-20 05:48:04.000000000 -0700
|
||||
@@ -404,7 +404,7 @@
|
||||
use ExtUtils::Constant qw (constant_types C_constant XS_constant);
|
||||
|
||||
my $types = {map {($_, 1)} qw(IV)};
|
||||
-my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
|
||||
+my @names = (qw(WEXITSTATUS WIFEXITED
|
||||
WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
|
||||
|
||||
print constant_types(); # macro defs
|
||||
@@ -416,65 +416,14 @@
|
||||
*/
|
||||
|
||||
switch (len) {
|
||||
- case 7:
|
||||
- /* Names all of length 7. */
|
||||
- /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
|
||||
- /* Offset 5 gives the best switch position. */
|
||||
- switch (name[5]) {
|
||||
- case 'E':
|
||||
- if (memEQ(name, "S_ISREG", 7)) {
|
||||
- /* ^ */
|
||||
-#ifdef S_ISREG
|
||||
- *arg_result = S_ISREG(*arg_result);
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- case 'H':
|
||||
- if (memEQ(name, "S_ISCHR", 7)) {
|
||||
- /* ^ */
|
||||
-#ifdef S_ISCHR
|
||||
- *arg_result = S_ISCHR(*arg_result);
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- case 'I':
|
||||
- if (memEQ(name, "S_ISDIR", 7)) {
|
||||
- /* ^ */
|
||||
-#ifdef S_ISDIR
|
||||
- *arg_result = S_ISDIR(*arg_result);
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- case 'L':
|
||||
- if (memEQ(name, "S_ISBLK", 7)) {
|
||||
- /* ^ */
|
||||
-#ifdef S_ISBLK
|
||||
- *arg_result = S_ISBLK(*arg_result);
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- }
|
||||
- break;
|
||||
case 8:
|
||||
/* Names all of length 8. */
|
||||
- /* S_ISFIFO WSTOPSIG WTERMSIG */
|
||||
- /* Offset 3 gives the best switch position. */
|
||||
- switch (name[3]) {
|
||||
- case 'O':
|
||||
+ /* WSTOPSIG WTERMSIG */
|
||||
+ /* Offset 1 gives the best switch position. */
|
||||
+ switch (name[1]) {
|
||||
+ case 'S':
|
||||
if (memEQ(name, "WSTOPSIG", 8)) {
|
||||
- /* ^ */
|
||||
+ /* ^ */
|
||||
#ifdef WSTOPSIG
|
||||
int i = *arg_result;
|
||||
*arg_result = WSTOPSIG(WMUNGE(i));
|
||||
@@ -484,9 +433,9 @@
|
||||
#endif
|
||||
}
|
||||
break;
|
||||
- case 'R':
|
||||
+ case 'T':
|
||||
if (memEQ(name, "WTERMSIG", 8)) {
|
||||
- /* ^ */
|
||||
+ /* ^ */
|
||||
#ifdef WTERMSIG
|
||||
int i = *arg_result;
|
||||
*arg_result = WTERMSIG(WMUNGE(i));
|
||||
@@ -496,17 +445,6 @@
|
||||
#endif
|
||||
}
|
||||
break;
|
||||
- case 'S':
|
||||
- if (memEQ(name, "S_ISFIFO", 8)) {
|
||||
- /* ^ */
|
||||
-#ifdef S_ISFIFO
|
||||
- *arg_result = S_ISFIFO(*arg_result);
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
}
|
||||
break;
|
||||
case 9:
|
||||
|
||||
--- perl/t/lib/proxy_constant_subs.t#1~32694~ 2007-12-22 01:23:09.000000000 -0800
|
||||
+++ perl/t/lib/proxy_constant_subs.t 2008-05-20 05:48:04.000000000 -0700
|
||||
@@ -7,20 +7,20 @@
|
||||
print "1..0 # Skip -- Perl configured without B module\n";
|
||||
exit 0;
|
||||
}
|
||||
- if ($Config::Config{'extensions'} !~ /\bPOSIX\b/) {
|
||||
- print "1..0 # Skip -- Perl configured without POSIX\n";
|
||||
+ if ($Config::Config{'extensions'} !~ /\bFcntl\b/) {
|
||||
+ print "1..0 # Skip -- Perl configured without Fcntl\n";
|
||||
exit 0;
|
||||
}
|
||||
- # errno is a real subroutine, and acts as control
|
||||
+ # S_IFMT is a real subroutine, and acts as control
|
||||
# SEEK_SET is a proxy constant subroutine.
|
||||
- @symbols = qw(errno SEEK_SET);
|
||||
+ @symbols = qw(S_IFMT SEEK_SET);
|
||||
}
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More tests => 4 * @symbols;
|
||||
use B qw(svref_2object GVf_IMPORTED_CV);
|
||||
-use POSIX @symbols;
|
||||
+use Fcntl @symbols;
|
||||
|
||||
# GVf_IMPORTED_CV should not be set on the original, but should be set on the
|
||||
# imported GV.
|
||||
@@ -29,7 +29,7 @@
|
||||
my ($ps, $ms);
|
||||
{
|
||||
no strict 'refs';
|
||||
- $ps = svref_2object(\*{"POSIX::$symbol"});
|
||||
+ $ps = svref_2object(\*{"Fcntl::$symbol"});
|
||||
$ms = svref_2object(\*{"::$symbol"});
|
||||
}
|
||||
isa_ok($ps, 'B::GV');
|
||||
|
@ -1,261 +0,0 @@
|
||||
--- perl/ext/B/t/concise-xs.t#42~33829~ 2008-05-15 05:01:42.000000000 -0700
|
||||
+++ perl/ext/B/t/concise-xs.t 2008-05-21 02:18:00.000000000 -0700
|
||||
@@ -180,7 +180,13 @@
|
||||
skip => [qw/ _POSIX_JOB_CONTROL /, # platform varying
|
||||
# Might be XS or imported from Fcntl, depending on your
|
||||
# perl version:
|
||||
- qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /],
|
||||
+ qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /,
|
||||
+ # Might be XS or AUTOLOADed, depending on your perl
|
||||
+ # version:
|
||||
+ qw /WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
|
||||
+ WSTOPSIG WTERMSIG/,
|
||||
+ 'int_macro_int', # Removed in POSIX 1.16
|
||||
+ ],
|
||||
perl => [qw/ import croak AUTOLOAD /],
|
||||
|
||||
XS => [qw/ write wctomb wcstombs uname tzset tzname
|
||||
@@ -194,7 +200,7 @@
|
||||
mblen lseek log10 localeconv ldexp lchown
|
||||
isxdigit isupper isspace ispunct isprint
|
||||
islower isgraph isdigit iscntrl isalpha
|
||||
- isalnum int_macro_int getcwd frexp fpathconf
|
||||
+ isalnum getcwd frexp fpathconf
|
||||
fmod floor dup2 dup difftime cuserid ctime
|
||||
ctermid cosh constant close clock ceil
|
||||
bootstrap atan asin asctime acos access abort
|
||||
|
||||
--- perl/ext/POSIX/POSIX.pm#55~33826~ 2008-05-15 04:24:43.000000000 -0700
|
||||
+++ perl/ext/POSIX/POSIX.pm 2008-05-21 02:18:00.000000000 -0700
|
||||
@@ -4,7 +4,7 @@
|
||||
|
||||
our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = ();
|
||||
|
||||
-our $VERSION = "1.15";
|
||||
+our $VERSION = "1.16";
|
||||
|
||||
use AutoLoader;
|
||||
|
||||
@@ -35,10 +35,6 @@
|
||||
|
||||
XSLoader::load 'POSIX', $VERSION;
|
||||
|
||||
-my %NON_CONSTS
|
||||
- = (map {($_,1)} qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED WSTOPSIG
|
||||
- WTERMSIG));
|
||||
-
|
||||
sub AUTOLOAD {
|
||||
no strict;
|
||||
no warnings 'uninitialized';
|
||||
@@ -50,15 +46,9 @@
|
||||
local $! = 0;
|
||||
my $constname = $AUTOLOAD;
|
||||
$constname =~ s/.*:://;
|
||||
- if ($NON_CONSTS{$constname}) {
|
||||
- my ($val, $error) = &int_macro_int($constname, $_[0]);
|
||||
- croak $error if $error;
|
||||
- *$AUTOLOAD = sub { &int_macro_int($constname, $_[0]) };
|
||||
- } else {
|
||||
- my ($error, $val) = constant($constname);
|
||||
- croak $error if $error;
|
||||
- *$AUTOLOAD = sub { $val };
|
||||
- }
|
||||
+ my ($error, $val) = constant($constname);
|
||||
+ croak $error if $error;
|
||||
+ *$AUTOLOAD = sub { $val };
|
||||
|
||||
goto &$AUTOLOAD;
|
||||
}
|
||||
|
||||
--- perl/ext/POSIX/POSIX.xs#151~33826~ 2008-05-15 04:24:43.000000000 -0700
|
||||
+++ perl/ext/POSIX/POSIX.xs 2008-05-21 02:18:00.000000000 -0700
|
||||
@@ -394,116 +394,6 @@
|
||||
|
||||
#include "const-c.inc"
|
||||
|
||||
-/* These were implemented in the old "constant" subroutine. They are actually
|
||||
- macros that take an integer argument and return an integer result. */
|
||||
-static int
|
||||
-int_macro_int (const char *name, STRLEN len, IV *arg_result) {
|
||||
- /* Initially switch on the length of the name. */
|
||||
- /* This code has been edited from a "constant" function generated by:
|
||||
-
|
||||
-use ExtUtils::Constant qw (constant_types C_constant XS_constant);
|
||||
-
|
||||
-my $types = {map {($_, 1)} qw(IV)};
|
||||
-my @names = (qw(WEXITSTATUS WIFEXITED
|
||||
- WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
|
||||
-
|
||||
-print constant_types(); # macro defs
|
||||
-foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
|
||||
- print $_, "\n"; # C constant subs
|
||||
-}
|
||||
-print "#### XS Section:\n";
|
||||
-print XS_constant ("POSIX", $types);
|
||||
- */
|
||||
-
|
||||
- switch (len) {
|
||||
- case 8:
|
||||
- /* Names all of length 8. */
|
||||
- /* WSTOPSIG WTERMSIG */
|
||||
- /* Offset 1 gives the best switch position. */
|
||||
- switch (name[1]) {
|
||||
- case 'S':
|
||||
- if (memEQ(name, "WSTOPSIG", 8)) {
|
||||
- /* ^ */
|
||||
-#ifdef WSTOPSIG
|
||||
- int i = *arg_result;
|
||||
- *arg_result = WSTOPSIG(WMUNGE(i));
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- case 'T':
|
||||
- if (memEQ(name, "WTERMSIG", 8)) {
|
||||
- /* ^ */
|
||||
-#ifdef WTERMSIG
|
||||
- int i = *arg_result;
|
||||
- *arg_result = WTERMSIG(WMUNGE(i));
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- }
|
||||
- break;
|
||||
- case 9:
|
||||
- if (memEQ(name, "WIFEXITED", 9)) {
|
||||
-#ifdef WIFEXITED
|
||||
- int i = *arg_result;
|
||||
- *arg_result = WIFEXITED(WMUNGE(i));
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- case 10:
|
||||
- if (memEQ(name, "WIFSTOPPED", 10)) {
|
||||
-#ifdef WIFSTOPPED
|
||||
- int i = *arg_result;
|
||||
- *arg_result = WIFSTOPPED(WMUNGE(i));
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- case 11:
|
||||
- /* Names all of length 11. */
|
||||
- /* WEXITSTATUS WIFSIGNALED */
|
||||
- /* Offset 1 gives the best switch position. */
|
||||
- switch (name[1]) {
|
||||
- case 'E':
|
||||
- if (memEQ(name, "WEXITSTATUS", 11)) {
|
||||
- /* ^ */
|
||||
-#ifdef WEXITSTATUS
|
||||
- int i = *arg_result;
|
||||
- *arg_result = WEXITSTATUS(WMUNGE(i));
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- case 'I':
|
||||
- if (memEQ(name, "WIFSIGNALED", 11)) {
|
||||
- /* ^ */
|
||||
-#ifdef WIFSIGNALED
|
||||
- int i = *arg_result;
|
||||
- *arg_result = WIFSIGNALED(WMUNGE(i));
|
||||
- return PERL_constant_ISIV;
|
||||
-#else
|
||||
- return PERL_constant_NOTDEF;
|
||||
-#endif
|
||||
- }
|
||||
- break;
|
||||
- }
|
||||
- break;
|
||||
- }
|
||||
- return PERL_constant_NOTFOUND;
|
||||
-}
|
||||
-
|
||||
static void
|
||||
restore_sigmask(pTHX_ SV *osset_sv)
|
||||
{
|
||||
@@ -756,47 +646,29 @@
|
||||
|
||||
INCLUDE: const-xs.inc
|
||||
|
||||
-void
|
||||
-int_macro_int(sv, iv)
|
||||
- PREINIT:
|
||||
- dXSTARG;
|
||||
- STRLEN len;
|
||||
- int type;
|
||||
- INPUT:
|
||||
- SV * sv;
|
||||
- const char * s = SvPV(sv, len);
|
||||
- IV iv;
|
||||
- PPCODE:
|
||||
- /* Change this to int_macro_int(s, len, &iv, &nv);
|
||||
- if you need to return both NVs and IVs */
|
||||
- type = int_macro_int(s, len, &iv);
|
||||
- /* Return 1 or 2 items. First is error message, or undef if no error.
|
||||
- Second, if present, is found value */
|
||||
- switch (type) {
|
||||
- case PERL_constant_NOTFOUND:
|
||||
- sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
|
||||
- EXTEND(SP, 1);
|
||||
- PUSHs(&PL_sv_undef);
|
||||
- PUSHs(sv);
|
||||
- break;
|
||||
- case PERL_constant_NOTDEF:
|
||||
- sv = sv_2mortal(newSVpvf(
|
||||
- "Your vendor has not defined POSIX macro %s, used", s));
|
||||
- EXTEND(SP, 1);
|
||||
- PUSHs(&PL_sv_undef);
|
||||
- PUSHs(sv);
|
||||
- break;
|
||||
- case PERL_constant_ISIV:
|
||||
- PUSHi(iv);
|
||||
- break;
|
||||
- default:
|
||||
- sv = sv_2mortal(newSVpvf(
|
||||
- "Unexpected return type %d while processing POSIX macro %s, used",
|
||||
- type, s));
|
||||
- EXTEND(SP, 1);
|
||||
- PUSHs(&PL_sv_undef);
|
||||
- PUSHs(sv);
|
||||
- }
|
||||
+int
|
||||
+WEXITSTATUS(status)
|
||||
+ int status
|
||||
+
|
||||
+int
|
||||
+WIFEXITED(status)
|
||||
+ int status
|
||||
+
|
||||
+int
|
||||
+WIFSIGNALED(status)
|
||||
+ int status
|
||||
+
|
||||
+int
|
||||
+WIFSTOPPED(status)
|
||||
+ int status
|
||||
+
|
||||
+int
|
||||
+WSTOPSIG(status)
|
||||
+ int status
|
||||
+
|
||||
+int
|
||||
+WTERMSIG(status)
|
||||
+ int status
|
||||
|
||||
int
|
||||
isalnum(charstring)
|
||||
|
||||
|
@ -1,61 +0,0 @@
|
||||
--- perl/ext/POSIX/POSIX.xs#152~33896~ 2008-05-21 02:18:00.000000000 -0700
|
||||
+++ perl/ext/POSIX/POSIX.xs 2008-05-21 03:31:32.000000000 -0700
|
||||
@@ -649,26 +649,37 @@
|
||||
int
|
||||
WEXITSTATUS(status)
|
||||
int status
|
||||
-
|
||||
-int
|
||||
-WIFEXITED(status)
|
||||
- int status
|
||||
-
|
||||
-int
|
||||
-WIFSIGNALED(status)
|
||||
- int status
|
||||
-
|
||||
-int
|
||||
-WIFSTOPPED(status)
|
||||
- int status
|
||||
-
|
||||
-int
|
||||
-WSTOPSIG(status)
|
||||
- int status
|
||||
-
|
||||
-int
|
||||
-WTERMSIG(status)
|
||||
- int status
|
||||
+ ALIAS:
|
||||
+ POSIX::WIFEXITED = 1
|
||||
+ POSIX::WIFSIGNALED = 2
|
||||
+ POSIX::WIFSTOPPED = 3
|
||||
+ POSIX::WSTOPSIG = 4
|
||||
+ POSIX::WTERMSIG = 5
|
||||
+ CODE:
|
||||
+ switch(ix) {
|
||||
+ case 0:
|
||||
+ RETVAL = WEXITSTATUS(status);
|
||||
+ break;
|
||||
+ case 1:
|
||||
+ RETVAL = WIFEXITED(status);
|
||||
+ break;
|
||||
+ case 2:
|
||||
+ RETVAL = WIFSIGNALED(status);
|
||||
+ break;
|
||||
+ case 3:
|
||||
+ RETVAL = WIFSTOPPED(status);
|
||||
+ break;
|
||||
+ case 4:
|
||||
+ RETVAL = WSTOPSIG(status);
|
||||
+ break;
|
||||
+ case 5:
|
||||
+ RETVAL = WTERMSIG(status);
|
||||
+ break;
|
||||
+ default:
|
||||
+ Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", ix);
|
||||
+ }
|
||||
+ OUTPUT:
|
||||
+ RETVAL
|
||||
|
||||
int
|
||||
isalnum(charstring)
|
||||
|
@ -1,13 +0,0 @@
|
||||
diff -up perl-5.10.0/regcomp.c.34507 perl-5.10.0/regcomp.c
|
||||
--- perl-5.10.0/regcomp.c.34507 2009-03-09 08:44:12.000000000 -0400
|
||||
+++ perl-5.10.0/regcomp.c 2009-03-09 08:45:36.000000000 -0400
|
||||
@@ -8239,6 +8239,9 @@ parseit:
|
||||
*STRING(ret)= (char)value;
|
||||
STR_LEN(ret)= 1;
|
||||
RExC_emit += STR_SZ(1);
|
||||
+ if (listsv) {
|
||||
+ SvREFCNT_dec(listsv);
|
||||
+ }
|
||||
return ret;
|
||||
}
|
||||
/* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */
|
@ -1,24 +0,0 @@
|
||||
Change 34025 by rgs@scipion on 2008/06/08 14:00:59
|
||||
|
||||
Fix for bug [perl #54934] Attempt to free unreferenced scalar
|
||||
fiddling with the symbol table
|
||||
Keep the refcount of the globs generated by PerlIO::via balanced.
|
||||
|
||||
Affected files ...
|
||||
|
||||
... //depot/perl/ext/PerlIO/via/via.pm#9 edit
|
||||
... //depot/perl/ext/PerlIO/via/via.xs#17 edit
|
||||
|
||||
Differences ...
|
||||
diff -up perl-5.10.0/ext/PerlIO/via/via.xs.34025 perl-5.10.0/ext/PerlIO/via/via.xs
|
||||
--- perl-5.10.0/ext/PerlIO/via/via.xs.34025 2007-12-18 11:47:07.000000000 +0100
|
||||
+++ perl-5.10.0/ext/PerlIO/via/via.xs 2009-01-19 09:15:46.000000000 +0100
|
||||
@@ -89,7 +89,7 @@ PerlIOVia_method(pTHX_ PerlIO * f, char
|
||||
if (!s->fh) {
|
||||
GV *gv = newGVgen(HvNAME_get(s->stash));
|
||||
GvIOp(gv) = newIO();
|
||||
- s->fh = newRV_noinc((SV *) gv);
|
||||
+ s->fh = newRV((SV *) gv);
|
||||
s->io = GvIOp(gv);
|
||||
}
|
||||
IoIFP(s->io) = PerlIONext(f);
|
@ -1,12 +0,0 @@
|
||||
diff -up perl-5.10.0/pp_sys.c.crr perl-5.10.0/pp_sys.c
|
||||
--- perl-5.10.0/pp_sys.c.crr 2007-12-18 11:47:08.000000000 +0100
|
||||
+++ perl-5.10.0/pp_sys.c 2008-06-11 14:50:12.000000000 +0200
|
||||
@@ -3002,7 +3002,7 @@ PP(pp_ftrread)
|
||||
|
||||
case OP_FTEEXEC:
|
||||
#ifdef PERL_EFF_ACCESS
|
||||
- access_mode = W_OK;
|
||||
+ access_mode = X_OK;
|
||||
#else
|
||||
use_access = 0;
|
||||
#endif
|
@ -1,36 +0,0 @@
|
||||
diff -up perl-5.10.0/mg.c.BAD perl-5.10.0/mg.c
|
||||
--- perl-5.10.0/mg.c.BAD 2009-03-11 13:10:22.000000000 -0400
|
||||
+++ perl-5.10.0/mg.c 2009-03-11 13:08:54.000000000 -0400
|
||||
@@ -1543,10 +1543,11 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *m
|
||||
stash = GvSTASH(
|
||||
SvTYPE(mg->mg_obj) == SVt_PVGV
|
||||
? (GV*)mg->mg_obj
|
||||
- : (GV*)SvMAGIC(mg->mg_obj)->mg_obj
|
||||
+ : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
|
||||
);
|
||||
|
||||
- mro_isa_changed_in(stash);
|
||||
+ if (stash)
|
||||
+ mro_isa_changed_in(stash);
|
||||
|
||||
return 0;
|
||||
}
|
||||
--- a/t/mro/pkg_gen.t
|
||||
+++ b/t/mro/pkg_gen.t
|
||||
@@ -4,7 +4,7 @@ use strict;
|
||||
use warnings;
|
||||
|
||||
chdir 't' if -d 't';
|
||||
-require q(./test.pl); plan(tests => 6);
|
||||
+require q(./test.pl); plan(tests => 7);
|
||||
|
||||
{
|
||||
package Foo;
|
||||
@@ -34,3 +34,7 @@ is(mro::get_pkg_gen('Foo'), 1, "pkg_gen 1 for undef %Pkg::");
|
||||
|
||||
delete $::{"Foo::"};
|
||||
is(mro::get_pkg_gen('Foo'), 0, 'pkg_gen 0 for delete $::{Pkg::}');
|
||||
+
|
||||
+delete $::{"Quux::"};
|
||||
+push @Quux::ISA, "Woot"; # should not segfault
|
||||
+ok(1, "No segfault on modification of ISA in a deleted stash");
|
@ -1,12 +0,0 @@
|
||||
diff -up perl-5.10.0/lib/File/Path.pm.BAD perl-5.10.0/lib/File/Path.pm
|
||||
--- perl-5.10.0/lib/File/Path.pm.BAD 2009-03-11 17:54:57.000000000 -0400
|
||||
+++ perl-5.10.0/lib/File/Path.pm 2009-03-11 17:55:32.000000000 -0400
|
||||
@@ -333,7 +333,7 @@ sub _rmtree {
|
||||
}
|
||||
else {
|
||||
_error($arg, "cannot remove directory", $canon);
|
||||
- if (!chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
|
||||
+ if ($Force_Writeable && !chmod($perm, ($Is_VMS ? VMS::Filespec::fileify($root) : $root))
|
||||
) {
|
||||
_error($arg, sprintf("cannot restore permissions to 0%o",$perm), $canon);
|
||||
}
|
@ -1,202 +0,0 @@
|
||||
diff -up perl-5.10.0/embed.fnc.much perl-5.10.0/embed.fnc
|
||||
--- perl-5.10.0/embed.fnc.much 2009-07-27 08:31:33.839374246 +0200
|
||||
+++ perl-5.10.0/embed.fnc 2009-07-27 08:32:05.322374620 +0200
|
||||
@@ -1441,7 +1441,6 @@ ERsn |U8* |reghop4 |NN U8 *pos|I32 off|N
|
||||
#endif
|
||||
ERsn |U8* |reghopmaybe3 |NN U8 *pos|I32 off|NN const U8 *lim
|
||||
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
|
||||
-Es |void |swap_match_buff|NN regexp * prog
|
||||
Es |void |to_utf8_substr |NN regexp * prog
|
||||
Es |void |to_byte_substr |NN regexp * prog
|
||||
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex|NN const regnode *prog
|
||||
diff -up perl-5.10.0/embed.h.much perl-5.10.0/embed.h
|
||||
--- perl-5.10.0/embed.h.much 2007-12-18 11:47:07.000000000 +0100
|
||||
+++ perl-5.10.0/embed.h 2009-07-27 08:31:34.016378805 +0200
|
||||
@@ -1426,7 +1426,6 @@
|
||||
#if defined(PERL_CORE) || defined(PERL_EXT)
|
||||
#define reghopmaybe3 S_reghopmaybe3
|
||||
#define find_byclass S_find_byclass
|
||||
-#define swap_match_buff S_swap_match_buff
|
||||
#define to_utf8_substr S_to_utf8_substr
|
||||
#define to_byte_substr S_to_byte_substr
|
||||
#define reg_check_named_buff_matched S_reg_check_named_buff_matched
|
||||
@@ -3714,7 +3713,6 @@
|
||||
#if defined(PERL_CORE) || defined(PERL_EXT)
|
||||
#define reghopmaybe3 S_reghopmaybe3
|
||||
#define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e)
|
||||
-#define swap_match_buff(a) S_swap_match_buff(aTHX_ a)
|
||||
#define to_utf8_substr(a) S_to_utf8_substr(aTHX_ a)
|
||||
#define to_byte_substr(a) S_to_byte_substr(aTHX_ a)
|
||||
#define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b)
|
||||
diff -up perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc.much perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc
|
||||
--- perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc.much 2007-12-18 11:47:07.000000000 +0100
|
||||
+++ perl-5.10.0/ext/Devel/PPPort/parts/embed.fnc 2009-07-27 08:32:58.859374528 +0200
|
||||
@@ -1436,7 +1436,6 @@ ERsn |U8* |reghop4 |NN U8 *pos|I32 off|N
|
||||
#endif
|
||||
ERsn |U8* |reghopmaybe3 |NN U8 *pos|I32 off|NN const U8 *lim
|
||||
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
|
||||
-Es |void |swap_match_buff|NN regexp * prog
|
||||
Es |void |to_utf8_substr |NN regexp * prog
|
||||
Es |void |to_byte_substr |NN regexp * prog
|
||||
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex|NN const regnode *prog
|
||||
diff -up perl-5.10.0/pod/perlapi.pod.much perl-5.10.0/pod/perlapi.pod
|
||||
diff -up perl-5.10.0/pod/perlguts.pod.much perl-5.10.0/pod/perlguts.pod
|
||||
diff -up perl-5.10.0/proto.h.much perl-5.10.0/proto.h
|
||||
--- perl-5.10.0/proto.h.much 2009-07-27 08:31:33.000000000 +0200
|
||||
+++ perl-5.10.0/proto.h 2009-07-27 08:35:52.103374484 +0200
|
||||
@@ -3851,9 +3851,6 @@ STATIC char* S_find_byclass(pTHX_ regexp
|
||||
__attribute__nonnull__(pTHX_3)
|
||||
__attribute__nonnull__(pTHX_4);
|
||||
|
||||
-STATIC void S_swap_match_buff(pTHX_ regexp * prog)
|
||||
- __attribute__nonnull__(pTHX_1);
|
||||
-
|
||||
STATIC void S_to_utf8_substr(pTHX_ regexp * prog)
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
|
||||
diff -up perl-5.10.0/regcomp.c.much perl-5.10.0/regcomp.c
|
||||
--- perl-5.10.0/regcomp.c.much 2009-07-27 08:31:33.000000000 +0200
|
||||
+++ perl-5.10.0/regcomp.c 2009-07-27 08:37:09.598625044 +0200
|
||||
@@ -9167,7 +9167,6 @@ Perl_pregfree(pTHX_ struct regexp *r)
|
||||
if (r->saved_copy)
|
||||
SvREFCNT_dec(r->saved_copy);
|
||||
#endif
|
||||
- Safefree(r->swap);
|
||||
Safefree(r->offs);
|
||||
Safefree(r);
|
||||
}
|
||||
@@ -9216,7 +9215,6 @@ Perl_reg_temp_copy (pTHX_ struct regexp
|
||||
ret->saved_copy = NULL;
|
||||
#endif
|
||||
ret->mother_re = r;
|
||||
- ret->swap = NULL;
|
||||
|
||||
return ret;
|
||||
}
|
||||
diff -up perl-5.10.0/regexec.c.much perl-5.10.0/regexec.c
|
||||
--- perl-5.10.0/regexec.c.much 2007-12-18 11:47:08.000000000 +0100
|
||||
+++ perl-5.10.0/regexec.c 2009-07-27 08:40:15.966404877 +0200
|
||||
@@ -1718,26 +1718,6 @@ S_find_byclass(pTHX_ regexp * prog, cons
|
||||
return s;
|
||||
}
|
||||
|
||||
-static void
|
||||
-S_swap_match_buff (pTHX_ regexp *prog) {
|
||||
- regexp_paren_pair *t;
|
||||
-
|
||||
- if (!prog->swap) {
|
||||
- /* We have to be careful. If the previous successful match
|
||||
- was from this regex we don't want a subsequent paritally
|
||||
- successful match to clobber the old results.
|
||||
- So when we detect this possibility we add a swap buffer
|
||||
- to the re, and switch the buffer each match. If we fail
|
||||
- we switch it back, otherwise we leave it swapped.
|
||||
- */
|
||||
- Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
|
||||
- }
|
||||
- t = prog->swap;
|
||||
- prog->swap = prog->offs;
|
||||
- prog->offs = t;
|
||||
-}
|
||||
-
|
||||
-
|
||||
/*
|
||||
- regexec_flags - match a regexp against a string
|
||||
*/
|
||||
@@ -1765,7 +1745,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
||||
I32 multiline;
|
||||
RXi_GET_DECL(prog,progi);
|
||||
regmatch_info reginfo; /* create some info to pass to regtry etc */
|
||||
- bool swap_on_fail = 0;
|
||||
+ regexp_paren_pair *swap = NULL;
|
||||
|
||||
GET_RE_DEBUG_FLAGS_DECL;
|
||||
|
||||
@@ -1843,9 +1823,16 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
||||
reginfo.ganch = strbeg;
|
||||
}
|
||||
if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
|
||||
- swap_on_fail = 1;
|
||||
- swap_match_buff(prog); /* do we need a save destructor here for
|
||||
- eval dies? */
|
||||
+ /* We have to be careful. If the previous successful match
|
||||
+ was from this regex we don't want a subsequent partially
|
||||
+ successful match to clobber the old results.
|
||||
+ So when we detect this possibility we add a swap buffer
|
||||
+ to the re, and switch the buffer each match. If we fail
|
||||
+ we switch it back, otherwise we leave it swapped.
|
||||
+ */
|
||||
+ swap = prog->offs;
|
||||
+ /* do we need a save destructor here for eval dies? */
|
||||
+ Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
|
||||
}
|
||||
if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
|
||||
re_scream_pos_data d;
|
||||
@@ -2144,6 +2131,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
||||
goto phooey;
|
||||
|
||||
got_it:
|
||||
+ Safefree(swap);
|
||||
RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
|
||||
|
||||
if (PL_reg_eval_set)
|
||||
@@ -2189,10 +2177,12 @@ phooey:
|
||||
PL_colors[4], PL_colors[5]));
|
||||
if (PL_reg_eval_set)
|
||||
restore_pos(aTHX_ prog);
|
||||
- if (swap_on_fail)
|
||||
+ if (swap) {
|
||||
/* we failed :-( roll it back */
|
||||
- swap_match_buff(prog);
|
||||
-
|
||||
+ Safefree(prog->offs);
|
||||
+ prog->offs = swap;
|
||||
+ }
|
||||
+
|
||||
return 0;
|
||||
}
|
||||
|
||||
diff -up perl-5.10.0/regexp.h.much perl-5.10.0/regexp.h
|
||||
--- perl-5.10.0/regexp.h.much 2007-12-18 11:47:08.000000000 +0100
|
||||
+++ perl-5.10.0/regexp.h 2009-07-27 08:41:06.882374786 +0200
|
||||
@@ -88,7 +88,7 @@ typedef struct regexp {
|
||||
/* Data about the last/current match. These are modified during matching*/
|
||||
U32 lastparen; /* last open paren matched */
|
||||
U32 lastcloseparen; /* last close paren matched */
|
||||
- regexp_paren_pair *swap; /* Swap copy of *offs */
|
||||
+ regexp_paren_pair *swap; /* Unused: 5.10.1 and later */
|
||||
regexp_paren_pair *offs; /* Array of offsets for (@-) and (@+) */
|
||||
|
||||
char *subbeg; /* saved or original string
|
||||
diff -up perl-5.10.0/t/op/pat.t.much perl-5.10.0/t/op/pat.t
|
||||
--- perl-5.10.0/t/op/pat.t.much 2007-12-18 11:47:08.000000000 +0100
|
||||
+++ perl-5.10.0/t/op/pat.t 2009-07-27 08:44:50.343375513 +0200
|
||||
@@ -4558,10 +4558,27 @@ ok($@=~/\QSequence \k... not terminated
|
||||
ok("aaa" =~ /$s/, "#45337");
|
||||
}
|
||||
|
||||
+# This only works under -DEBUGGING because it relies on an assert().
|
||||
+{
|
||||
+ local $BugId = '60508';
|
||||
+ local $Message = "Check capture offset re-entrancy of utf8 code.";
|
||||
+
|
||||
+ sub fswash { $_[0] =~ s/([>X])//g; }
|
||||
+ my $k1 = "." x 4 . ">>";
|
||||
+ fswash($k1);
|
||||
+
|
||||
+ my $k2 = "\x{f1}\x{2022}";
|
||||
+ $k2 =~ s/([\360-\362])/>/g;
|
||||
+ fswash($k2);
|
||||
+
|
||||
+ iseq($k2, "\x{2022}", "utf8::SWASHNEW doesn't cause capture leaks");
|
||||
+}
|
||||
+
|
||||
# Put new tests above the dotted line about a page above this comment
|
||||
iseq(0+$::test,$::TestCount,"Got the right number of tests!");
|
||||
# Don't forget to update this!
|
||||
BEGIN {
|
||||
- $::TestCount = 4013;
|
||||
+ $::TestCount = 4014;
|
||||
print "1..$::TestCount\n";
|
||||
}
|
||||
+
|
@ -1,47 +0,0 @@
|
||||
diff -up perl-5.10.0/t/op/subst.t.pos perl-5.10.0/t/op/subst.t
|
||||
--- perl-5.10.0/t/op/subst.t.pos 2007-12-18 11:47:08.000000000 +0100
|
||||
+++ perl-5.10.0/t/op/subst.t 2008-07-21 11:01:01.000000000 +0200
|
||||
@@ -7,7 +7,7 @@ BEGIN {
|
||||
}
|
||||
|
||||
require './test.pl';
|
||||
-plan( tests => 136 );
|
||||
+plan( tests => 139 );
|
||||
|
||||
$x = 'foo';
|
||||
$_ = "x";
|
||||
@@ -583,3 +583,11 @@ is($name, "cis", q[#22351 bug with 'e' s
|
||||
is($want,$_,"RT#17542");
|
||||
}
|
||||
|
||||
+{
|
||||
+ my @tests = ('ABC', "\xA3\xA4\xA5", "\x{410}\x{411}\x{412}");
|
||||
+ foreach (@tests) {
|
||||
+ my $id = ord $_;
|
||||
+ s/./pos/ge;
|
||||
+ is($_, "012", "RT#52104: $id");
|
||||
+ }
|
||||
+}
|
||||
diff -up perl-5.10.0/pp_ctl.c.pos perl-5.10.0/pp_ctl.c
|
||||
--- perl-5.10.0/pp_ctl.c.pos 2007-12-18 11:47:08.000000000 +0100
|
||||
+++ perl-5.10.0/pp_ctl.c 2008-07-21 12:31:50.000000000 +0200
|
||||
@@ -285,7 +285,6 @@ PP(pp_substcont)
|
||||
{ /* Update the pos() information. */
|
||||
SV * const sv = cx->sb_targ;
|
||||
MAGIC *mg;
|
||||
- I32 i;
|
||||
SvUPGRADE(sv, SVt_PVMG);
|
||||
if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
|
||||
#ifdef PERL_OLD_COPY_ON_WRITE
|
||||
@@ -295,10 +294,7 @@ PP(pp_substcont)
|
||||
mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
|
||||
NULL, 0);
|
||||
}
|
||||
- i = m - orig;
|
||||
- if (DO_UTF8(sv))
|
||||
- sv_pos_b2u(sv, &i);
|
||||
- mg->mg_len = i;
|
||||
+ mg->mg_len = m - orig;
|
||||
}
|
||||
if (old != rx)
|
||||
(void)ReREFCNT_inc(rx);
|
@ -1,16 +0,0 @@
|
||||
This fixes #52740: crash when localizing a symtab entry [1]
|
||||
It was pulled to -current in 33807 which was superseded by 34213.
|
||||
For 5.10.x, this was pulled in by 34295.
|
||||
|
||||
diff -up perl-5.10.0/sv.c.stlocal perl-5.10.0/sv.c
|
||||
--- perl-5.10.0/sv.c.stlocal 2008-10-12 10:31:28.000000000 +0200
|
||||
+++ perl-5.10.0/sv.c 2008-10-12 10:31:39.000000000 +0200
|
||||
@@ -3546,7 +3546,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, regi
|
||||
Perl_croak(aTHX_ "Cannot copy to %s", type);
|
||||
} else if (sflags & SVf_ROK) {
|
||||
if (isGV_with_GP(dstr) && dtype == SVt_PVGV
|
||||
- && SvTYPE(SvRV(sstr)) == SVt_PVGV) {
|
||||
+ && SvTYPE(SvRV(sstr)) == SVt_PVGV && isGV_with_GP(SvRV(sstr))) {
|
||||
sstr = SvRV(sstr);
|
||||
if (sstr == dstr) {
|
||||
if (GvIMPORTED(dstr) != GVf_IMPORTED
|
@ -1,11 +0,0 @@
|
||||
--- perl/installperl.patch 2003-07-07 09:55:32.000000000 -0400
|
||||
+++ perl/installperl 2003-07-07 09:56:03.000000000 -0400
|
||||
@@ -213,7 +213,7 @@
|
||||
|
||||
# Do some quick sanity checks.
|
||||
|
||||
-if (!$nonono && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
|
||||
+# if (!$nonono && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
|
||||
|
||||
$installbin || die "No installbin directory in config.sh\n";
|
||||
-d $installbin || mkpath($installbin, $verbose, 0777);
|
@ -1,22 +0,0 @@
|
||||
2009-04-06 Stepan Kasal <skasal@redhat.com>
|
||||
|
||||
* lib/CGI/t/util-58.t: return to the upstream version, do not
|
||||
hide bugs.
|
||||
|
||||
diff -ur perl-5.10.0.orig/lib/CGI/t/util-58.t perl-5.10.0/lib/CGI/t/util-58.t
|
||||
--- perl-5.10.0.orig/lib/CGI/t/util-58.t 2007-12-18 11:47:07.000000000 +0100
|
||||
+++ perl-5.10.0/lib/CGI/t/util-58.t 2009-04-06 18:28:07.000000000 +0200
|
||||
@@ -11,11 +11,6 @@
|
||||
use Test::More tests => 2;
|
||||
use_ok("CGI::Util");
|
||||
my $uri = "\x{5c0f}\x{98fc} \x{5f3e}.txt"; # KOGAI, Dan, in Kanji
|
||||
-if (ord('A') == 193) { # EBCDIC.
|
||||
- is(CGI::Util::escape($uri), "%FC%C3%A0%EE%F9%E5%E7%F8%20%FC%C3%C7%CA.txt",
|
||||
- "# Escape string with UTF-8 (UTF-EBCDIC) flag");
|
||||
-} else {
|
||||
- is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
|
||||
- "# Escape string with UTF-8 flag");
|
||||
-}
|
||||
+is(CGI::Util::escape($uri), "%E5%B0%8F%E9%A3%BC%20%E5%BC%BE.txt",
|
||||
+ "# Escape string with UTF-8 flag");
|
||||
__END__
|
@ -1,7 +1,7 @@
|
||||
diff -up perl-5.10.0/lib/ExtUtils/MM_Unix.pm.Fedora perl-5.10.0/lib/ExtUtils/MM_Unix.pm
|
||||
--- perl-5.10.0/lib/ExtUtils/MM_Unix.pm.Fedora 2007-12-21 11:03:28.000000000 -0500
|
||||
+++ perl-5.10.0/lib/ExtUtils/MM_Unix.pm 2007-12-21 11:04:27.000000000 -0500
|
||||
@@ -945,7 +945,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $
|
||||
diff -up perl-5.10.1/lib/ExtUtils/MM_Unix.pm.runpath perl-5.10.1/lib/ExtUtils/MM_Unix.pm
|
||||
--- perl-5.10.1/lib/ExtUtils/MM_Unix.pm.runpath 2009-11-18 16:08:45.000000000 +0100
|
||||
+++ perl-5.10.1/lib/ExtUtils/MM_Unix.pm 2009-11-18 16:09:32.000000000 +0100
|
||||
@@ -944,7 +944,7 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $
|
||||
}
|
||||
|
||||
my $ld_run_path_shell = "";
|
||||
@ -10,10 +10,10 @@ diff -up perl-5.10.0/lib/ExtUtils/MM_Unix.pm.Fedora perl-5.10.0/lib/ExtUtils/MM_
|
||||
$ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
|
||||
}
|
||||
|
||||
diff -up perl-5.10.0/lib/ExtUtils/Liblist.pm.Fedora perl-5.10.0/lib/ExtUtils/Liblist.pm
|
||||
--- perl-5.10.0/lib/ExtUtils/Liblist.pm.Fedora 2007-12-21 11:04:36.000000000 -0500
|
||||
+++ perl-5.10.0/lib/ExtUtils/Liblist.pm 2007-12-21 11:05:15.000000000 -0500
|
||||
@@ -89,6 +89,11 @@ libraries. LD_RUN_PATH is a colon separ
|
||||
diff -up perl-5.10.1/lib/ExtUtils/Liblist.pm.runpath perl-5.10.1/lib/ExtUtils/Liblist.pm
|
||||
--- perl-5.10.1/lib/ExtUtils/Liblist.pm.runpath 2009-11-18 16:08:45.000000000 +0100
|
||||
+++ perl-5.10.1/lib/ExtUtils/Liblist.pm 2009-11-18 16:09:32.000000000 +0100
|
||||
@@ -88,6 +88,11 @@ libraries. LD_RUN_PATH is a colon separ
|
||||
in LDLOADLIBS. It is passed as an environment variable to the process
|
||||
that links the shared library.
|
||||
|
||||
@ -25,22 +25,22 @@ diff -up perl-5.10.0/lib/ExtUtils/Liblist.pm.Fedora perl-5.10.0/lib/ExtUtils/Lib
|
||||
=head2 BSLOADLIBS
|
||||
|
||||
List of those libraries that are needed but can be linked in
|
||||
diff -up perl-5.10.0/lib/ExtUtils/MakeMaker.pm.Fedora perl-5.10.0/lib/ExtUtils/MakeMaker.pm
|
||||
--- perl-5.10.0/lib/ExtUtils/MakeMaker.pm.Fedora 2007-12-21 10:59:52.000000000 -0500
|
||||
+++ perl-5.10.0/lib/ExtUtils/MakeMaker.pm 2007-12-21 11:03:16.000000000 -0500
|
||||
@@ -245,7 +245,7 @@ sub full_setup {
|
||||
PERL_SRC PERM_RW PERM_RWX
|
||||
diff -up perl-5.10.1/lib/ExtUtils/MakeMaker.pm.runpath perl-5.10.1/lib/ExtUtils/MakeMaker.pm
|
||||
--- perl-5.10.1/lib/ExtUtils/MakeMaker.pm.runpath 2009-11-18 16:08:45.000000000 +0100
|
||||
+++ perl-5.10.1/lib/ExtUtils/MakeMaker.pm 2009-11-18 16:32:50.000000000 +0100
|
||||
@@ -262,7 +262,7 @@ sub full_setup {
|
||||
PERL_SRC PERM_DIR PERM_RW PERM_RWX
|
||||
PL_FILES PM PM_FILTER PMLIBDIRS PMLIBPARENTDIRS POLLUTE PPM_INSTALL_EXEC
|
||||
PPM_INSTALL_SCRIPT PREREQ_FATAL PREREQ_PM PREREQ_PRINT PRINT_PREREQ
|
||||
- SIGN SKIP TYPEMAPS VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
||||
+ SKIP TYPEMAPS USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
||||
+ SIGN SKIP TYPEMAPS USE_MM_LD_RUN_PATH VERSION VERSION_FROM XS XSOPT XSPROTOARG
|
||||
XS_VERSION clean depend dist dynamic_lib linkext macro realclean
|
||||
tool_autosplit
|
||||
|
||||
@@ -384,7 +384,28 @@ sub new {
|
||||
print join(" ", map { "perl($_)>=$self->{PREREQ_PM}->{$_} " }
|
||||
sort keys %{$self->{PREREQ_PM}}), "\n";
|
||||
exit 0;
|
||||
@@ -406,7 +406,27 @@ sub new {
|
||||
# PRINT_PREREQ is RedHatism.
|
||||
if ("@ARGV" =~ /\bPRINT_PREREQ\b/) {
|
||||
$self->_PRINT_PREREQ;
|
||||
- }
|
||||
+ }
|
||||
+
|
||||
@ -63,11 +63,10 @@ diff -up perl-5.10.0/lib/ExtUtils/MakeMaker.pm.Fedora perl-5.10.0/lib/ExtUtils/M
|
||||
+ };
|
||||
+ $self->{USE_MM_LD_RUN_PATH}=$v;
|
||||
+ };
|
||||
+
|
||||
|
||||
print STDOUT "MakeMaker (v$VERSION)\n" if $Verbose;
|
||||
if (-f "MANIFEST" && ! -f "Makefile"){
|
||||
@@ -2159,6 +2180,40 @@ precedence. A typemap in the current di
|
||||
@@ -2319,6 +2339,40 @@ precedence. A typemap in the current di
|
||||
precedence, even if it isn't listed in TYPEMAPS. The default system
|
||||
typemap has lowest precedence.
|
||||
|
112
perl-add-symbols.patch
Normal file
112
perl-add-symbols.patch
Normal file
@ -0,0 +1,112 @@
|
||||
2009-12-02 Stepan Kasal <skasal@redhat.com>
|
||||
|
||||
* add the extra symbols, even though DEBUGGING is not defined
|
||||
|
||||
diff -ur perl-5.10.1.orig/hv.c perl-5.10.1/hv.c
|
||||
--- perl-5.10.1.orig/hv.c 2009-06-10 14:36:34.000000000 +0200
|
||||
+++ perl-5.10.1/hv.c 2009-12-02 15:05:07.000000000 +0100
|
||||
@@ -2926,7 +2926,7 @@
|
||||
=cut
|
||||
*/
|
||||
|
||||
-#ifdef DEBUGGING
|
||||
+/* #ifdef DEBUGGING */
|
||||
|
||||
void
|
||||
Perl_hv_assert(pTHX_ HV *hv)
|
||||
@@ -2991,7 +2991,7 @@
|
||||
HvEITER_set(hv, eiter);
|
||||
}
|
||||
|
||||
-#endif
|
||||
+/* #endif */
|
||||
|
||||
/*
|
||||
* Local variables:
|
||||
diff -ur perl-5.10.1.orig/makedef.pl perl-5.10.1/makedef.pl
|
||||
--- perl-5.10.1.orig/makedef.pl 2009-12-02 14:42:12.000000000 +0100
|
||||
+++ perl-5.10.1/makedef.pl 2009-12-02 14:42:04.000000000 +0100
|
||||
@@ -617,7 +617,7 @@
|
||||
)];
|
||||
}
|
||||
|
||||
-unless ($define{'DEBUGGING'}) {
|
||||
+unless (1 || $define{'DEBUGGING'}) {
|
||||
skip_symbols [qw(
|
||||
Perl_deb_growlevel
|
||||
Perl_debop
|
||||
diff -ur perl-5.10.1.orig/pad.c perl-5.10.1/pad.c
|
||||
--- perl-5.10.1.orig/pad.c 2009-04-22 23:43:43.000000000 +0200
|
||||
+++ perl-5.10.1/pad.c 2009-12-02 14:39:21.000000000 +0100
|
||||
@@ -912,7 +912,7 @@
|
||||
}
|
||||
|
||||
|
||||
-#ifdef DEBUGGING
|
||||
+/* #ifdef DEBUGGING */
|
||||
/*
|
||||
=for apidoc pad_sv
|
||||
|
||||
@@ -963,7 +963,7 @@
|
||||
);
|
||||
PL_curpad[po] = sv;
|
||||
}
|
||||
-#endif
|
||||
+/* #endif */
|
||||
|
||||
|
||||
|
||||
diff -ur perl-5.10.1.orig/perl.h perl-5.10.1/perl.h
|
||||
--- perl-5.10.1.orig/perl.h 2009-07-06 13:18:58.000000000 +0200
|
||||
+++ perl-5.10.1/perl.h 2009-12-02 15:06:44.000000000 +0100
|
||||
@@ -4457,7 +4457,7 @@
|
||||
EXTCONST unsigned char PL_freq[];
|
||||
#endif
|
||||
|
||||
-#ifdef DEBUGGING
|
||||
+/* #ifdef DEBUGGING */
|
||||
#ifdef DOINIT
|
||||
EXTCONST char* const PL_block_type[] = {
|
||||
"NULL",
|
||||
@@ -4473,7 +4473,7 @@
|
||||
#else
|
||||
EXTCONST char* PL_block_type[];
|
||||
#endif
|
||||
-#endif
|
||||
+/* #endif */
|
||||
|
||||
/* These are all the compile time options that affect binary compatibility.
|
||||
Other compile time options that are binary compatible are in perl.c
|
||||
diff -ur perl-5.10.1.orig/perlvars.h perl-5.10.1/perlvars.h
|
||||
--- perl-5.10.1.orig/perlvars.h 2009-02-12 23:58:17.000000000 +0100
|
||||
+++ perl-5.10.1/perlvars.h 2009-12-02 15:10:39.000000000 +0100
|
||||
@@ -112,9 +112,9 @@
|
||||
PERLVARI(Gsig_trapped, int, 0)
|
||||
#endif
|
||||
|
||||
-#ifdef DEBUGGING
|
||||
+/* #ifdef DEBUGGING */
|
||||
PERLVAR(Gwatch_pvx, char*)
|
||||
-#endif
|
||||
+/* #endif */
|
||||
|
||||
#ifdef PERL_GLOBAL_STRUCT
|
||||
PERLVAR(Gppaddr, Perl_ppaddr_t*) /* or opcode.h */
|
||||
--- perl-5.10.1/proto.h.kasal 2009-12-02 15:18:39.000000000 +0100
|
||||
+++ perl-5.10.1/proto.h 2009-12-02 15:29:51.000000000 +0100
|
||||
@@ -6068,13 +6068,13 @@
|
||||
#define PERL_ARGS_ASSERT_PAD_CHECK_DUP \
|
||||
assert(name); assert(ourstash)
|
||||
|
||||
-#ifdef DEBUGGING
|
||||
+/* #ifdef DEBUGGING */
|
||||
PERL_CALLCONV void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
|
||||
__attribute__nonnull__(pTHX_2);
|
||||
#define PERL_ARGS_ASSERT_PAD_SETSV \
|
||||
assert(sv)
|
||||
|
||||
-#endif
|
||||
+/* #endif */
|
||||
PERL_CALLCONV void Perl_pad_block_start(pTHX_ int full);
|
||||
PERL_CALLCONV void Perl_pad_tidy(pTHX_ padtidy_type type);
|
||||
PERL_CALLCONV void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
|
@ -1,141 +0,0 @@
|
||||
commit 345d607e7958b7f31d5f0c780e86d1cc3e658d99
|
||||
Author: Niko Tyni <ntyni@debian.org>
|
||||
Date: Tue Apr 14 22:55:34 2009 +0300
|
||||
|
||||
Squelch 'Constant subroutine ... undefined' warnings from .ph files
|
||||
|
||||
As reported by Christopher Zimmermann in <http://bugs.debian.org/379757>,
|
||||
code generated from simple #undef directives by h2ph can cause
|
||||
'Constant subroutine ... undefined' warnings if the undefined
|
||||
function was eligible for inlining.
|
||||
|
||||
(cherry picked from commit c0cc52e96e988526754ef533bd76595720660db2)
|
||||
|
||||
commit 2d375d52dd1895b26a80209dd64a3c11b9e3b532
|
||||
Author: Niko Tyni <ntyni@debian.org>
|
||||
Date: Tue Apr 14 22:55:33 2009 +0300
|
||||
|
||||
Add tests to verify that h2ph output compiles and is warning free
|
||||
|
||||
The #include directives are #ifdef'd out so that running the
|
||||
resulting code does not actually need the headers. We still
|
||||
get the same effect from comparing with the expected h2ph output.
|
||||
|
||||
(cherry picked from commit c1a2df7619e7315b8fccef3b9fa56bb8d7df3845)
|
||||
|
||||
diff --git a/lib/h2ph.t b/lib/h2ph.t
|
||||
index 7b339b3..e303406 100755
|
||||
--- a/lib/h2ph.t
|
||||
+++ b/lib/h2ph.t
|
||||
@@ -15,7 +15,7 @@ if (!(-e $extracted_program)) {
|
||||
exit 0;
|
||||
}
|
||||
|
||||
-print "1..2\n";
|
||||
+print "1..4\n";
|
||||
|
||||
# quickly compare two text files
|
||||
sub txt_compare {
|
||||
@@ -32,6 +32,14 @@ print(($ok == 0 ? "" : "not "), "ok 1\n");
|
||||
$ok = txt_compare("lib/h2ph.ph", "lib/h2ph.pht");
|
||||
print(($ok == 0 ? "" : "not "), "ok 2\n");
|
||||
|
||||
+# does the output compile?
|
||||
+$ok = system($^X, "-I../lib", "lib/h2ph.pht");
|
||||
+print(($ok == 0 ? "" : "not "), "ok 3\n");
|
||||
+
|
||||
+# is the output warning free?
|
||||
+$ok = system($^X, "-w", "-I../lib", "-e", '$SIG{__WARN__} = sub { die $_[0] }; require "lib/h2ph.pht"');
|
||||
+print(($ok == 0 ? "" : "not "), "ok 4\n");
|
||||
+
|
||||
# cleanup - should this be in an END block?
|
||||
unlink("lib/h2ph.ph");
|
||||
unlink("_h2ph_pre.ph");
|
||||
diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h
|
||||
index 495789a..78429ca 100644
|
||||
--- a/t/lib/h2ph.h
|
||||
+++ b/t/lib/h2ph.h
|
||||
@@ -26,6 +26,10 @@
|
||||
#undef MAX
|
||||
#define MAX(a,b) ((a) > (b) ? (a) : (b))
|
||||
|
||||
+/* Test #undef'ining an existing constant function */
|
||||
+#define NOTTRUE 0
|
||||
+#undef NOTTRUE
|
||||
+
|
||||
/* Test #ifdef */
|
||||
#ifdef __SOME_UNIMPORTANT_PROPERTY
|
||||
#define MIN(a,b) ((a) < (b) ? (a) : (b))
|
||||
@@ -68,9 +72,11 @@ function Tru64_Pascal(n: Integer): Integer;
|
||||
* with `use lib qw(/opt/perl5/lib/site_perl/i586-linux/linux);' or whatever
|
||||
* your equivalent is...
|
||||
*/
|
||||
+#if 0
|
||||
#include <sys/socket.h>
|
||||
#import "sys/ioctl.h"
|
||||
#include_next <sys/fcntl.h>
|
||||
+#endif
|
||||
|
||||
/* typedefs should be ignored */
|
||||
typedef struct a_struct {
|
||||
diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht
|
||||
index 145e682..3723fca 100644
|
||||
--- a/t/lib/h2ph.pht
|
||||
+++ b/t/lib/h2ph.pht
|
||||
@@ -1,6 +1,6 @@
|
||||
require '_h2ph_pre.ph';
|
||||
|
||||
-no warnings 'redefine';
|
||||
+no warnings qw(redefine misc);
|
||||
|
||||
unless(defined(&SQUARE)) {
|
||||
sub SQUARE {
|
||||
@@ -22,6 +22,8 @@ unless(defined(&_H2PH_H_)) {
|
||||
my($a,$b) = @_;
|
||||
eval q((($a) > ($b) ? ($a) : ($b)));
|
||||
}' unless defined(&MAX);
|
||||
+ eval 'sub NOTTRUE () {0;}' unless defined(&NOTTRUE);
|
||||
+ undef(&NOTTRUE) if defined(&NOTTRUE);
|
||||
if(defined(&__SOME_UNIMPORTANT_PROPERTY)) {
|
||||
eval 'sub MIN {
|
||||
my($a,$b) = @_;
|
||||
@@ -47,15 +49,17 @@ unless(defined(&_H2PH_H_)) {
|
||||
} else {
|
||||
eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER);
|
||||
}
|
||||
- require 'sys/socket.ph';
|
||||
- require 'sys/ioctl.ph';
|
||||
- eval {
|
||||
- my(@REM);
|
||||
- my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
|
||||
- @REM = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"}) and -f "$_/sys/fcntl.ph" } @INC);
|
||||
- require "$REM[0]" if @REM;
|
||||
- };
|
||||
- warn($@) if $@;
|
||||
+ if(0) {
|
||||
+ require 'sys/socket.ph';
|
||||
+ require 'sys/ioctl.ph';
|
||||
+ eval {
|
||||
+ my(@REM);
|
||||
+ my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
|
||||
+ @REM = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"}) and -f "$_/sys/fcntl.ph" } @INC);
|
||||
+ require "$REM[0]" if @REM;
|
||||
+ };
|
||||
+ warn($@) if $@;
|
||||
+ }
|
||||
eval("sub sun () { 0; }") unless defined(&sun);
|
||||
eval("sub mon () { 1; }") unless defined(&mon);
|
||||
eval("sub tue () { 2; }") unless defined(&tue);
|
||||
diff --git a/utils/h2ph.PL b/utils/h2ph.PL
|
||||
index 6f40126..4e99a7a 100644
|
||||
--- a/utils/h2ph.PL
|
||||
+++ b/utils/h2ph.PL
|
||||
@@ -123,7 +123,7 @@ while (defined (my $file = next_file())) {
|
||||
|
||||
print OUT
|
||||
"require '_h2ph_pre.ph';\n\n",
|
||||
- "no warnings 'redefine';\n\n";
|
||||
+ "no warnings qw(redefine misc);\n\n";
|
||||
|
||||
while (defined (local $_ = next_line($file))) {
|
||||
if (s/^\s*\#\s*//) {
|
246
perl-much-better-swap-logic.patch
Normal file
246
perl-much-better-swap-logic.patch
Normal file
@ -0,0 +1,246 @@
|
||||
Backport of commit e9105d30 in blead perl.
|
||||
|
||||
diff -urpN perl-5.10.1.orig/embed.fnc perl-5.10.1/embed.fnc
|
||||
--- perl-5.10.1.orig/embed.fnc 2009-08-15 18:36:34.000000000 +0200
|
||||
+++ perl-5.10.1/embed.fnc 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -1658,7 +1658,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN
|
||||
#endif
|
||||
ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim
|
||||
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
|
||||
-Es |void |swap_match_buff|NN regexp * prog
|
||||
Es |void |to_utf8_substr |NN regexp * prog
|
||||
Es |void |to_byte_substr |NN regexp * prog
|
||||
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \
|
||||
diff -urpN perl-5.10.1.orig/embed.h perl-5.10.1/embed.h
|
||||
--- perl-5.10.1.orig/embed.h 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/embed.h 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -1452,7 +1452,6 @@
|
||||
#if defined(PERL_CORE) || defined(PERL_EXT)
|
||||
#define reghopmaybe3 S_reghopmaybe3
|
||||
#define find_byclass S_find_byclass
|
||||
-#define swap_match_buff S_swap_match_buff
|
||||
#define to_utf8_substr S_to_utf8_substr
|
||||
#define to_byte_substr S_to_byte_substr
|
||||
#define reg_check_named_buff_matched S_reg_check_named_buff_matched
|
||||
@@ -3783,7 +3782,6 @@
|
||||
#if defined(PERL_CORE) || defined(PERL_EXT)
|
||||
#define reghopmaybe3 S_reghopmaybe3
|
||||
#define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e)
|
||||
-#define swap_match_buff(a) S_swap_match_buff(aTHX_ a)
|
||||
#define to_utf8_substr(a) S_to_utf8_substr(aTHX_ a)
|
||||
#define to_byte_substr(a) S_to_byte_substr(aTHX_ a)
|
||||
#define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b)
|
||||
diff -urpN perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc
|
||||
--- perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -1677,7 +1677,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN
|
||||
#endif
|
||||
ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim
|
||||
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
|
||||
-Es |void |swap_match_buff|NN regexp * prog
|
||||
Es |void |to_utf8_substr |NN regexp * prog
|
||||
Es |void |to_byte_substr |NN regexp * prog
|
||||
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \
|
||||
diff -urpN perl-5.10.1.orig/pod/perlreapi.pod perl-5.10.1/pod/perlreapi.pod
|
||||
--- perl-5.10.1.orig/pod/perlreapi.pod 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/pod/perlreapi.pod 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -598,7 +598,7 @@ engine should use something else.
|
||||
|
||||
=head2 C<swap>
|
||||
|
||||
-TODO: document
|
||||
+Unused. Left in for compatibility with perl 5.10.0.
|
||||
|
||||
=head2 C<offs>
|
||||
|
||||
diff -urpN perl-5.10.1.orig/pod/perlreguts.pod perl-5.10.1/pod/perlreguts.pod
|
||||
--- perl-5.10.1.orig/pod/perlreguts.pod 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/pod/perlreguts.pod 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -810,13 +810,12 @@ value to other engine implementations.
|
||||
|
||||
=item C<swap>
|
||||
|
||||
-C<swap> is an extra set of startp/endp stored in a C<regexp_paren_ofs>
|
||||
-struct. This is used when the last successful match was from the same pattern
|
||||
-as the current pattern, so that a partial match doesn't overwrite the
|
||||
-previous match's results. When this field is data filled the matching
|
||||
-engine will swap buffers before every match attempt. If the match fails,
|
||||
-then it swaps them back. If it's successful it leaves them. This field
|
||||
-is populated on demand and is by default null.
|
||||
+C<swap> formerly was an extra set of startp/endp stored in a
|
||||
+C<regexp_paren_ofs> struct. This was used when the last successful match
|
||||
+was from the same pattern as the current pattern, so that a partial
|
||||
+match didn't overwrite the previous match's results, but it caused a
|
||||
+problem with re-entrant code such as trying to build the UTF-8 swashes.
|
||||
+Currently unused and left for backward compatibility with 5.10.0.
|
||||
|
||||
=item C<offsets>
|
||||
|
||||
diff -urpN perl-5.10.1.orig/proto.h perl-5.10.1/proto.h
|
||||
--- perl-5.10.1.orig/proto.h 2009-08-15 18:36:34.000000000 +0200
|
||||
+++ perl-5.10.1/proto.h 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -5445,11 +5445,6 @@ STATIC char* S_find_byclass(pTHX_ regexp
|
||||
#define PERL_ARGS_ASSERT_FIND_BYCLASS \
|
||||
assert(prog); assert(c); assert(s); assert(strend)
|
||||
|
||||
-STATIC void S_swap_match_buff(pTHX_ regexp * prog)
|
||||
- __attribute__nonnull__(pTHX_1);
|
||||
-#define PERL_ARGS_ASSERT_SWAP_MATCH_BUFF \
|
||||
- assert(prog)
|
||||
-
|
||||
STATIC void S_to_utf8_substr(pTHX_ regexp * prog)
|
||||
__attribute__nonnull__(pTHX_1);
|
||||
#define PERL_ARGS_ASSERT_TO_UTF8_SUBSTR \
|
||||
diff -urpN perl-5.10.1.orig/regcomp.c perl-5.10.1/regcomp.c
|
||||
--- perl-5.10.1.orig/regcomp.c 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/regcomp.c 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -9361,7 +9361,6 @@ Perl_pregfree(pTHX_ REGEXP *r)
|
||||
if (r->saved_copy)
|
||||
SvREFCNT_dec(r->saved_copy);
|
||||
#endif
|
||||
- Safefree(r->swap);
|
||||
Safefree(r->offs);
|
||||
Safefree(r);
|
||||
}
|
||||
@@ -9413,7 +9412,6 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) {
|
||||
ret->saved_copy = NULL;
|
||||
#endif
|
||||
ret->mother_re = r;
|
||||
- ret->swap = NULL;
|
||||
|
||||
return ret;
|
||||
}
|
||||
diff -urpN perl-5.10.1.orig/regexec.c perl-5.10.1/regexec.c
|
||||
--- perl-5.10.1.orig/regexec.c 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/regexec.c 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -1733,28 +1733,6 @@ S_find_byclass(pTHX_ regexp * prog, cons
|
||||
return s;
|
||||
}
|
||||
|
||||
-static void
|
||||
-S_swap_match_buff (pTHX_ regexp *prog)
|
||||
-{
|
||||
- regexp_paren_pair *t;
|
||||
-
|
||||
- PERL_ARGS_ASSERT_SWAP_MATCH_BUFF;
|
||||
-
|
||||
- if (!prog->swap) {
|
||||
- /* We have to be careful. If the previous successful match
|
||||
- was from this regex we don't want a subsequent paritally
|
||||
- successful match to clobber the old results.
|
||||
- So when we detect this possibility we add a swap buffer
|
||||
- to the re, and switch the buffer each match. If we fail
|
||||
- we switch it back, otherwise we leave it swapped.
|
||||
- */
|
||||
- Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
|
||||
- }
|
||||
- t = prog->swap;
|
||||
- prog->swap = prog->offs;
|
||||
- prog->offs = t;
|
||||
-}
|
||||
-
|
||||
|
||||
/*
|
||||
- regexec_flags - match a regexp against a string
|
||||
@@ -1783,7 +1761,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
||||
I32 multiline;
|
||||
RXi_GET_DECL(prog,progi);
|
||||
regmatch_info reginfo; /* create some info to pass to regtry etc */
|
||||
- bool swap_on_fail = 0;
|
||||
+ regexp_paren_pair *swap = NULL;
|
||||
GET_RE_DEBUG_FLAGS_DECL;
|
||||
|
||||
PERL_ARGS_ASSERT_REGEXEC_FLAGS;
|
||||
@@ -1861,9 +1839,16 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
||||
reginfo.ganch = strbeg;
|
||||
}
|
||||
if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
|
||||
- swap_on_fail = 1;
|
||||
- swap_match_buff(prog); /* do we need a save destructor here for
|
||||
- eval dies? */
|
||||
+ /* We have to be careful. If the previous successful match
|
||||
+ was from this regex we don't want a subsequent partially
|
||||
+ successful match to clobber the old results.
|
||||
+ So when we detect this possibility we add a swap buffer
|
||||
+ to the re, and switch the buffer each match. If we fail
|
||||
+ we switch it back, otherwise we leave it swapped.
|
||||
+ */
|
||||
+ swap = prog->offs;
|
||||
+ /* do we need a save destructor here for eval dies? */
|
||||
+ Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
|
||||
}
|
||||
if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
|
||||
re_scream_pos_data d;
|
||||
@@ -2162,6 +2147,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
||||
goto phooey;
|
||||
|
||||
got_it:
|
||||
+ Safefree(swap);
|
||||
RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
|
||||
|
||||
if (PL_reg_eval_set)
|
||||
@@ -2207,10 +2193,12 @@ phooey:
|
||||
PL_colors[4], PL_colors[5]));
|
||||
if (PL_reg_eval_set)
|
||||
restore_pos(aTHX_ prog);
|
||||
- if (swap_on_fail)
|
||||
+ if (swap) {
|
||||
/* we failed :-( roll it back */
|
||||
- swap_match_buff(prog);
|
||||
-
|
||||
+ Safefree(prog->offs);
|
||||
+ prog->offs = swap;
|
||||
+ }
|
||||
+
|
||||
return 0;
|
||||
}
|
||||
|
||||
diff -urpN perl-5.10.1.orig/regexp.h perl-5.10.1/regexp.h
|
||||
--- perl-5.10.1.orig/regexp.h 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/regexp.h 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -88,7 +88,7 @@ typedef struct regexp {
|
||||
/* Data about the last/current match. These are modified during matching*/
|
||||
U32 lastparen; /* last open paren matched */
|
||||
U32 lastcloseparen; /* last close paren matched */
|
||||
- regexp_paren_pair *swap; /* Swap copy of *offs */
|
||||
+ regexp_paren_pair *swap; /* Unused: 5.10.1 and later */
|
||||
regexp_paren_pair *offs; /* Array of offsets for (@-) and (@+) */
|
||||
|
||||
char *subbeg; /* saved or original string
|
||||
diff -urpN perl-5.10.1.orig/t/op/pat.t perl-5.10.1/t/op/pat.t
|
||||
--- perl-5.10.1.orig/t/op/pat.t 2009-07-27 23:37:52.000000000 +0200
|
||||
+++ perl-5.10.1/t/op/pat.t 2009-11-26 00:12:48.000000000 +0100
|
||||
@@ -13,7 +13,7 @@ sub run_tests;
|
||||
|
||||
$| = 1;
|
||||
|
||||
-my $EXPECTED_TESTS = 4065; # Update this when adding/deleting tests.
|
||||
+my $EXPECTED_TESTS = 4066; # Update this when adding/deleting tests.
|
||||
|
||||
BEGIN {
|
||||
chdir 't' if -d 't';
|
||||
@@ -4349,6 +4349,24 @@ sub run_tests {
|
||||
}
|
||||
}
|
||||
|
||||
+ # This only works under -DEBUGGING because it relies on an assert().
|
||||
+ {
|
||||
+ local $BugId = '60508';
|
||||
+ local $Message = "Check capture offset re-entrancy of utf8 code.";
|
||||
+
|
||||
+ sub fswash { $_[0] =~ s/([>X])//g; }
|
||||
+
|
||||
+ my $k1 = "." x 4 . ">>";
|
||||
+ fswash($k1);
|
||||
+
|
||||
+ my $k2 = "\x{f1}\x{2022}";
|
||||
+ $k2 =~ s/([\360-\362])/>/g;
|
||||
+ fswash($k2);
|
||||
+
|
||||
+ iseq($k2, "\x{2022}", "utf8::SWASHNEW doesn't cause capture leaks");
|
||||
+ }
|
||||
+
|
||||
+
|
||||
{
|
||||
local $BugId = 65372; # minimal CURLYM limited to 32767 matches
|
||||
my @pat = (
|
@ -1,6 +1,5 @@
|
||||
diff -up perl-5.10.0/utils/perlbug.PL.BAD perl-5.10.0/utils/perlbug.PL
|
||||
--- perl-5.10.0/utils/perlbug.PL.BAD 2007-12-21 10:31:26.000000000 -0500
|
||||
+++ perl-5.10.0/utils/perlbug.PL 2007-12-21 10:36:03.000000000 -0500
|
||||
--- perl-5.10.1/utils/perlbug.PL.fedora 2009-08-12 20:49:24.000000000 +0200
|
||||
+++ perl-5.10.1/utils/perlbug.PL 2009-11-18 15:56:15.000000000 +0100
|
||||
@@ -27,8 +27,6 @@ open OUT, ">$file" or die "Can't create
|
||||
open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
|
||||
or die "Can't open patchlevel.h: $!";
|
||||
@ -10,7 +9,7 @@ diff -up perl-5.10.0/utils/perlbug.PL.BAD perl-5.10.0/utils/perlbug.PL
|
||||
while (<PATCH_LEVEL>) {
|
||||
last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
|
||||
}
|
||||
@@ -68,9 +66,8 @@ $Config{startperl}
|
||||
@@ -71,9 +69,8 @@ $Config{startperl}
|
||||
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
|
||||
if \$running_under_some_shell;
|
||||
|
||||
@ -21,8 +20,8 @@ diff -up perl-5.10.0/utils/perlbug.PL.BAD perl-5.10.0/utils/perlbug.PL
|
||||
my \$patch_tags = '$patch_tags';
|
||||
my \@patches = (
|
||||
$patch_desc
|
||||
@@ -288,17 +285,6 @@ sub Init {
|
||||
$ok = 0;
|
||||
@@ -333,17 +330,6 @@ sub Init {
|
||||
$ok = '';
|
||||
if ($::opt_o) {
|
||||
if ($::opt_o eq 'k' or $::opt_o eq 'kay') {
|
||||
- my $age = time - $patchlevel_date;
|
||||
@ -39,7 +38,7 @@ diff -up perl-5.10.0/utils/perlbug.PL.BAD perl-5.10.0/utils/perlbug.PL
|
||||
# force these options
|
||||
unless ($::opt_n) {
|
||||
$::opt_S = 1; # don't prompt for send
|
||||
@@ -628,8 +614,8 @@ EFF
|
||||
@@ -730,8 +716,8 @@ EFF
|
||||
print OUT <<EFF;
|
||||
---
|
||||
EFF
|
@ -1,24 +0,0 @@
|
||||
--- perl-5.10.0/ext/Math/BigInt/FastCalc/Makefile.PL 2007-12-18 11:47:07.000000000 +0100
|
||||
+++ perl-5.10.0/ext/Math/BigInt/FastCalc/Makefile.PL 2009-07-10 15:37:39.000000000 +0200
|
||||
@@ -2,12 +2,18 @@
|
||||
|
||||
use strict;
|
||||
|
||||
+unless($ENV{PERL_CORE}) {
|
||||
+ $ENV{PERL_CORE} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
|
||||
+}
|
||||
+
|
||||
WriteMakefile(
|
||||
'NAME' => 'Math::BigInt::FastCalc',
|
||||
'VERSION_FROM' => 'FastCalc.pm',
|
||||
- 'PREREQ_PM' => {
|
||||
- 'Math::BigInt' => 1.88,
|
||||
- },
|
||||
+ (
|
||||
+ $ENV{PERL_CORE}
|
||||
+ ? ( )
|
||||
+ : ('PREREQ_PM' => { 'Math::BigInt' => 1.88, } )
|
||||
+ ),
|
||||
INSTALLDIRS => 'perl',
|
||||
PREREQ_FATAL => 1,
|
||||
MAN3PODS => {},
|
11
perl-suid-noroot.patch
Normal file
11
perl-suid-noroot.patch
Normal file
@ -0,0 +1,11 @@
|
||||
--- perl-5.10.1/installperl.orig 2009-11-18 15:44:47.000000000 +0100
|
||||
+++ perl-5.10.1/installperl 2009-11-18 15:50:32.000000000 +0100
|
||||
@@ -235,7 +235,7 @@
|
||||
|
||||
# Do some quick sanity checks.
|
||||
|
||||
-if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
|
||||
+# if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
|
||||
|
||||
$installbin || die "No installbin directory in config.sh\n";
|
||||
-d $installbin || mkpath($installbin, $opts{verbose}, 0777);
|
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user