diff --git a/02_fix_pod2html_dl b/02_fix_pod2html_dl new file mode 100644 index 0000000..c8cd162 --- /dev/null +++ b/02_fix_pod2html_dl @@ -0,0 +1,425 @@ +Fix issue with (nested) definition lists in lib/Pod/Html.pm +-
tags are not closed +- generated code contains spurious closing tags +- when other (definition) lists are nested in a definition list, the + indentation of sublevels gets messed up because of incorrect + placement of
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
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 "
\n" if $need_dd; + my $text = $_; ++ ++ # Open tag for definition list as we have something to put in it ++ if( $ListNewTerm ){ ++ print HTML "
\n"; ++ $ListNewTerm = 0; ++ } ++ + if( $text =~ /\A\s+/ ){ + process_pre( \$text ); + print HTML "
\n$text
\n"; +@@ -594,12 +599,8 @@ + } + ## end of experimental + +- if( $after_item ){ +- $After_Lpar = 1; +- } + print HTML "

$text

\n"; + } +- print HTML "
\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 "

\n"; + if( $level == 1 && ! $Top ){ +@@ -1143,19 +1139,32 @@ + $name = anchorify($name); + print HTML qq{}, process_text( \$otext ), ''; + } +- print HTML "\n"; ++ print HTML ""; + 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 "

