Storable: sv_upgrade from type 7 down to type 1 #17037
Comments
From alex.karelas@gmail.comhttps://gist.github.com/akarelas-pt/f53e3f474e9cefbce8cf00af88f18c08 The above page demonstrates a Storable bug. I cannot find anywhere instructions on how to submit bugs for Storable. How do I submit bugs for Storable, and, more importantly, how do I find instructions for how to submit bugs for Storable? Thank you Sirs, - Alexander |
From @ilmariHi Porters, daxim reported on IRC that the following program errors with $subject use Storable qw(dclone); my $foo = [qr//,[]]; Both the preceding qr// and the two-level weakened cycle are necessary Backtrace: $ gdb -q --args perl -MStorable=dclone -MScalar::Util=weaken \ Breakpoint 1, Perl_croak (my_perl=my_perl@entry=0x555555757010, pat=pat@entry=0x7ffff7b49ee0 "sv_upgrade from type %d down to type %d") Summary of my perl5 (revision 5 version 30 subversion 0) configuration: Characteristics of this binary (from libperl): -- |
From @tonycozOn Wed, 05 Jun 2019 07:41:27 -0700, ilmari wrote:
The attached fixes it for me. Tony |
From @tonycoz134179-storable-regexp-self-ref.patchFrom 911c22769d23520ac44e33511a52cd04341fba10 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 10 Jun 2019 10:17:20 +1000
Subject: (perl #134179) include regexps in the seen objects table on retrieve
Also, bless the regexp object, so freezing/thawing bless qr//, "Foo"
returns a "Foo" blesses regexp.
---
dist/Storable/Storable.xs | 3 +++
dist/Storable/t/regexp.t | 4 +++-
dist/Storable/t/weak.t | 10 +++++++++-
3 files changed, 15 insertions(+), 2 deletions(-)
diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index ed729c94a6..ea794bbfe6 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -6808,6 +6808,7 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
SV *sv;
dSP;
I32 count;
+ HV *stash;
PERL_UNUSED_ARG(cname);
@@ -6857,6 +6858,8 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) {
sv = SvRV(re_ref);
SvREFCNT_inc(sv);
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0);
FREETMPS;
LEAVE;
diff --git a/dist/Storable/t/regexp.t b/dist/Storable/t/regexp.t
index acf28cfec6..e7c6c7e94a 100644
--- a/dist/Storable/t/regexp.t
+++ b/dist/Storable/t/regexp.t
@@ -37,7 +37,7 @@ while (<DATA>) {
}
}
-plan tests => 9 + 3*scalar(@tests);
+plan tests => 10 + 3*scalar(@tests);
SKIP:
{
@@ -75,6 +75,8 @@ SKIP:
ok(!eval { dclone($re) }, "should fail to clone, even with use re 'eval'");
}
+is(ref(dclone(bless qr//, "Foo")), "Foo", "check reblessed regexps");
+
for my $test (@tests) {
my ($code, $not, $match, $matchc, $name) = @$test;
my $qr = eval $code;
diff --git a/dist/Storable/t/weak.t b/dist/Storable/t/weak.t
index 220c70160f..48752fbec4 100644
--- a/dist/Storable/t/weak.t
+++ b/dist/Storable/t/weak.t
@@ -29,7 +29,7 @@ sub BEGIN {
}
use Test::More 'no_plan';
-use Storable qw (store retrieve freeze thaw nstore nfreeze);
+use Storable qw (store retrieve freeze thaw nstore nfreeze dclone);
require 'testlib.pl';
our $file;
use strict;
@@ -143,3 +143,11 @@ foreach (@tests) {
$stored = nfreeze $input;
tester($stored, \&freeze_and_thaw, $testsub, 'network string');
}
+
+{
+ # [perl #134179] sv_upgrade from type 7 down to type 1
+ my $foo = [qr//,[]];
+ weaken($foo->[1][0][0] = $foo->[1]);
+ my $out = dclone($foo); # croaked here
+ is_deeply($out, $foo, "check they match");
+}
--
2.11.0
From 040de379ce9b7bec47a258d8b1d7449b21f70d2b Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 10 Jun 2019 10:42:45 +1000
Subject: bump $Storable::VERSION
and update Changes
---
dist/Storable/ChangeLog | 5 +++++
dist/Storable/__Storable__.pm | 2 +-
2 files changed, 6 insertions(+), 1 deletion(-)
diff --git a/dist/Storable/ChangeLog b/dist/Storable/ChangeLog
index 04881992e2..4745c74b85 100644
--- a/dist/Storable/ChangeLog
+++ b/dist/Storable/ChangeLog
@@ -1,3 +1,8 @@
+2019-06-11 10:43:00 TonyC
+ version 3.16
+ * (perl #134179) fix self-referencing structures that include regexps
+ * bless regexps to preserve bless qr//, "Foo"
+
2019-04-23 16:00:00 xsawyerx
version 3.15
* Fix leaking.
diff --git a/dist/Storable/__Storable__.pm b/dist/Storable/__Storable__.pm
index 9237371234..8ed247f96f 100644
--- a/dist/Storable/__Storable__.pm
+++ b/dist/Storable/__Storable__.pm
@@ -27,7 +27,7 @@ our @EXPORT_OK = qw(
our ($canonical, $forgive_me);
-our $VERSION = '3.15';
+our $VERSION = '3.16';
our $recursion_limit;
our $recursion_limit_hash;
--
2.11.0
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @ilmari"Tony Cook via RT" <perlbug-followup@perl.org> writes:
Looks good to me, and matches how other potentially-blessed refs are
This is no longer unused. - ilmari |
From @jkeenanOn Tue, 04 Jun 2019 20:20:41 GMT, alex.karelas@gmail.com wrote:
Your bug report was sent to 'perlbug-admin@perl.org'. It should have been sent to 'perlbug@perl.org'. The sysadmins have moved it to the proper queue. Please include the string: [perl #134176] Thank you very much. -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @tonycozOn Mon, 10 Jun 2019 02:53:18 -0700, ilmari wrote:
Thanks, fixed in the version committed. The fix itself is 16f2ddb and the version bump is 5afa8ff. This fixes both this ticket and the DateTime::Format::Strptime issue now merged into 134179 (since the DateTime::Format::Strptime object has a regular expression embedded in it.) Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From alex.karelas@gmail.comIs it my fault I sent it there? That's the instructions on the screen On 10/6/19 7:33 μ.μ., James E Keenan via RT wrote:
|
Migrated from rt.perl.org#134179 (status was 'pending release')
Searchable as RT134179$
The text was updated successfully, but these errors were encountered: