rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

reorder @INC, fix bz 489204, merge useful debian patches

Browse Source
This commit is contained in:
Tom Callaway 2009-03-11 22:01:05 +00:00
parent 26b7a08961
commit 270a81b80b
27 changed files with 1962 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

425
02_fix_pod2html_dl Normal file
View File

@ -0,0 +1,425 @@
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>&nbsp;the</a></strong>
+</li>
<li><strong><a name="mat" class="item">Mat&lt;!&gt;</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 Normal file
View File

@ -0,0 +1,184 @@
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);

16
08_fix_udp_typo Normal file
View File

@ -0,0 +1,16 @@
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;

62
09_fix_memory_debugging Normal file
View File

@ -0,0 +1,62 @@
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)

60
10_fix_h2ph_include_quote Normal file
View File

@ -0,0 +1,60 @@
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;

156
11_disable_vstring_warning Normal file
View File

@ -0,0 +1,156 @@
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.

22
15_fix_local_symtab Normal file
View File

@ -0,0 +1,22 @@
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) {

42
16_fix_perlio_teardown_prototype Normal file
View File

@ -0,0 +1,42 @@
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 */

20
17_fix_getopt_long_callback Normal file
View File

@ -0,0 +1,20 @@
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;

47
18_fix_bigint_floats Normal file
View File

@ -0,0 +1,47 @@
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);
+}

20
25_fix_cgi_tempdir Normal file
View File

@ -0,0 +1,20 @@
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_ \'\":/.\$\\-]+)$!;

314
26_fix_pod2man_upgrade Normal file
View File