\n"; ++ $ListNewTerm = 0; ++ } ++ + if( $Items_Seen[$Listlevel]++ == 0 ){ +- push( @Listend, "" ); ++ # 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 "
\n" unless $ListNewTerm; ++ } else { ++ print HTML "\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
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 ? "\n" : "\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
tag ++ new_listitem( 'dl' ); + if ($text =~ /\A(.+)\Z/s ){ # should have text + emit_item_tag( $otext, $text, 1 ); ++ # write the definition term and close
tag ++ print HTML "
\n"; + } +- $need_dd = 1; ++ # trigger opening a
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 ? "
\n" : "\n" if $After_Lpar; +- print HTML $Listend[$Listlevel]; +- print HTML "\n"; +- pop( @Listend ); ++ if( defined $Listtype[$Listlevel] ){ ++ if ( $Listtype[$Listlevel] eq 'dl' ){ ++ print HTML "\n" unless $ListNewTerm; ++ } else { ++ print HTML "\n"; ++ } ++ print HTML "\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 "\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 @@ +

section three

+

This is section three.

+
+-
item1 ++
item1
+ +
+

This is item one.

+
+- +-
item 2 ++
item 2
+ +
+

This is item two.

+
+- +-
item three ++
item three
+ +
+

This is item three.

+
+- +
+ + +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
++=for html
+

+ blah blah +

+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 @@ +

new()

+

Constructor method. Accepts the following config options:

+
+-
foo ++
foo
+ +
+

The foo item.

+
+- +-
bar ++
bar
+ +
+

The bar item.

+-
+

This is a list within a list

+ +-
baz ++ ++
baz
+ +
+

The baz item.

+
+- +
+

Title on the same line as the =item + * bullets

+ +

Title on the same line as the =item + numerical bullets

+
    +
  1. Cat + ++
  2. +
  3. Sat + ++
  4. +
  5. Mat + ++
  6. +
+

No bullets, no title

+
+@@ -137,17 +141,14 @@ +
+

Cat

+
+- +
+
+

Sat

+
+- +
+
+

Mat

+
+- +
+

+

+@@ -157,7 +158,7 @@ +

+
+

TESTING FOR AND BEGIN

+-
++
+

+ blah blah +

intermediate text

diff --git a/07_fix_nullok b/07_fix_nullok new file mode 100644 index 0000000..2d3a041 --- /dev/null +++ b/07_fix_nullok @@ -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); diff --git a/08_fix_udp_typo b/08_fix_udp_typo new file mode 100644 index 0000000..c0b3c66 --- /dev/null +++ b/08_fix_udp_typo @@ -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; + diff --git a/09_fix_memory_debugging b/09_fix_memory_debugging new file mode 100644 index 0000000..0043cdb --- /dev/null +++ b/09_fix_memory_debugging @@ -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) diff --git a/10_fix_h2ph_include_quote b/10_fix_h2ph_include_quote new file mode 100644 index 0000000..fdb23ee --- /dev/null +++ b/10_fix_h2ph_include_quote @@ -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 .=
; + } + +- 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; diff --git a/11_disable_vstring_warning b/11_disable_vstring_warning new file mode 100644 index 0000000..e030775 --- /dev/null +++ b/11_disable_vstring_warning @@ -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 say +-C. 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 is preceded by a +-C (see C in L). +- + =item Warning: something's wrong + + (W) You passed warn() an empty string (the equivalent of C) 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 followed by a +-v-string version like C, to avoid the unintuitive C. (older perl versions fail gracefully at the first C, +-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 +-Cing library modules that have changed in incompatible ways from +-older versions of Perl. (We try not to do this more than we have to.) ++Cing 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 will also load the C 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. diff --git a/15_fix_local_symtab b/15_fix_local_symtab new file mode 100644 index 0000000..8b67d23 --- /dev/null +++ b/15_fix_local_symtab @@ -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) { diff --git a/16_fix_perlio_teardown_prototype b/16_fix_perlio_teardown_prototype new file mode 100644 index 0000000..fb1a6c0 --- /dev/null +++ b/16_fix_perlio_teardown_prototype @@ -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 */ diff --git a/17_fix_getopt_long_callback b/17_fix_getopt_long_callback new file mode 100644 index 0000000..52736dc --- /dev/null +++ b/17_fix_getopt_long_callback @@ -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; diff --git a/18_fix_bigint_floats b/18_fix_bigint_floats new file mode 100644 index 0000000..bd4b84f --- /dev/null +++ b/18_fix_bigint_floats @@ -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); ++} diff --git a/25_fix_cgi_tempdir b/25_fix_cgi_tempdir new file mode 100644 index 0000000..7803924 --- /dev/null +++ b/25_fix_cgi_tempdir @@ -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_ \'\":/.\$\\-]+)$!; diff --git a/26_fix_pod2man_upgrade b/26_fix_pod2man_upgrade new file mode 100644 index 0000000..d3b1098 --- /dev/null +++ b/26_fix_pod2man_upgrade @@ -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 + # Substantial contributions by Sean Burke + # +@@ -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  . ++ # Tell Pod::Simple not to handle S<> by automatically inserting  . ++ # 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 +- # 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 ++ # 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. ++ ++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 EEE 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 ++# Copyright 1999, 2000, 2001, 2004, 2006, 2008 ++# Russ Allbery + # + # 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] [B<--release>[=I]] + [B<--center>=I] [B<--date>=I] [B<--fixed>=I] + [B<--fixedbold>=I] [B<--fixeditalic>=I] + [B<--fixedbolditalic>=I] [B<--name>=I] [B<--official>] +-[B<--lax>] [B<--quotes>=I] [B<--verbose>] ++[B<--lax>] [B<--quotes>=I] [B<--utf8>] [B<--verbose>] + [I [I] ...] + + 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 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. ++ ++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 documentation by Tom. + + =head1 COPYRIGHT AND LICENSE + +-Copyright 1999, 2000, 2001, 2004, 2006 by Russ Allbery . ++Copyright 1999, 2000, 2001, 2004, 2006, 2008 Russ Allbery ++. + + 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 diff --git a/27_fix_sys_syslog_timeout b/27_fix_sys_syslog_timeout new file mode 100644 index 0000000..ccd33ea --- /dev/null +++ b/27_fix_sys_syslog_timeout @@ -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); + } + diff --git a/28_fix_inplace_sort b/28_fix_inplace_sort new file mode 100644 index 0000000..cf2d148 --- /dev/null +++ b/28_fix_inplace_sort @@ -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]); + } diff --git a/30_fix_freetmps b/30_fix_freetmps new file mode 100644 index 0000000..45cf2a6 --- /dev/null +++ b/30_fix_freetmps @@ -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, diff --git a/31_fix_attributes_unknown_error b/31_fix_attributes_unknown_error new file mode 100644 index 0000000..f77573d --- /dev/null +++ b/31_fix_attributes_unknown_error @@ -0,0 +1,67 @@ +Fix 'Unknown error' messages with attribute.pm. (Closes: #488088) + +[perl #49472] +blead change 33265 + +From: Dave Mitchell +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 + diff --git a/32_fix_fork_rand b/32_fix_fork_rand new file mode 100644 index 0000000..7e3b2d5 --- /dev/null +++ b/32_fix_fork_rand @@ -0,0 +1,43 @@ +Stop t/op/fork.t relying on rand(). (Closes: #317843) + +[perl #53238] +blead change 33749 + +From: David Dick +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) + Message-ID: + +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 = ); ++ chomp(my $string_from_child = ); + close RDR; +- print $rand_child ne $rand_parent, "\n"; ++ print $string_from_child eq "STRING_FROM_CHILD", "\n"; + } + EXPECT + 1 +-- +1.5.6.5 + diff --git a/34_fix_qr-memory-leak-2 b/34_fix_qr-memory-leak-2 new file mode 100644 index 0000000..81d45e6 --- /dev/null +++ b/34_fix_qr-memory-leak-2 @@ -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; + } diff --git a/36_fix_file_temp_cleanup b/36_fix_file_temp_cleanup new file mode 100644 index 0000000..b8cb149 --- /dev/null +++ b/36_fix_file_temp_cleanup @@ -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 diff --git a/37_fix_coredump_indicator b/37_fix_coredump_indicator new file mode 100644 index 0000000..e6a2296 --- /dev/null +++ b/37_fix_coredump_indicator @@ -0,0 +1,22 @@ +Fix $? when dumping core. (Closes: #509041) + +WCOREDUMP is in + +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 + #endif + ++/* for WCOREDUMP */ ++#ifdef I_SYS_WAIT ++# include ++#endif ++ + #ifdef __SYMBIAN32__ + # undef _SC_ARG_MAX /* Symbian has _SC_ARG_MAX but no sysconf() */ + #endif diff --git a/38_fix_weaken_memleak b/38_fix_weaken_memleak new file mode 100644 index 0000000..7816f39 --- /dev/null +++ b/38_fix_weaken_memleak @@ -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 diff --git a/perl-5.10.0-Archive-Extract-onlystdout.patch b/perl-5.10.0-Archive-Extract-onlystdout.patch new file mode 100644 index 0000000..0b407be --- /dev/null +++ b/perl-5.10.0-Archive-Extract-onlystdout.patch @@ -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); diff --git a/perl-5.10.0-Change34507.patch b/perl-5.10.0-Change34507.patch new file mode 100644 index 0000000..9016ecf --- /dev/null +++ b/perl-5.10.0-Change34507.patch @@ -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) */ diff --git a/perl-5.10.0-bz448392.patch b/perl-5.10.0-bz448392.patch index 4b07caa..1cd55cd 100644 --- a/perl-5.10.0-bz448392.patch +++ b/perl-5.10.0-bz448392.patch @@ -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"); diff --git a/perl-5.10.0-fix_file_path_rmtree_setuid.patch b/perl-5.10.0-fix_file_path_rmtree_setuid.patch new file mode 100644 index 0000000..82d22ff --- /dev/null +++ b/perl-5.10.0-fix_file_path_rmtree_setuid.patch @@ -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); + } diff --git a/perl-5.10.0-reorderINC.patch b/perl-5.10.0-reorderINC.patch new file mode 100644 index 0000000..1f1a94b --- /dev/null +++ b/perl-5.10.0-reorderINC.patch @@ -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 diff --git a/perl.spec b/perl.spec index 1c4e799..94d50ba 100644 --- a/perl.spec +++ b/perl.spec @@ -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 - 4:5.10.0-60 +* Wed Mar 11 2009 Tom "spot" Callaway - 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 - 4:5.10.0-60 - remove compatibility obsolete sitelib directories - use a better BuildRoot - drop a redundant mkdir in %%install