From cea1d7e080624961b978dd11782a2a10faeebc76 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Mon, 10 Sep 2018 12:43:15 +0200 Subject: [PATCH] Replace patched sources with 1.50 CPAN release --- .gitignore | 1 + Carp-1.38-Upgrade-to-1.40.patch | 118 ----- Carp-1.40-Upgrade-to-1.42.patch | 128 ------ Carp-1.42-Upgrade-to-1.50.patch | 759 -------------------------------- perl-Carp.spec | 15 +- sources | 2 +- 6 files changed, 4 insertions(+), 1019 deletions(-) delete mode 100644 Carp-1.38-Upgrade-to-1.40.patch delete mode 100644 Carp-1.40-Upgrade-to-1.42.patch delete mode 100644 Carp-1.42-Upgrade-to-1.50.patch diff --git a/.gitignore b/.gitignore index 6aecb9d..c6c7d06 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ /Carp-1.35.tar.gz /Carp-1.36.tar.gz /Carp-1.38.tar.gz +/Carp-1.50.tar.gz diff --git a/Carp-1.38-Upgrade-to-1.40.patch b/Carp-1.38-Upgrade-to-1.40.patch deleted file mode 100644 index 1ea49a5..0000000 --- a/Carp-1.38-Upgrade-to-1.40.patch +++ /dev/null @@ -1,118 +0,0 @@ -diff --git a/Changes b/Changes -index b55b49f..dca6a52 100644 ---- a/Changes -+++ b/Changes -@@ -1,4 +1,12 @@ - -+version 1.40; 2016-03-10 -+ * Get arg_string.t to compile in perl v5.6 -+ * Add information for how to contribute to Carp. -+ -+version 1.39; 2016-03-06 -+ * bugfix: longmess() should return the error in scalar context -+ (CPANRT#107225) -+ - version 1.38; 2015-11-06 - * stable release of changes since v1.36 - -diff --git a/lib/Carp.pm b/lib/Carp.pm -index 9421c74..92f8866 100644 ---- a/lib/Carp.pm -+++ b/lib/Carp.pm -@@ -87,7 +87,7 @@ BEGIN { - } - } - --our $VERSION = '1.38'; -+our $VERSION = '1.40'; - $VERSION =~ tr/_//d; - - our $MaxEvalLen = 0; -@@ -445,7 +445,9 @@ sub long_error_loc { - } - - sub longmess_heavy { -- return @_ if ref( $_[0] ); # don't break references as exceptions -+ if ( ref( $_[0] ) ) { # don't break references as exceptions -+ return wantarray ? @_ : $_[0]; -+ } - my $i = long_error_loc(); - return ret_backtrace( $i, @_ ); - } -@@ -906,6 +908,12 @@ call die() or warn(), as appropriate. - L, - L - -+=head1 CONTRIBUTING -+ -+L is maintained by the perl 5 porters as part of the core perl 5 -+version control repository. Please see the L perldoc for how to -+submit patches and contribute to it. -+ - =head1 AUTHOR - - The Carp module first appeared in Larry Wall's perl 5.000 distribution. -diff --git a/lib/Carp/Heavy.pm b/lib/Carp/Heavy.pm -index 91a42d1..b05d758 100644 ---- a/lib/Carp/Heavy.pm -+++ b/lib/Carp/Heavy.pm -@@ -2,7 +2,7 @@ package Carp::Heavy; - - use Carp (); - --our $VERSION = '1.38'; -+our $VERSION = '1.40'; - $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 a18e3b4..9ecdf88 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 => 65; -+use Test::More tests => 66; - - sub runperl { - my(%args) = @_; -@@ -39,6 +39,24 @@ BEGIN { - ); - } - -+package MyClass; -+ -+sub new { return bless +{ field => ['value1', 'SecondVal'] }; } -+ -+package main; -+ -+{ -+ my $err = Carp::longmess(MyClass->new); -+ -+ # See: -+ # https://rt.cpan.org/Public/Bug/Display.html?id=107225 -+ is_deeply( -+ $err->{field}, -+ ['value1', 'SecondVal',], -+ "longmess returns sth meaningful in scalar context when passed a ref.", -+ ); -+} -+ - { - local $SIG{__WARN__} = sub { - like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+\.$/, 'ok 2\n'; -diff --git a/t/arg_string.t b/t/arg_string.t -index 42b43b1..dbd2e6e 100644 ---- a/t/arg_string.t -+++ b/t/arg_string.t -@@ -15,7 +15,7 @@ my $e9 = sprintf "%02x", (($] ge 5.007_003) - : ((ord("A") == 193) - ? 0x51 - : 0xE9)); --my $chr_e9 = chr utf8::unicode_to_native(0xe9); -+my $chr_e9 = chr eval "0x$e9"; - my $nl_as_hex = sprintf "%x", ord("\n"); - - like lm(3), qr/main::lm\(3\)/; diff --git a/Carp-1.40-Upgrade-to-1.42.patch b/Carp-1.40-Upgrade-to-1.42.patch deleted file mode 100644 index b85353e..0000000 --- a/Carp-1.40-Upgrade-to-1.42.patch +++ /dev/null @@ -1,128 +0,0 @@ -From 7cdc0cd3cf5f9fd6459daa746db8f647c14ef9fe Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= -Date: Thu, 11 May 2017 08:43:33 +0200 -Subject: [PATCH] Upgrade to 1.42 -MIME-Version: 1.0 -Content-Type: text/plain; charset=UTF-8 -Content-Transfer-Encoding: 8bit - -Unbundled from perl-5.25.12. - -Signed-off-by: Petr Písař ---- - lib/Carp.pm | 6 +++--- - lib/Carp/Heavy.pm | 2 +- - t/Carp.t | 13 ++++++++++++- - t/arg_string.t | 10 +++++++++- - 4 files changed, 25 insertions(+), 6 deletions(-) - -diff --git a/lib/Carp.pm b/lib/Carp.pm -index 92f8866..05052b9 100644 ---- a/lib/Carp.pm -+++ b/lib/Carp.pm -@@ -87,7 +87,7 @@ BEGIN { - } - } - --our $VERSION = '1.40'; -+our $VERSION = '1.42'; - $VERSION =~ tr/_//d; - - our $MaxEvalLen = 0; -@@ -474,7 +474,7 @@ sub ret_backtrace { - eval { - CORE::die; - }; -- if($@ =~ /^Died at .*(, <.*?> line \d+).$/ ) { -+ if($@ =~ /^Died at .*(, <.*?> (?:line|chunk) \d+).$/ ) { - $mess .= $1; - } - } -@@ -636,7 +636,7 @@ Carp - alternative warn and die for modules - - # cluck, longmess and shortmess not exported by default - use Carp qw(cluck longmess shortmess); -- cluck "This is how we got here!"; -+ cluck "This is how we got here!"; # warn with stack backtrace - $long_message = longmess( "message from cluck() or confess()" ); - $short_message = shortmess( "message from carp() or croak()" ); - -diff --git a/lib/Carp/Heavy.pm b/lib/Carp/Heavy.pm -index b05d758..f9c584a 100644 ---- a/lib/Carp/Heavy.pm -+++ b/lib/Carp/Heavy.pm -@@ -2,7 +2,7 @@ package Carp::Heavy; - - use Carp (); - --our $VERSION = '1.40'; -+our $VERSION = '1.42'; - $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 9ecdf88..65daed7 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 => 66; -+use Test::More tests => 67; - - sub runperl { - my(%args) = @_; -@@ -442,6 +442,16 @@ $@ =~ s/\n.*//; # just check first line - is $@, "heek at ".__FILE__." line ".(__LINE__-2).", line 2.\n", - 'last handle line num is mentioned'; - -+# [cpan #100183] -+{ -+ local $/ = \6; -+ ; -+ eval { croak 'jeek' }; -+ $@ =~ s/\n.*//; # just check first line -+ is $@, "jeek at ".__FILE__." line ".(__LINE__-2).", chunk 3.\n", -+ 'last handle chunk num is mentioned'; -+} -+ - SKIP: - { - skip "IPC::Open3::open3 needs porting", 1 if $Is_VMS; -@@ -531,3 +541,4 @@ __DATA__ - 1 - 2 - 3 -+abcdefghijklmnopqrstuvwxyz -diff --git a/t/arg_string.t b/t/arg_string.t -index dbd2e6e..dc70f43 100644 ---- a/t/arg_string.t -+++ b/t/arg_string.t -@@ -1,6 +1,8 @@ - use warnings; - use strict; - -+# confirm that stack args are displayed correctly by longmess() -+ - use Test::More tests => 32; - - use Carp (); -@@ -22,7 +24,13 @@ like lm(3), qr/main::lm\(3\)/; - like lm(substr("3\x{2603}", 0, 1)), qr/main::lm\(3\)/; - like lm(-3), qr/main::lm\(-3\)/; - like lm(-3.5), qr/main::lm\(-3\.5\)/; --like lm(-3.5e100), qr/main::lm\(-3\.5[eE]\+?100\)/; -+like lm(-3.5e30), -+ qr/main::lm\( -+ ( -+ -3500000000000000000000000000000 -+ | -3\.5[eE]\+?0?30 -+ ) -+ \) /x; - like lm(""), qr/main::lm\(""\)/; - like lm("foo"), qr/main::lm\("foo"\)/; - like lm("a\$b\@c\\d\"e"), qr/main::lm\("a\\\$b\\\@c\\\\d\\\"e"\)/; --- -2.9.3 - diff --git a/Carp-1.42-Upgrade-to-1.50.patch b/Carp-1.42-Upgrade-to-1.50.patch deleted file mode 100644 index e6cb013..0000000 --- a/Carp-1.42-Upgrade-to-1.50.patch +++ /dev/null @@ -1,759 +0,0 @@ -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 9bfbd2b..66b7ad5 100644 --- a/perl-Carp.spec +++ b/perl-Carp.spec @@ -1,18 +1,10 @@ -%global cpan_version 1.38 - Name: perl-Carp Version: 1.50 Release: 417%{?dist} Summary: Alternative warn and die for modules License: GPL+ or Artistic URL: https://metacpan.org/release/Carp -Source0: https://cpan.metacpan.org/authors/id/R/RJ/RJBS/Carp-%{cpan_version}.tar.gz -# Unbundled from perl 5.24.0 -Patch0: Carp-1.38-Upgrade-to-1.40.patch -# Unbundled from perl 5.25.12 -Patch1: Carp-1.40-Upgrade-to-1.42.patch -# Unbundled from perl 5.28.0 -Patch2: Carp-1.42-Upgrade-to-1.50.patch +Source0: https://cpan.metacpan.org/authors/id/X/XS/XSAWYERX/Carp-%{version}.tar.gz BuildArch: noarch BuildRequires: make BuildRequires: perl-generators @@ -45,10 +37,7 @@ module was called. There is no guarantee that that is where the error was, but it is a good educated guess. %prep -%setup -q -n Carp-%{cpan_version} -%patch0 -p1 -%patch1 -p1 -%patch2 -p1 +%setup -q -n Carp-%{version} %build perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 diff --git a/sources b/sources index 785184e..e12b7c7 100644 --- a/sources +++ b/sources @@ -1 +1 @@ -93ac4c56312a9db6cef3b502a8169859 Carp-1.38.tar.gz +SHA512 (Carp-1.50.tar.gz) = 624e5fe41492d1d5de840d56a648168f2e6066717efaa20d257b277219ea2cd3b73e5bc2bd46a3e37e060cb3e35b4cccc560bdd169c2e252e861d441e90df4b6