@ -0,0 +1,314 @@
Upgrade to Pod::Man 2.18 to get the 'pod2man --utf8' functionality in lenny. (Closes: #480997)
diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm
index 451ecc8..11959a6 100644
--- a/lib/Pod/Man.pm
+++ b/lib/Pod/Man.pm
@@ -1,7 +1,6 @@
# Pod::Man -- Convert POD data to formatted *roff input.
-# $Id: Man.pm,v 2.16 2007-11-29 01:35:53 eagle Exp $
#
-# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
# Russ Allbery <rra@stanford.edu>
# Substantial contributions by Sean Burke <sburke@cpan.org>
#
@@ -37,10 +36,7 @@ use POSIX qw(strftime);
@ISA = qw(Pod::Simple);
-# Don't use the CVS revision as the version, since this module is also in Perl
-# core and too many things could munge CVS magic revision strings. This
-# number should ideally be the same as the CVS revision in podlators, however.
-$VERSION = '2.16';
+$VERSION = '2.18';
# Set the debugging level. If someone has inserted a debug function into this
# class already, use that. Otherwise, use any Pod::Simple debug function
@@ -73,7 +69,9 @@ sub new {
my $class = shift;
my $self = $class->SUPER::new;
- # Tell Pod::Simple to handle S<> by automatically inserting &nbsp;.
+ # Tell Pod::Simple not to handle S<> by automatically inserting &nbsp;.
+ # Note that this messes up Unicode output by embedding explicit ISO 8859-1
+ # non-breaking spaces that we have to clean up later.
$self->nbsp_for_S (1);
# Tell Pod::Simple to keep whitespace whenever possible.
@@ -348,23 +346,22 @@ sub format_text {
my $convert = $$options{convert};
my $literal = $$options{literal};
- # Normally we do character translation, but we won't even do that in
- # <Data> blocks.
- if ($convert) {
- if (ASCII) {
- $text =~ s/(\\|[^\x00-\x7F])/$ESCAPES{ord ($1)} || "X"/eg;
- } else {
- $text =~ s/(\\)/$ESCAPES{ord ($1)} || "X"/eg;
- }
- }
-
# Cleanup just tidies up a few things, telling *roff that the hyphens are
- # hard and putting a bit of space between consecutive underscores.
+ # hard, putting a bit of space between consecutive underscores, and
+ # escaping backslashes. Be careful not to mangle our character
+ # translations by doing this before processing character translation.
if ($cleanup) {
+ $text =~ s/\\/\\e/g;
$text =~ s/-/\\-/g;
$text =~ s/_(?=_)/_\\|/g;
}
+ # Normally we do character translation, but we won't even do that in
+ # <Data> blocks or if UTF-8 output is desired.
+ if ($convert && !$$self{utf8} && ASCII) {
+ $text =~ s/([^\x00-\x7F])/$ESCAPES{ord ($1)} || "X"/eg;
+ }
+
# Ensure that *roff doesn't convert literal quotes to UTF-8 single quotes,
# but don't mess up our accept escapes.
if ($literal) {
@@ -641,10 +645,10 @@ sub switchquotes {
# to Roman rather than the actual previous font when used in headings.
# troff output may still be broken, but at least we can fix nroff by
# just switching the font changes to the non-fixed versions.
- $nroff =~ s/\Q$$self{FONTS}{100}\E(.*)\\f[PR]/$1/g;
- $nroff =~ s/\Q$$self{FONTS}{101}\E(.*)\\f([PR])/\\fI$1\\f$2/g;
- $nroff =~ s/\Q$$self{FONTS}{110}\E(.*)\\f([PR])/\\fB$1\\f$2/g;
- $nroff =~ s/\Q$$self{FONTS}{111}\E(.*)\\f([PR])/\\f\(BI$1\\f$2/g;
+ $nroff =~ s/\Q$$self{FONTS}{100}\E(.*?)\\f[PR]/$1/g;
+ $nroff =~ s/\Q$$self{FONTS}{101}\E(.*?)\\f([PR])/\\fI$1\\f$2/g;
+ $nroff =~ s/\Q$$self{FONTS}{110}\E(.*?)\\f([PR])/\\fB$1\\f$2/g;
+ $nroff =~ s/\Q$$self{FONTS}{111}\E(.*?)\\f([PR])/\\f\(BI$1\\f$2/g;
# Now finally output the command. Bother with .ie only if the nroff
# and troff output aren't the same.
@@ -851,7 +855,7 @@ sub devise_date {
# module, but this order is correct for both Solaris and Linux.
sub preamble {
my ($self, $name, $section, $date) = @_;
- my $preamble = $self->preamble_template;
+ my $preamble = $self->preamble_template (!$$self{utf8});
# Build the index line and make sure that it will be syntactically valid.
my $index = "$name $section";
@@ -1025,7 +1029,7 @@ sub cmd_head1 {
sub cmd_head2 {
my ($self, $attrs, $text) = @_;
$text = $self->heading_common ($text, $$attrs{start_line});
- $self->output ($self->switchquotes ('.Sh', $self->mapfonts ($text)));
+ $self->output ($self->switchquotes ('.SS', $self->mapfonts ($text)));
$self->outindex ('Subsection', $text);
$$self{NEEDSPACE} = 0;
return '';
@@ -1273,7 +1277,7 @@ sub parse_from_filehandle {
# results are pretty poor.
#
# This only works in an ASCII world. What to do in a non-ASCII world is very
-# unclear.
+# unclear -- hopefully we can assume UTF-8 and just leave well enough alone.
@ESCAPES{0xA0 .. 0xFF} = (
"\\ ", undef, undef, undef, undef, undef, undef, undef,
undef, undef, undef, undef, undef, "\\%", undef, undef,
@@ -1294,27 +1298,18 @@ sub parse_from_filehandle {
"o\\*/" , "u\\*`", "u\\*'", "u\\*^", "u\\*:", "y\\*'", "\\*(th", "y\\*:",
) if ASCII;
-# Make sure that at least this works even outside of ASCII.
-$ESCAPES{ord("\\")} = "\\e";
-
##############################################################################
# Premable
##############################################################################
# The following is the static preamble which starts all *roff output we
-# generate. It's completely static except for the font to use as a
-# fixed-width font, which is designed by @CFONT@, and the left and right
-# quotes to use for C<> text, designated by @LQOUTE@ and @RQUOTE@.
+# generate. Most is static except for the font to use as a fixed-width font,
+# which is designed by @CFONT@, and the left and right quotes to use for C<>
+# text, designated by @LQOUTE@ and @RQUOTE@. However, the second part, which
+# defines the accent marks, is only used if $escapes is set to true.
sub preamble_template {
- return <<'----END OF PREAMBLE----';
-.de Sh \" Subsection heading
-.br
-.if t .Sp
-.ne 5
-.PP
-\fB\\$1\fR
-.PP
-..
+ my ($self, $accents) = @_;
+ my $preamble = <<'----END OF PREAMBLE----';
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
@@ -1358,7 +1353,7 @@ sub preamble_template {
.el .ds Aq '
.\"
.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
+.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
.ie \nF \{\
@@ -1372,6 +1367,10 @@ sub preamble_template {
. de IX
..
.\}
+----END OF PREAMBLE----
+
+ if ($accents) {
+ $preamble .= <<'----END OF PREAMBLE----'
.\"
.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
.\" Fear. Run. Save yourself. No user-serviceable parts.
@@ -1436,6 +1435,8 @@ sub preamble_template {
.rm #[ #] #H #V #F C
----END OF PREAMBLE----
#`# for cperl-mode
+ }
+ return $preamble;
}
##############################################################################
@@ -1582,6 +1583,22 @@ that are reliably consistent are 1, 2, and 3.
By default, section 1 will be used unless the file ends in .pm in which case
section 3 will be selected.
+=item utf8
+
+By default, Pod::Man produces the most conservative possible *roff output
+to try to ensure that it will work with as many different *roff
+implementations as possible. Many *roff implementations cannot handle
+non-ASCII characters, so this means all non-ASCII characters are converted
+either to a *roff escape sequence that tries to create a properly accented
+character (at least for troff output) or to C<X>.
+
+If this option is set, Pod::Man will instead output UTF-8. If your *roff
+implementation can handle it, this is the best output format to use and
+avoids corruption of documents containing non-ASCII characters. However,
+be warned that *roff source with literal UTF-8 characters is not supported
+by many implementations and may even result in segfaults and other bad
+behavior.
+
=back
The standard Pod::Simple method parse_file() takes one argument naming the
@@ -1617,15 +1634,6 @@ invalid. A quote specification must be one, two, or four characters long.
=head1 BUGS
-Eight-bit input data isn't handled at all well at present. The correct
-approach would be to map EE<lt>E<gt> escapes to the appropriate UTF-8
-characters and then do a translation pass on the output according to the
-user-specified output character set. Unfortunately, we can't send eight-bit
-data directly to the output unless the user says this is okay, since some
-vendor *roff implementations can't handle eight-bit data. If the *roff
-implementation can, however, that's far superior to the current hacked
-characters that only work under troff.
-
There is currently no way to turn off the guesswork that tries to format
unmarked text appropriately, and sometimes it isn't wanted (particularly
when using POD to document something other than Perl). Most of the work
diff --git a/pod/pod2man.PL b/pod/pod2man.PL
index 9a8414a..10ddbbd 100644
--- a/pod/pod2man.PL
+++ b/pod/pod2man.PL
@@ -36,9 +36,9 @@ $Config{startperl}
print OUT <<'!NO!SUBS!';
# pod2man -- Convert POD data to formatted *roff input.
-# $Id: pod2man.PL,v 1.16 2006-01-21 01:53:55 eagle Exp $
#
-# Copyright 1999, 2000, 2001, 2004, 2006 by Russ Allbery <rra@stanford.edu>
+# Copyright 1999, 2000, 2001, 2004, 2006, 2008
+# Russ Allbery <rra@stanford.edu>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
@@ -66,7 +66,7 @@ Getopt::Long::config ('bundling_override');
GetOptions (\%options, 'section|s=s', 'release|r:s', 'center|c=s',
'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s',
'fixedbolditalic=s', 'name|n=s', 'official|o', 'quotes|q=s',
- 'lax|l', 'help|h', 'verbose|v') or exit 1;
+ 'lax|l', 'help|h', 'verbose|v', 'utf8|u') or exit 1;
pod2usage (0) if $options{help};
# Official sets --center, but don't override things explicitly set.
@@ -104,7 +104,7 @@ pod2man [B<--section>=I<manext>] [B<--release>[=I<version>]]
[B<--center>=I<string>] [B<--date>=I<string>] [B<--fixed>=I<font>]
[B<--fixedbold>=I<font>] [B<--fixeditalic>=I<font>]
[B<--fixedbolditalic>=I<font>] [B<--name>=I<name>] [B<--official>]
-[B<--lax>] [B<--quotes>=I<quotes>] [B<--verbose>]
+[B<--lax>] [B<--quotes>=I<quotes>] [B<--utf8>] [B<--verbose>]
[I<input> [I<output>] ...]
pod2man B<--help>
@@ -243,6 +243,22 @@ that are reliably consistent are 1, 2, and 3.
By default, section 1 will be used unless the file ends in .pm in which case
section 3 will be selected.
+=item B<-u>, B<--utf8>
+
+By default, B<pod2man> produces the most conservative possible *roff
+output to try to ensure that it will work with as many different *roff
+implementations as possible. Many *roff implementations cannot handle
+non-ASCII characters, so this means all non-ASCII characters are converted
+either to a *roff escape sequence that tries to create a properly accented
+character (at least for troff output) or to C<X>.
+
+This option says to instead output literal UTF-8 characters. If your
+*roff implementation can handle it, this is the best output format to use
+and avoids corruption of documents containing non-ASCII characters.
+However, be warned that *roff source with literal UTF-8 characters is not
+supported by many implementations and may even result in segfaults and
+other bad behavior.
+
=item B<-v>, B<--verbose>
Print out the name of each output file as it is being generated.
@@ -537,7 +553,8 @@ page, are taken from the B<pod2man> documentation by Tom.
=head1 COPYRIGHT AND LICENSE
-Copyright 1999, 2000, 2001, 2004, 2006 by Russ Allbery <rra@stanford.edu>.
+Copyright 1999, 2000, 2001, 2004, 2006, 2008 Russ Allbery
+<rra@stanford.edu>.
This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.
--- a/lib/Pod/t/man.t
+++ b/lib/Pod/t/man.t
@@ -344,7 +344,7 @@ Oboy, is this C++ "fun" yet! (guesswork)
###
.SH "NAME"
"Stuff" (no guesswork)
-.Sh "\s-1THINGS\s0"
+.SS "\s-1THINGS\s0"
.IX Subsection "THINGS"
Oboy, is this \*(C+ \*(L"fun\*(R" yet! (guesswork)
###
--- a/lib/Pod/t/basic.man
+++ b/lib/Pod/t/basic.man
@@ -7,7 +7,7 @@ other interesting bits.
.ie n .SH "This ""is"" a ""level 1"" heading"
.el .SH "This \f(CWis\fP a ``level 1'' heading"
.IX Header "This is a level 1 heading"
-.Sh "``Level'' ""2 \fIheading\fP"
+.SS "``Level'' ""2 \fIheading\fP"
.IX Subsection "``Level'' ""2 heading"
\fILevel 3 \f(BIheading \f(BIwith \f(CB\*(C`weird \f(CBstuff "" (double quote)\f(CB\*(C'\f(BI\f(BI\fI\fR
.IX Subsection "Level 3 heading with weird stuff """" (double quote)"
@@ -20,7 +20,7 @@ Now try again with \fBintermixed\fR \fItext\fR.
.el .SH "This \f(CWis\fP a ``level 1'' heading"
.IX Header "This is a level 1 heading"
Text.
-.Sh "``Level'' 2 \fIheading\fP"
+.SS "``Level'' 2 \fIheading\fP"
.IX Subsection "``Level'' 2 heading"
Text.
.PP

20
27_fix_sys_syslog_timeout Normal file
View File

@ -0,0 +1,20 @@
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);
}

32
28_fix_inplace_sort Normal file
View File

@ -0,0 +1,32 @@
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]);
}

18
30_fix_freetmps Normal file
View File

@ -0,0 +1,18 @@
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,

67
31_fix_attributes_unknown_error Normal file
View File

@ -0,0 +1,67 @@
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

43
32_fix_fork_rand Normal file
View File

@ -0,0 +1,43 @@
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

17
34_fix_qr-memory-leak-2 Normal file
View File

@ -0,0 +1,17 @@
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;
}

35
36_fix_file_temp_cleanup Normal file
View File

@ -0,0 +1,35 @@
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

22
37_fix_coredump_indicator Normal file
View File

@ -0,0 +1,22 @@
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

44
38_fix_weaken_memleak Normal file
View File

@ -0,0 +1,44 @@
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

37
perl-5.10.0-Archive-Extract-onlystdout.patch Normal file
View File

@ -0,0 +1,37 @@
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);

13
perl-5.10.0-Change34507.patch Normal file
View File

@ -0,0 +1,13 @@
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) */

36
perl-5.10.0-bz448392.patch
View File

@ -1,12 +1,36 @@
diff -up perl-5.10.0/mg.c.crr perl-5.10.0/mg.c
--- perl-5.10.0/mg.c.crr 2007-12-18 11:47:08.000000000 +0100
+++ perl-5.10.0/mg.c 2008-05-26 15:28:17.000000000 +0200
@@ -1543,7 +1543,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *m
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
+ : (GV*)mg_find(mg->mg_obj, PERL_MAGIC_isa)->mg_obj
);
mro_isa_changed_in(stash);
- 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");

12
perl-5.10.0-fix_file_path_rmtree_setuid.patch Normal file
View File

@ -0,0 +1,12 @@
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);
}

59
perl-5.10.0-reorderINC.patch Normal file
View File

@ -0,0 +1,59 @@
diff -up perl-5.10.0/perl.c.BAD perl-5.10.0/perl.c
--- perl-5.10.0/perl.c.BAD 2009-03-09 09:55:05.000000000 -0400
+++ perl-5.10.0/perl.c 2009-03-09 10:00:41.000000000 -0400
@@ -4753,9 +4753,6 @@ S_init_perllib(pTHX)
incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE);
#endif
-#ifdef ARCHLIB_EXP
- incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
-#endif
#ifdef MACOS_TRADITIONAL
{
Stat_t tmpstatbuf;
@@ -4764,6 +4761,10 @@ S_init_perllib(pTHX)
if (!macperl)
macperl = "";
+
+#ifdef ARCHLIB_EXP
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+#endif
Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
@@ -4777,14 +4778,6 @@ S_init_perllib(pTHX)
if (!PL_tainting)
incpush(":", FALSE, FALSE, TRUE, FALSE);
#else
-#ifndef PRIVLIB_EXP
-# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
-#endif
-#if defined(WIN32)
- incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
-#else
- incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
-#endif
#ifdef SITEARCH_EXP
/* sitearch is always relative to sitelib on Windows for
@@ -4828,6 +4821,19 @@ S_init_perllib(pTHX)
incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE);
#endif
+#ifdef ARCHLIB_EXP
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+#endif
+
+#ifndef PRIVLIB_EXP
+# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
+#endif
+#if defined(WIN32)
+ incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
+#else
+ incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
+#endif
+
#ifdef PERL_OTHERLIBDIRS
incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE);
#endif

147
perl.spec
View File

@ -7,7 +7,7 @@
Name: perl
Version: %{perl_version}
Release: 60%{?dist}
Release: 61%{?dist}
Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language
Group: Development/Languages
@ -89,6 +89,96 @@ Patch31: perl-5.10.0-Change33897.patch
Patch33: perl-5.10.0-PerlIO-via-change34025.patch
# Change 34507: Fix memory leak in single-char character class optimization
Patch34: perl-5.10.0-Change34507.patch
# Reorder @INC: Based on: http://github.com/rafl/perl/commit/b9ba2fadb18b54e35e5de54f945111a56cbcb249
Patch35: perl-5.10.0-reorderINC.patch
# Fix from Archive::Extract maintainer to only look at stdout
# We need this because we're using tar >= 1.21
Patch36: perl-5.10.0-Archive-Extract-onlystdout.patch
### Debian Patches ###
# Fix issue with (nested) definition lists in lib/Pod/Html.pm
# Upstream change 32727
Patch40: 02_fix_pod2html_dl
# Fix NULLOK items
# Upstream change 33287
Patch41: 07_fix_nullok
# Fix a typo in the predefined common protocols to make "udp" resolve without netbase
# Upstream change 33554
Patch42: 08_fix_udp_typo
# Fix a segmentation fault with 'debugperl -Dm'.
# Upstream change 33388
Patch43: 09_fix_memory_debugging
# Allow the quote mark delimiter also for those #include directives chased with "h2ph -a".
# 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
Patch44: 10_fix_h2ph_include_quote
# Disable the "v-string in use/require is non-portable" warning.
# Upstream change 32910
Patch45: 11_disable_vstring_warning
# Fix a segmentation fault occurring in the mod_perl2 test suite.
# Upstream change 33807
Patch46: 15_fix_local_symtab
# Fix the PerlIO_teardown prototype to suppress a compiler warning.
# Upstream change 33370
Patch47: 16_fix_perlio_teardown_prototype
# Remove numeric overloading of Getopt::Long callback functions.
# Dual-lived module, fixed on the CPAN side in 2.37_01.
Patch48: 17_fix_getopt_long_callback
# Fix Math::BigFloat::sqrt() breaking with too many digits.
# Upstream change 33821
Patch49: 18_fix_bigint_floats
# Upgrade to Pod::Man 2.18 for utf8 functionality in pod2man
Patch50: 26_fix_pod2man_upgrade
# Fix memory corruption with in-place sorting.
# Upstream change 33937
Patch51: 28_fix_inplace_sort
# Revert an incorrect substitution optimization introduced in 5.10.0.
# Bug introduced by upstream change 26334, reverted with change 33685 in blead and 33732 in maint-5.10.
Patch52: 30_fix_freetmps
# Fix 'Unknown error' messages with attribute.pm.
# Upstream change 33265
Patch53: 31_fix_attributes_unknown_error
# Stop t/op/fork.t relying on rand().
# Upstream change 33749
Patch54: 32_fix_fork_rand
# Fix memory leak with qr//.
# Adapted from upstream changhe 34506.
Patch55: 34_fix_qr-memory-leak-2
# CVE-2005-0448 revisited: File::Path::rmtree no longer allows creating of setuid files.
# We have 2.07, but it is still missing one fix (the debian patch has two fixes, but one is in 2.07)
Patch56: perl-5.10.0-fix_file_path_rmtree_setuid.patch
# Fix $? when dumping core.
Patch57: 37_fix_coredump_indicator
# Fix a memory leak with Scalar::Util::weaken().
# Upstream change 34209
Patch58: 38_fix_weaken_memleak
### End of Debian Patches ###
# Update some of the bundled modules
# see http://fedoraproject.org/wiki/Perl/perl.spec for instructions
Patch100: perl-update-constant.patch
@ -857,6 +947,31 @@ upstream tarball from perl.org.
%patch30 -p1
%patch31 -p1
%patch33 -p1
%patch34 -p1
%patch35 -p1
%patch36 -p1
### Debian patches ###
%patch40 -p1
%patch41 -p1
%patch42 -p1
%patch43 -p1
%patch44 -p1
%patch45 -p1
%patch46 -p1
%patch47 -p1
%patch48 -p1
%patch49 -p1
%patch50 -p1
%patch51 -p1
%patch52 -p1
%patch53 -p1
%patch54 -p1
%patch55 -p1
%patch56 -p1
%patch57 -p1
%patch58 -p1
%patch100 -p1
%patch101 -p1
%patch102 -p1
@ -1095,6 +1210,28 @@ perl -x patchlevel.h \
'33896 Eliminate POSIX::int_macro_int, and all the complex AUTOLOAD fandango' \
'33897 Replaced the WEXITSTATUS, WIFEXITED, WIFSIGNALED, WIFSTOPPED, WSTOPSIG' \
'54934 Change 34025 refcount of the globs generated by PerlIO::via balanced' \
'34507 Fix memory leak in single-char character class optimization' \
'Fedora Patch35: Reorder @INC, based on b9ba2fadb18b54e35e5de54f945111a56cbcb249' \
'Fedora Patch36: Fix from Archive::Extract maintainer to only look at stdout from tar' \
'32727 Fix issue with (nested) definition lists in lib/Pod/Html.pm' \
'33287 Fix NULLOK items' \
'33554 Fix a typo in the predefined common protocols to make "udp" resolve without netbase' \
'33388 Fix a segmentation fault with debugperl -Dm' \
'33835 Allow the quote mark delimiter also for those #include directives chased with h2ph -a.' \
'32910 Disable the v-string in use/require is non-portable warning.' \
'33807 Fix a segmentation fault occurring in the mod_perl2 test suite.' \
'33370 Fix the PerlIO_teardown prototype to suppress a compiler warning.' \
'Fedora Patch48: Remove numeric overloading of Getopt::Long callback functions.' \
'33821 Fix Math::BigFloat::sqrt() breaking with too many digits.' \
'Fedora Patch50: Upgrade to Pod::Man 2.18 for utf8 functionality in pod2man' \
'33937 Fix memory corruption with in-place sorting' \
'33732 Revert an incorrect substitution optimization introduced in 5.10.0' \
'33265 Fix Unknown error messages with attribute.pm.' \
'33749 Stop t/op/fork.t relying on rand()' \
'34506 Fix memory leak with qr//' \
'Fedora Patch56: File::Path::rmtree no longer allows creating of setuid files.' \
'Fedora Patch57: Fix $? when dumping core' \
'34209 Fix a memory leak with Scalar::Util::weaken()' \
'Fedora Patch100: Update constant to %{constant_version}' \
'Fedora Patch101: Update Archive::Extract to %{Archive_Extract_version}' \
'Fedora Patch102: Update Archive::Tar to %{Archive_Tar_version}' \
@ -1734,7 +1871,13 @@ TMPDIR="$PWD/tmp" make test
# Old changelog entries are preserved in CVS.
%changelog
* Tue Mar 11 2009 Stepan Kasal <skasal@redhat.com> - 4:5.10.0-60
* Wed Mar 11 2009 Tom "spot" Callaway <tcallawa@redhat.com> - 4:5.10.0-61
- apply Change 34507: Fix memory leak in single-char character class optimization
- Reorder @INC, based on b9ba2fadb18b54e35e5de54f945111a56cbcb249
- fix Archive::Extract to fix test failure caused by tar >= 1.21
- Merge useful Debian patches
* Tue Mar 10 2009 Stepan Kasal <skasal@redhat.com> - 4:5.10.0-60
- remove compatibility obsolete sitelib directories
- use a better BuildRoot
- drop a redundant mkdir in %%install