Compare commits

...

No commits in common. "c8-stream-5.3" and "c8-beta" have entirely different histories.

6 changed files with 347 additions and 25 deletions

2
.gitignore vendored
View File

@ -1 +1 @@
SOURCES/Carp-1.50.tar.gz
SOURCES/Carp-1.38.tar.gz

View File

@ -1 +1 @@
309973bc0c27f7a186a307c0f243cac36101d229 SOURCES/Carp-1.50.tar.gz
6ad4e281ea94c3065c54237b03e1740b879fb6e5 SOURCES/Carp-1.38.tar.gz

View File

@ -0,0 +1,118 @@
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<Carp::Always>,
L<Carp::Clan>
+=head1 CONTRIBUTING
+
+L<Carp> is maintained by the perl 5 porters as part of the core perl 5
+version control repository. Please see the L<perlhack> 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\)/;

View File

@ -0,0 +1,128 @@
From 7cdc0cd3cf5f9fd6459daa746db8f647c14ef9fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
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ř <ppisar@redhat.com>
---
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).", <DATA> line 2.\n",
'last handle line num is mentioned';
+# [cpan #100183]
+{
+ local $/ = \6;
+ <XD::DATA>;
+ eval { croak 'jeek' };
+ $@ =~ s/\n.*//; # just check first line
+ is $@, "jeek at ".__FILE__." line ".(__LINE__-2).", <DATA> 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

View File

@ -0,0 +1,82 @@
From b5ad485cc167b3b6aa43f83aa92bbf8b8811cb42 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
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 <pali@cpan.org>
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ř <ppisar@redhat.com>
---
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

View File

@ -1,10 +1,19 @@
%global cpan_version 1.38
Name: perl-Carp
Version: 1.50
Release: 439%{?dist}
Version: 1.42
Release: 396%{?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/X/XS/XSAWYERX/Carp-%{version}.tar.gz
URL: http://search.cpan.org/dist/Carp/
Source0: http://www.cpan.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
# 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
BuildArch: noarch
BuildRequires: make
BuildRequires: perl-generators
@ -37,7 +46,10 @@ 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-%{version}
%setup -q -n Carp-%{cpan_version}
%patch0 -p1
%patch1 -p1
%patch2 -p1
%build
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1
@ -56,24 +68,6 @@ make test
%{_mandir}/man3/*
%changelog
* Fri Jul 26 2019 Fedora Release Engineering <releng@fedoraproject.org> - 1.50-439
- Rebuilt for https://fedoraproject.org/wiki/Fedora_31_Mass_Rebuild
* Thu May 30 2019 Jitka Plesnikova <jplesnik@redhat.com> - 1.50-438
- Increase release to favour standalone package
* Fri Feb 01 2019 Fedora Release Engineering <releng@fedoraproject.org> - 1.50-418
- Rebuilt for https://fedoraproject.org/wiki/Fedora_30_Mass_Rebuild
* Fri Jul 13 2018 Fedora Release Engineering <releng@fedoraproject.org> - 1.50-417
- Rebuilt for https://fedoraproject.org/wiki/Fedora_29_Mass_Rebuild
* Tue Jun 26 2018 Jitka Plesnikova <jplesnik@redhat.com> - 1.50-416
- Increase release to favour standalone package
* Wed May 23 2018 Jitka Plesnikova <jplesnik@redhat.com> - 1.50-1
- Upgrade to 1.50 as provided in perl-5.28.0
* Fri Apr 20 2018 Petr Pisar <ppisar@redhat.com> - 1.42-396
- Prevent from some stack-not-ref-counted crashes in Carp (RT#52610)