In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/5afa8ffbdf01228399875ca4111e261e206f40cd?hp=7948efd4698ec5639b8de124f836d9d3064798cb>
- Log ----------------------------------------------------------------- commit 5afa8ffbdf01228399875ca4111e261e206f40cd Author: Tony Cook <[email protected]> Date: Mon Jun 10 10:42:45 2019 +1000 bump $Storable::VERSION and update Changes commit 16f2ddb794883529d5a3ad8326974a07aae7e567 Author: Tony Cook <[email protected]> Date: Mon Jun 10 10:17:20 2019 +1000 (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. ----------------------------------------------------------------------- Summary of changes: dist/Storable/ChangeLog | 5 +++++ dist/Storable/Storable.xs | 5 +++-- dist/Storable/__Storable__.pm | 2 +- dist/Storable/t/regexp.t | 4 +++- dist/Storable/t/weak.t | 10 +++++++++- 5 files changed, 21 insertions(+), 5 deletions(-) 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.xs b/dist/Storable/Storable.xs index ed729c94a6..6a45d8adf2 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -6808,8 +6808,7 @@ static SV *retrieve_regexp(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv; dSP; I32 count; - - PERL_UNUSED_ARG(cname); + HV *stash; ENTER; SAVETMPS; @@ -6857,6 +6856,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/__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; 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"); +} -- Perl5 Master Repository
