diff --git a/Carp-1.42-Fix-RT-52610-Carp-Do-not-crash-when-reading-DB-args.patch b/Carp-1.42-Fix-RT-52610-Carp-Do-not-crash-when-reading-DB-args.patch deleted file mode 100644 index 9283173..0000000 --- a/Carp-1.42-Fix-RT-52610-Carp-Do-not-crash-when-reading-DB-args.patch +++ /dev/null @@ -1,82 +0,0 @@ -From b5ad485cc167b3b6aa43f83aa92bbf8b8811cb42 Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= -Date: Fri, 20 Apr 2018 10:20:55 +0200 -Subject: [PATCH] Fix RT #52610: Carp: Do not crash when reading @DB::args -MIME-Version: 1.0 -Content-Type: text/plain; charset=UTF-8 -Content-Transfer-Encoding: 8bit - -Petr Pisar: Ported from perl after 5.27.8. The unreliable test was -later deleted in a77eff3c and the comments rephrased in 02c84d7: - -commit 4764858cb80e76fdba33cc1b3be8fcdef26df754 -Author: Pali -Date: Wed Jan 31 22:43:46 2018 +0100 - - Fix RT #52610: Carp: Do not crash when reading @DB::args - - Trying to read values from array @DB::args can lead to perl fatal error - "Bizarre copy of ARRAY in scalar assignment". But missing, incomplete or - possible incorrect value in @DB::args is not a fatal error for Carp. - - Carp is primary used for reporting warnings and errors from other - modules, so it should not crash perl when trying to print error message. - - This patch safely iterates all elements of @DB::args array via eval { } - block and replace already freed scalars for Carp usage by string - "** argument not available anymore **". - - This prevent crashing perl and allows to use Carp module. It it not a - proper fix but rather workaround for Carp module. At least it allows to - safely use Carp. - - Patch amended by Yves Orton - -Signed-off-by: Petr Písař ---- - lib/Carp.pm | 22 ++++++++++++++++------ - 1 file changed, 16 insertions(+), 6 deletions(-) - -diff --git a/lib/Carp.pm b/lib/Carp.pm -index 05052b9..60b2469 100644 ---- a/lib/Carp.pm -+++ b/lib/Carp.pm -@@ -203,11 +203,22 @@ sub caller_info { - - my $sub_name = Carp::get_subname( \%call_info ); - if ( $call_info{has_args} ) { -- my @args; -- if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1 -- && ref $DB::args[0] eq ref \$i -- && $DB::args[0] == \$i ) { -- @DB::args = (); # Don't let anyone see the address of $i -+ # guard our serialization of the stack from stack refcounting bugs -+ my @args = map { -+ my $arg; -+ local $@= $@; -+ eval { -+ $arg = $_; -+ 1; -+ } or do { -+ $arg = '** argument not available anymore **'; -+ }; -+ $arg; -+ } @DB::args; -+ if (CALLER_OVERRIDE_CHECK_OK && @args == 1 -+ && ref $args[0] eq ref \$i -+ && $args[0] == \$i ) { -+ @args = (); # Don't let anyone see the address of $i - local $@; - my $where = eval { - my $func = $cgc or return ''; -@@ -226,7 +237,6 @@ sub caller_info { - = "** Incomplete caller override detected$where; \@DB::args were not set **"; - } - else { -- @args = @DB::args; - my $overflow; - if ( $MaxArgNums and @args > $MaxArgNums ) - { # More than we want to show? --- -2.14.3 - diff --git a/Carp-1.42-Upgrade-to-1.50.patch b/Carp-1.42-Upgrade-to-1.50.patch new file mode 100644 index 0000000..e6cb013 --- /dev/null +++ b/Carp-1.42-Upgrade-to-1.50.patch @@ -0,0 +1,759 @@ +From 243826fff8700a7d99f3615334fdffaaf89feef4 Mon Sep 17 00:00:00 2001 +From: Jitka Plesnikova +Date: Wed, 23 May 2018 14:15:47 +0200 +Subject: [PATCH] Upgrade to 1.50 + +--- + Changes | 48 ++++++++++ + lib/Carp.pm | 237 +++++++++++++++++++++++++++++++++++++++----------- + lib/Carp/Heavy.pm | 2 +- + t/Carp.t | 13 ++- + t/Carp_overloadless.t | 15 ++++ + t/arg_regexp.t | 41 +++------ + t/arg_string.t | 9 +- + t/broken_can.t | 15 ++++ + t/broken_univ_can.t | 24 +++++ + t/stack_after_err.t | 69 +++++++++++++++ + t/vivify_stash.t | 12 +-- + 11 files changed, 397 insertions(+), 88 deletions(-) + create mode 100644 t/Carp_overloadless.t + create mode 100644 t/broken_can.t + create mode 100644 t/broken_univ_can.t + create mode 100644 t/stack_after_err.t + +diff --git a/Changes b/Changes +index dca6a52..2b549d9 100644 +--- a/Changes ++++ b/Changes +@@ -1,3 +1,51 @@ ++version 1.49 ++ ++ * comment only change, document the change from 1.47 better ++ and create a commit in blead-perl which can be used to ++ reference this issue from the bug report. ++ ++version 1.48 ++ ++ * guard against hand-rolled UNIVERSAL::can() implementations ++ which throw exceptions when we call $obj->can("(("). ++ ++version 1.47, 1.47_02 ++ ++ * Deal with overloading when overload.pm is not use ++ ++ * Note 1.47_02 only existed for one commit in blead-perl, ++ and in fact no 1.47 should ever see the wild. ++ ++version 1.47, 1.47_01 ++ ++ * Do not die on trappable stack-not-refcounted bugs while ++ serializing the stack. ++ ++ * Note 1.47_01 only existed for one commit in blead-perl, ++ and in fact no 1.47 should ever see the wild. ++ ++version 1.46 ++ ++ * avoid vivifying UNIVERSAL::isa:: in Carp ++ ++version 1.45 ++ ++ * Optimize format_arg when arguments contain many references ++ ++version 1.43 ++ ++ * fix problems introduced by the partial EBCDIC support from version ++ 1.35 ++ ++version 1.42 ++ ++ * add some doc clue about what cluck does ++ ++ * avoid floating point overflow in test ++ ++version 1.41 ++ ++ * add missing " chunk #" phrase to messages + + version 1.40; 2016-03-10 + * Get arg_string.t to compile in perl v5.6 +diff --git a/lib/Carp.pm b/lib/Carp.pm +index 05052b9..109b7fe 100644 +--- a/lib/Carp.pm ++++ b/lib/Carp.pm +@@ -87,7 +87,131 @@ BEGIN { + } + } + +-our $VERSION = '1.42'; ++# is_safe_printable_codepoint() indicates whether a character, specified ++# by integer codepoint, is OK to output literally in a trace. Generally ++# this is if it is a printable character in the ancestral character set ++# (ASCII or EBCDIC). This is used on some Perls in situations where a ++# regexp can't be used. ++BEGIN { ++ *is_safe_printable_codepoint = ++ "$]" >= 5.007_003 ? ++ eval(q(sub ($) { ++ my $u = utf8::native_to_unicode($_[0]); ++ $u >= 0x20 && $u <= 0x7e; ++ })) ++ : ord("A") == 65 ? ++ sub ($) { $_[0] >= 0x20 && $_[0] <= 0x7e } ++ : ++ sub ($) { ++ # Early EBCDIC ++ # 3 EBCDIC code pages supported then; all controls but one ++ # are the code points below SPACE. The other one is 0x5F on ++ # POSIX-BC; FF on the other two. ++ # FIXME: there are plenty of unprintable codepoints other ++ # than those that this code and the comment above identifies ++ # as "controls". ++ $_[0] >= ord(" ") && $_[0] <= 0xff && ++ $_[0] != (ord ("^") == 106 ? 0x5f : 0xff); ++ } ++ ; ++} ++ ++sub _univ_mod_loaded { ++ return 0 unless exists($::{"UNIVERSAL::"}); ++ for ($::{"UNIVERSAL::"}) { ++ return 0 unless ref \$_ eq "GLOB" && *$_{HASH} && exists $$_{"$_[0]::"}; ++ for ($$_{"$_[0]::"}) { ++ return 0 unless ref \$_ eq "GLOB" && *$_{HASH} && exists $$_{"VERSION"}; ++ for ($$_{"VERSION"}) { ++ return 0 unless ref \$_ eq "GLOB"; ++ return ${*$_{SCALAR}}; ++ } ++ } ++ } ++} ++ ++# _maybe_isa() is usually the UNIVERSAL::isa function. We have to avoid ++# the latter if the UNIVERSAL::isa module has been loaded, to avoid infi- ++# nite recursion; in that case _maybe_isa simply returns true. ++my $isa; ++BEGIN { ++ if (_univ_mod_loaded('isa')) { ++ *_maybe_isa = sub { 1 } ++ } ++ else { ++ # Since we have already done the check, record $isa for use below ++ # when defining _StrVal. ++ *_maybe_isa = $isa = _fetch_sub(UNIVERSAL => "isa"); ++ } ++} ++ ++ ++# We need an overload::StrVal or equivalent function, but we must avoid ++# loading any modules on demand, as Carp is used from __DIE__ handlers and ++# may be invoked after a syntax error. ++# We can copy recent implementations of overload::StrVal and use ++# overloading.pm, which is the fastest implementation, so long as ++# overloading is available. If it is not available, we use our own pure- ++# Perl StrVal. We never actually use overload::StrVal, for various rea- ++# sons described below. ++# overload versions are as follows: ++# undef-1.00 (up to perl 5.8.0) uses bless (avoid!) ++# 1.01-1.17 (perl 5.8.1 to 5.14) uses Scalar::Util ++# 1.18+ (perl 5.16+) uses overloading ++# The ancient 'bless' implementation (that inspires our pure-Perl version) ++# blesses unblessed references and must be avoided. Those using ++# Scalar::Util use refaddr, possibly the pure-Perl implementation, which ++# has the same blessing bug, and must be avoided. Also, Scalar::Util is ++# loaded on demand. Since we avoid the Scalar::Util implementations, we ++# end up having to implement our own overloading.pm-based version for perl ++# 5.10.1 to 5.14. Since it also works just as well in more recent ver- ++# sions, we use it there, too. ++BEGIN { ++ if (eval { require "overloading.pm" }) { ++ *_StrVal = eval 'sub { no overloading; "$_[0]" }' ++ } ++ else { ++ # Work around the UNIVERSAL::can/isa modules to avoid recursion. ++ ++ # _mycan is either UNIVERSAL::can, or, in the presence of an ++ # override, overload::mycan. ++ *_mycan = _univ_mod_loaded('can') ++ ? do { require "overload.pm"; _fetch_sub overload => 'mycan' } ++ : \&UNIVERSAL::can; ++ ++ # _blessed is either UNIVERAL::isa(...), or, in the presence of an ++ # override, a hideous, but fairly reliable, workaround. ++ *_blessed = $isa ++ ? sub { &$isa($_[0], "UNIVERSAL") } ++ : sub { ++ my $probe = "UNIVERSAL::Carp_probe_" . rand; ++ no strict 'refs'; ++ local *$probe = sub { "unlikely string" }; ++ local $@; ++ local $SIG{__DIE__} = sub{}; ++ (eval { $_[0]->$probe } || '') eq 'unlikely string' ++ }; ++ ++ *_StrVal = sub { ++ my $pack = ref $_[0]; ++ # Perl's overload mechanism uses the presence of a special ++ # "method" named "((" or "()" to signal it is in effect. ++ # This test seeks to see if it has been set up. "((" post- ++ # dates overloading.pm, so we can skip it. ++ return "$_[0]" unless _mycan($pack, "()"); ++ # Even at this point, the invocant may not be blessed, so ++ # check for that. ++ return "$_[0]" if not _blessed($_[0]); ++ bless $_[0], "Carp"; ++ my $str = "$_[0]"; ++ bless $_[0], $pack; ++ $pack . substr $str, index $str, "="; ++ } ++ } ++} ++ ++ ++our $VERSION = '1.50'; + $VERSION =~ tr/_//d; + + our $MaxEvalLen = 0; +@@ -203,11 +327,33 @@ sub caller_info { + + my $sub_name = Carp::get_subname( \%call_info ); + if ( $call_info{has_args} ) { +- my @args; +- if (CALLER_OVERRIDE_CHECK_OK && @DB::args == 1 +- && ref $DB::args[0] eq ref \$i +- && $DB::args[0] == \$i ) { +- @DB::args = (); # Don't let anyone see the address of $i ++ # Guard our serialization of the stack from stack refcounting bugs ++ # NOTE this is NOT a complete solution, we cannot 100% guard against ++ # these bugs. However in many cases Perl *is* capable of detecting ++ # them and throws an error when it does. Unfortunately serializing ++ # the arguments on the stack is a perfect way of finding these bugs, ++ # even when they would not affect normal program flow that did not ++ # poke around inside the stack. Inside of Carp.pm it makes little ++ # sense reporting these bugs, as Carp's job is to report the callers ++ # errors, not the ones it might happen to tickle while doing so. ++ # See: https://rt.perl.org/Public/Bug/Display.html?id=131046 ++ # and: https://rt.perl.org/Public/Bug/Display.html?id=52610 ++ # for more details and discussion. - Yves ++ my @args = map { ++ my $arg; ++ local $@= $@; ++ eval { ++ $arg = $_; ++ 1; ++ } or do { ++ $arg = '** argument not available anymore **'; ++ }; ++ $arg; ++ } @DB::args; ++ if (CALLER_OVERRIDE_CHECK_OK && @args == 1 ++ && ref $args[0] eq ref \$i ++ && $args[0] == \$i ) { ++ @args = (); # Don't let anyone see the address of $i + local $@; + my $where = eval { + my $func = $cgc or return ''; +@@ -226,7 +372,6 @@ sub caller_info { + = "** Incomplete caller override detected$where; \@DB::args were not set **"; + } + else { +- @args = @DB::args; + my $overflow; + if ( $MaxArgNums and @args > $MaxArgNums ) + { # More than we want to show? +@@ -253,9 +398,10 @@ our $in_recurse; + sub format_arg { + my $arg = shift; + +- if ( ref($arg) ) { ++ if ( my $pack= ref($arg) ) { ++ + # legitimate, let's not leak it. +- if (!$in_recurse && ++ if (!$in_recurse && _maybe_isa( $arg, 'UNIVERSAL' ) && + do { + local $@; + local $in_recurse = 1; +@@ -278,8 +424,11 @@ sub format_arg { + } + else + { +- my $sub = _fetch_sub(overload => 'StrVal'); +- return $sub ? &$sub($arg) : "$arg"; ++ # Argument may be blessed into a class with overloading, and so ++ # might have an overloaded stringification. We don't want to ++ # risk getting the overloaded stringification, so we need to ++ # use _StrVal, our overload::StrVal()-equivalent. ++ return _StrVal $arg; + } + } + return "undef" if !defined($arg); +@@ -300,32 +449,15 @@ sub format_arg { + next; + } + my $o = ord($c); +- +- # This code is repeated in Regexp::CARP_TRACE() +- if ($] ge 5.007_003) { +- substr $arg, $i, 1, sprintf("\\x{%x}", $o) +- if utf8::native_to_unicode($o) < utf8::native_to_unicode(0x20) +- || utf8::native_to_unicode($o) > utf8::native_to_unicode(0x7e); +- } elsif (ord("A") == 65) { +- substr $arg, $i, 1, sprintf("\\x{%x}", $o) +- if $o < 0x20 || $o > 0x7e; +- } else { # Early EBCDIC +- +- # 3 EBCDIC code pages supported then; all controls but one +- # are the code points below SPACE. The other one is 0x5F on +- # POSIX-BC; FF on the other two. +- substr $arg, $i, 1, sprintf("\\x{%x}", $o) +- if $o < ord(" ") || ((ord ("^") == 106) +- ? $o == 0x5f +- : $o == 0xff); +- } ++ substr $arg, $i, 1, sprintf("\\x{%x}", $o) ++ unless is_safe_printable_codepoint($o); + } + } else { + $arg =~ s/([\"\\\$\@])/\\$1/g; + # This is all the ASCII printables spelled-out. It is portable to all + # Perl versions and platforms (such as EBCDIC). There are other more + # compact ways to do this, but may not work everywhere every version. +- $arg =~ s/([^ !"\$\%#'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf("\\x{%x}",ord($1))/eg; ++ $arg =~ s/([^ !"#\$\%\&'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf("\\x{%x}",ord($1))/eg; + } + downgrade($arg, 1); + return "\"".$arg."\"".$suffix; +@@ -338,25 +470,12 @@ sub Regexp::CARP_TRACE { + for(my $i = length($arg); $i--; ) { + my $o = ord(substr($arg, $i, 1)); + my $x = substr($arg, 0, 0); # work around bug on Perl 5.8.{1,2} +- +- # This code is repeated in format_arg() +- if ($] ge 5.007_003) { +- substr $arg, $i, 1, sprintf("\\x{%x}", $o) +- if utf8::native_to_unicode($o) < utf8::native_to_unicode(0x20) +- || utf8::native_to_unicode($o) > utf8::native_to_unicode(0x7e); +- } elsif (ord("A") == 65) { +- substr $arg, $i, 1, sprintf("\\x{%x}", $o) +- if $o < 0x20 || $o > 0x7e; +- } else { # Early EBCDIC +- substr $arg, $i, 1, sprintf("\\x{%x}", $o) +- if $o < ord(" ") || ((ord ("^") == 106) +- ? $o == 0x5f +- : $o == 0xff); +- } ++ substr $arg, $i, 1, sprintf("\\x{%x}", $o) ++ unless is_safe_printable_codepoint($o); + } + } else { + # See comment in format_arg() about this same regex. +- $arg =~ s/([^ !"\$\%#'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf("\\x{%x}",ord($1))/eg; ++ $arg =~ s/([^ !"#\$\%\&'()*+,\-.\/0123456789:;<=>?\@ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\\\]^_`abcdefghijklmnopqrstuvwxyz\{|}~])/sprintf("\\x{%x}",ord($1))/eg; + } + downgrade($arg, 1); + my $suffix = ""; +@@ -452,6 +571,15 @@ sub longmess_heavy { + return ret_backtrace( $i, @_ ); + } + ++BEGIN { ++ if("$]" >= 5.017004) { ++ # The LAST_FH constant is a reference to the variable. ++ $Carp::{LAST_FH} = \eval '\${^LAST_FH}'; ++ } else { ++ eval '*LAST_FH = sub () { 0 }'; ++ } ++} ++ + # Returns a full stack backtrace starting from where it is + # told. + sub ret_backtrace { +@@ -468,7 +596,16 @@ sub ret_backtrace { + + my %i = caller_info($i); + $mess = "$err at $i{file} line $i{line}$tid_msg"; +- if( defined $. ) { ++ if( $. ) { ++ # Use ${^LAST_FH} if available. ++ if (LAST_FH) { ++ if (${+LAST_FH}) { ++ $mess .= sprintf ", <%s> %s %d", ++ *${+LAST_FH}{NAME}, ++ ($/ eq "\n" ? "line" : "chunk"), $. ++ } ++ } ++ else { + local $@ = ''; + local $SIG{__DIE__}; + eval { +@@ -477,6 +614,7 @@ sub ret_backtrace { + if($@ =~ /^Died at .*(, <.*?> (?:line|chunk) \d+).$/ ) { + $mess .= $1; + } ++ } + } + $mess .= "\.\n"; + +@@ -594,7 +732,8 @@ sub trusts_directly { + for my $var (qw/ CARP_NOT ISA /) { + # Don't try using the variable until we know it exists, + # to avoid polluting the caller's namespace. +- if ( $stash->{$var} && *{$stash->{$var}}{ARRAY} && @{$stash->{$var}} ) { ++ if ( $stash->{$var} && ref \$stash->{$var} eq 'GLOB' ++ && *{$stash->{$var}}{ARRAY} && @{$stash->{$var}} ) { + return @{$stash->{$var}} + } + } +diff --git a/lib/Carp/Heavy.pm b/lib/Carp/Heavy.pm +index f9c584a..a9b803c 100644 +--- a/lib/Carp/Heavy.pm ++++ b/lib/Carp/Heavy.pm +@@ -2,7 +2,7 @@ package Carp::Heavy; + + use Carp (); + +-our $VERSION = '1.42'; ++our $VERSION = '1.50'; + $VERSION =~ tr/_//d; + + # Carp::Heavy was merged into Carp in version 1.12. Any mismatched versions +diff --git a/t/Carp.t b/t/Carp.t +index 65daed7..b1e399d 100644 +--- a/t/Carp.t ++++ b/t/Carp.t +@@ -3,7 +3,7 @@ no warnings "once"; + use Config; + + use IPC::Open3 1.0103 qw(open3); +-use Test::More tests => 67; ++use Test::More tests => 68; + + sub runperl { + my(%args) = @_; +@@ -488,6 +488,17 @@ SKIP: + ); + } + ++{ ++ package Mpar; ++ sub f { Carp::croak "tun syn" } ++ ++ package Phou; ++ $Phou::{ISA} = \42; ++ eval { Mpar::f }; ++} ++like $@, qr/tun syn/, 'Carp can handle non-glob ISA stash elems'; ++ ++ + # New tests go here + + # line 1 "XA" +diff --git a/t/Carp_overloadless.t b/t/Carp_overloadless.t +new file mode 100644 +index 0000000..f4bda04 +--- /dev/null ++++ b/t/Carp_overloadless.t +@@ -0,0 +1,15 @@ ++use warnings; ++#no warnings 'once'; ++use Test::More tests => 1; ++ ++use Carp; ++ ++# test that enabling overload without loading overload.pm does not trigger infinite recursion ++ ++my $p = "OverloadedInXS"; ++*{$p."::(("} = sub{}; ++*{$p.q!::(""!} = sub { Carp::cluck "" }; ++sub { Carp::longmess("longmess:") }->(bless {}, $p); ++ok(1); ++ ++ +diff --git a/t/arg_regexp.t b/t/arg_regexp.t +index 1575b29..83e8f03 100644 +--- a/t/arg_regexp.t ++++ b/t/arg_regexp.t +@@ -1,6 +1,8 @@ + use warnings; + use strict; + ++# confirm that regexp-typed stack args are displayed correctly by longmess() ++ + use Test::More tests => 42; + + use Carp (); +@@ -16,12 +18,14 @@ my $e9 = sprintf "%02x", (($] ge 5.007_003) + : ((ord("A") == 193) + ? 0x51 + : 0xE9)); +-my $chr_e9 = chr eval "0x$e9"; ++my $xe9 = "\\x$e9"; ++my $chr_e9 = eval "\"$xe9\""; + my $nl_as_hex = sprintf "%x", ord("\n"); + + # On Perl 5.6 we accept some incorrect quoting of Unicode characters, + # because upgradedness of regexps isn't preserved by stringification, + # so it's impossible to implement the correct behaviour. ++# FIXME: the permissive patterns don't account for EBCDIC + my $xe9_rx = "$]" < 5.008 ? qr/\\x\{c3\}\\x\{a9\}|\\x\{e9\}/ : qr/\\x\{$e9\}/; + my $x666_rx = "$]" < 5.008 ? qr/\\x\{d9\}\\x\{a6\}|\\x\{666\}/ : qr/\\x\{666\}/; + my $x2603_rx = "$]" < 5.008 ? qr/\\x\{e2\}\\x\{98\}\\x\{83\}|\\x\{2603\}/ : qr/\\x\{2603\}/; +@@ -41,16 +45,10 @@ like lm(qr/\x{666}b/), qr/main::lm\(qr\(\\x\{666\}b\)u?\)/; + like lm(rx("\x{666}b")), qr/main::lm\(qr\(${x666_rx}b\)u?\)/; + like lm(qr/a\x{666}/), qr/main::lm\(qr\(a\\x\{666\}\)u?\)/; + like lm(rx("a\x{666}")), qr/main::lm\(qr\(a${x666_rx}\)u?\)/; +-like lm(qr/L${chr_e9}on/), qr/main::lm\(qr\(L\\x\{?${e9}\}?on\)u?\)/; ++like lm(qr/L${xe9}on/), qr/main::lm\(qr\(L\\x${e9}on\)u?\)/; + like lm(rx("L${chr_e9}on")), qr/main::lm\(qr\(L${xe9_rx}on\)u?\)/; +- +- +-SKIP: { +- skip "wide-character-related bug in pre-5.18 perls", 2 if $] lt 5.017_001; +- +- like lm(qr/L${chr_e9}on \x{2603} !/), qr/main::lm\(qr\(L\\x\{?${e9}\}?on \\x\{2603\} !\)u?\)/; +- like lm(rx("L${chr_e9}on \x{2603} !")), qr/main::lm\(qr\(L${xe9_rx}on ${x2603_rx} !\)u?\)/; +-} ++like lm(qr/L${xe9}on \x{2603} !/), qr/main::lm\(qr\(L\\x${e9}on \\x\{2603\} !\)u?\)/; ++like lm(rx("L${chr_e9}on \x{2603} !")), qr/main::lm\(qr\(L${xe9_rx}on ${x2603_rx} !\)u?\)/; + + $Carp::MaxArgLen = 5; + foreach my $arg ("foo bar baz", "foo bar ba", "foo bar b", "foo bar ", "foo bar", "foo ba") { +@@ -60,16 +58,10 @@ foreach my $arg ("foo b", "foo ", "foo", "fo", "f", "") { + like lm(rx($arg)), qr/main::lm\(qr\(\Q$arg\E\)u?\)/; + } + like lm(qr/foo.bar$/sm), qr/main::lm\(qr\(fo\)\.\.\.u?ms\)/; +- +-SKIP: { +- skip "wide-character-related bug in pre-5.18 perls", 4 if $] lt 5.017_001; +- +- like lm(qr/L${chr_e9}on \x{2603} !/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; +- like lm(rx("L${chr_e9}on \x{2603} !")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; +- like lm(qr/L${chr_e9}on\x{2603}/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; +- like lm(rx("L${chr_e9}on\x{2603}")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; +-} +- ++like lm(qr/L${xe9}on \x{2603} !/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; ++like lm(rx("L${chr_e9}on \x{2603} !")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; ++like lm(qr/L${xe9}on\x{2603}/), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; ++like lm(rx("L${chr_e9}on\x{2603}")), qr/main::lm\(qr\(L\\\)\.\.\.u?\)/; + like lm(qr/foo\x{2603}/), qr/main::lm\(qr\(fo\)\.\.\.u?\)/; + like lm(rx("foo\x{2603}")), qr/main::lm\(qr\(fo\)\.\.\.u?\)/; + +@@ -77,12 +69,7 @@ $Carp::MaxArgLen = 0; + foreach my $arg ("wibble:" x 20, "foo bar baz") { + like lm(rx($arg)), qr/main::lm\(qr\(\Q$arg\E\)u?\)/; + } +- +-SKIP: { +- skip "wide-character-related bug in pre-5.18 perls", 2 if $] lt 5.017_001; +- +- like lm(qr/L${chr_e9}on\x{2603}/), qr/main::lm\(qr\(L\\x\{?${e9}\}?on\\x\{2603\}\)u?\)/; +- like lm(rx("L${chr_e9}on\x{2603}")), qr/main::lm\(qr\(L${xe9_rx}on${x2603_rx}\)u?\)/; +-} ++like lm(qr/L${xe9}on\x{2603}/), qr/main::lm\(qr\(L\\x${e9}on\\x\{2603\}\)u?\)/; ++like lm(rx("L${chr_e9}on\x{2603}")), qr/main::lm\(qr\(L${xe9_rx}on${x2603_rx}\)u?\)/; + + 1; +diff --git a/t/arg_string.t b/t/arg_string.t +index dc70f43..544a4fe 100644 +--- a/t/arg_string.t ++++ b/t/arg_string.t +@@ -1,9 +1,9 @@ + use warnings; + use strict; + +-# confirm that stack args are displayed correctly by longmess() ++# confirm that string-typed stack args are displayed correctly by longmess() + +-use Test::More tests => 32; ++use Test::More tests => 33; + + use Carp (); + +@@ -17,7 +17,8 @@ my $e9 = sprintf "%02x", (($] ge 5.007_003) + : ((ord("A") == 193) + ? 0x51 + : 0xE9)); +-my $chr_e9 = chr eval "0x$e9"; ++my $xe9 = "\\x$e9"; ++my $chr_e9 = eval "\"$xe9\""; + my $nl_as_hex = sprintf "%x", ord("\n"); + + like lm(3), qr/main::lm\(3\)/; +@@ -33,9 +34,9 @@ like lm(-3.5e30), + \) /x; + like lm(""), qr/main::lm\(""\)/; + like lm("foo"), qr/main::lm\("foo"\)/; ++like lm("a&b"), qr/main::lm\("a&b"\)/; + like lm("a\$b\@c\\d\"e"), qr/main::lm\("a\\\$b\\\@c\\\\d\\\"e"\)/; + like lm("a\nb"), qr/main::lm\("a\\x\{$nl_as_hex\}b"\)/; +- + like lm("a\x{666}b"), qr/main::lm\("a\\x\{666\}b"\)/; + like lm("\x{666}b"), qr/main::lm\("\\x\{666\}b"\)/; + like lm("a\x{666}"), qr/main::lm\("a\\x\{666\}"\)/; +diff --git a/t/broken_can.t b/t/broken_can.t +new file mode 100644 +index 0000000..c32fa19 +--- /dev/null ++++ b/t/broken_can.t +@@ -0,0 +1,15 @@ ++use Test::More tests => 1; ++ ++# [perl #132910] ++ ++package Foo; ++sub can { die } ++ ++package main; ++ ++use Carp; ++ ++eval { ++ sub { confess-sins }->(bless[], Foo); ++}; ++like $@, qr/^-sins at /; +diff --git a/t/broken_univ_can.t b/t/broken_univ_can.t +new file mode 100644 +index 0000000..0ec19d7 +--- /dev/null ++++ b/t/broken_univ_can.t +@@ -0,0 +1,24 @@ ++# [perl #132910] ++# This mock-up breaks Test::More. Don’t use Test::More. ++ ++sub UNIVERSAL::can { die; } ++ ++# Carp depends on this to detect the override: ++BEGIN { $UNIVERSAL::can::VERSION = 0xbaff1ed_bee; } ++ ++use Carp; ++ ++eval { ++ sub { confess-sins }->(bless[], Foo); ++}; ++print "1..1\n"; ++if ($@ !~ qr/^-sins at /) { ++ print "not ok 1\n"; ++ print "# Expected -sins at blah blah blah...\n"; ++ print "# Instead, we got:\n"; ++ $@ =~ s/^/# /mg; ++ print $@; ++} ++else { ++ print "ok 1\n"; ++} +diff --git a/t/stack_after_err.t b/t/stack_after_err.t +new file mode 100644 +index 0000000..57dbc23 +--- /dev/null ++++ b/t/stack_after_err.t +@@ -0,0 +1,69 @@ ++use strict; ++use warnings; ++use Config; ++use IPC::Open3 1.0103 qw(open3); ++ ++BEGIN { ++ if ($^O eq 'VMS') { ++ print "1..0 # IPC::Open3 needs porting\n"; ++ exit; ++ } ++} ++ ++my @tests=( ++ # Make sure we don’t try to load modules on demand in the presence of over- ++ # loaded args. If there has been a syntax error, they won’t load. ++ [ 'Carp does not try to load modules on demand for overloaded args', ++ "", qr/Looks lark.*o=ARRAY.* CODE/s, ++ ], ++ # Run the test also in the presence of ++ # a) A UNIVERSAL::can module ++ # b) A UNIVERSAL::isa module ++ # c) Both ++ # since they follow slightly different code paths on old pre-5.10.1 perls. ++ [ 'StrVal fallback in the presence of UNIVERSAL::isa', ++ 'BEGIN { $UNIVERSAL::isa::VERSION = 1 }', ++ qr/Looks lark.*o=ARRAY.* CODE/s, ++ ], ++ [ 'StrVal fallback in the presence of UNIVERSAL::can', ++ 'BEGIN { $UNIVERSAL::can::VERSION = 1 }', ++ qr/Looks lark.*o=ARRAY.* CODE/s, ++ ], ++ [ 'StrVal fallback in the presence of UNIVERSAL::can/isa', ++ 'BEGIN { $UNIVERSAL::can::VERSION = $UNIVERSAL::isa::VERSION = 1 }', ++ qr/Looks lark.*o=ARRAY.* CODE/s, ++ ], ++); ++ ++my ($test_num)= @ARGV; ++if (!$test_num) { ++ eval sprintf "use Test::More tests => %d; 1", 0+@tests ++ or die "Failed to use Test::More: $@"; ++ local $ENV{PERL5LIB} = join ($Config::Config{path_sep}, @INC); ++ foreach my $i (1 .. @tests) { ++ my($w, $r); ++ my $pid = open3($w, $r, undef, $^X, $0, $i); ++ close $w; ++ my $output = do{ local $/; <$r> }; ++ waitpid($pid, 0); ++ like($output, $tests[$i-1][2], $tests[$i-1][0]); ++ } ++} else { ++ eval $tests[$test_num-1][1] . <<'END_OF_TEST_CODE' ++ no strict; ++ no warnings; ++ use Carp; ++ sub foom { ++ Carp::confess("Looks lark we got a error: $_[0]") ++ } ++ BEGIN { ++ *{"o::()"} = sub {}; ++ *{'o::(""'} = sub {"hay"}; ++ $o::OVERLOAD{dummy}++; # perls before 5.18 need this ++ *{"CODE::()"} = sub {}; ++ $SIG{__DIE__} = sub { foom (@_, bless([], o), sub {}) } ++ } ++ $a + ++END_OF_TEST_CODE ++ or die $@; ++} +diff --git a/t/vivify_stash.t b/t/vivify_stash.t +index 0ac66d8..744d0d2 100644 +--- a/t/vivify_stash.t ++++ b/t/vivify_stash.t +@@ -1,25 +1,25 @@ + BEGIN { print "1..5\n"; } + + our $has_utf8; BEGIN { $has_utf8 = exists($::{"utf8::"}); } +-our $has_overload; BEGIN { $has_overload = exists($::{"overload::"}); } + our $has_B; BEGIN { $has_B = exists($::{"B::"}); } ++our $has_UNIVERSAL_isa; BEGIN { $has_UNIVERSAL_isa = exists($UNIVERSAL::{"isa::"}); } + + use Carp; + sub { sub { Carp::longmess("x") }->() }->(\1, "\x{2603}", qr/\x{2603}/); + +-print !(exists($::{"utf8::"}) xor $has_utf8) ? "" : "not ", "ok 1\n"; +-print !(exists($::{"overload::"}) xor $has_overload) ? "" : "not ", "ok 2\n"; +-print !(exists($::{"B::"}) xor $has_B) ? "" : "not ", "ok 3\n"; ++print !(exists($::{"utf8::"}) xor $has_utf8) ? "" : "not ", "ok 1 # used utf8\n"; ++print !(exists($::{"B::"}) xor $has_B) ? "" : "not ", "ok 2 # used B\n"; ++print !(exists($UNIVERSAL::{"isa::"}) xor $has_UNIVERSAL_isa) ? "" : "not ", "ok 3 # used UNIVERSAL::isa\n"; + + # Autovivify $::{"overload::"} + () = \$::{"overload::"}; + () = \$::{"utf8::"}; + eval { sub { Carp::longmess() }->(\1) }; +-print $@ eq '' ? "ok 4\n" : "not ok 4\n# $@"; ++print $@ eq '' ? "ok 4 # longmess check1\n" : "not ok 4 # longmess check1\n# $@"; + + # overload:: glob without hash + undef *{"overload::"}; + eval { sub { Carp::longmess() }->(\1) }; +-print $@ eq '' ? "ok 5\n" : "not ok 5\n# $@"; ++print $@ eq '' ? "ok 5 # longmess check2\n" : "not ok 5 # longmess check2\n# $@"; + + 1; +-- +2.14.3 + diff --git a/perl-Carp.spec b/perl-Carp.spec index bfabb8f..e39a315 100644 --- a/perl-Carp.spec +++ b/perl-Carp.spec @@ -1,8 +1,8 @@ %global cpan_version 1.38 Name: perl-Carp -Version: 1.42 -Release: 396%{?dist} +Version: 1.50 +Release: 1%{?dist} Summary: Alternative warn and die for modules License: GPL+ or Artistic URL: http://search.cpan.org/dist/Carp/ @@ -11,9 +11,8 @@ Source0: http://www.cpan.org/authors/id/R/RJ/RJBS/Carp-%{cpan_version}.ta Patch0: Carp-1.38-Upgrade-to-1.40.patch # Unbundled from perl 5.25.12 Patch1: Carp-1.40-Upgrade-to-1.42.patch -# Prevent from some stack-not-ref-counted crashes in Carp, RT#52610, -# in perl upstream after 5.27.8 -Patch2: Carp-1.42-Fix-RT-52610-Carp-Do-not-crash-when-reading-DB-args.patch +# Unbundled from perl 5.28.0 +Patch2: Carp-1.42-Upgrade-to-1.50.patch BuildArch: noarch BuildRequires: make BuildRequires: perl-generators @@ -68,6 +67,9 @@ make test %{_mandir}/man3/* %changelog +* Wed May 23 2018 Jitka Plesnikova - 1.50-1 +- Upgrade to 1.50 as provided in perl-5.28.0 + * Fri Apr 20 2018 Petr Pisar - 1.42-396 - Prevent from some stack-not-ref-counted crashes in Carp (RT#52610)