From fd2e79041c553c1220c6eca796293873246c5682 Mon Sep 17 00:00:00 2001

From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>

Date: Wed, 6 May 2015 09:39:53 +0200

Subject: [PATCH] Upgrade to 2.53

MIME-Version: 1.0

Content-Type: text/plain; charset=UTF-8

Content-Transfer-Encoding: 8bit

Signed-off-by: Petr Písař <ppisar@redhat.com>

---

 ChangeLog         |  2 +-

 MANIFEST          |  3 +++

 Storable.pm       |  6 +++---

 t/attach.t        | 42 ++++++++++++++++++++++++++++++++++++

 t/attach_errors.t |  2 +-

 t/canonical.t     |  2 +-

 t/code.t          |  2 +-

 t/leaks.t         | 34 +++++++++++++++++++++++++++++

 t/tied_store.t    | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++

 t/utf8.t          |  6 ++++--

 10 files changed, 154 insertions(+), 9 deletions(-)

 create mode 100644 t/attach.t

 create mode 100644 t/leaks.t

 create mode 100644 t/tied_store.t

diff --git a/ChangeLog b/ChangeLog

index 4df921e..cbfdbab 100644

--- a/ChangeLog

+++ b/ChangeLog

@@ -209,7 +209,7 @@ Fri Jun  7 23:55:41 BST 2002   Nicholas Clark

 	The bug was introduced as development perl change 16442 (on

 	2002/05/07), so has been present since 2.00.

 	Patches to introduce more regression tests to reduce the chance of

-	a reoccurence of this sort of goof are always welcome.

+	a reoccurrence of this sort of goof are always welcome.

 Thu May 30 20:31:08 BST 2002   Nicholas Clark <nick@ccl4.org>

diff --git a/MANIFEST b/MANIFEST

index 84b72f1..2f5b725 100644

--- a/MANIFEST

+++ b/MANIFEST

@@ -9,6 +9,7 @@ ppport.h

 README

 Storable.pm

 Storable.xs

+t/attach.t

 t/attach_errors.t

 t/attach_singleton.t

 t/blessed.t

@@ -33,6 +34,7 @@ t/HAS_OVERLOAD.pm

 t/integer.t

 t/interwork56.t

 t/just_plain_nasty.t

+t/leaks.t

 t/lock.t

 t/make_56_interwork.pl

 t/make_downgrade.pl

@@ -51,6 +53,7 @@ t/threads.t

 t/tied.t

 t/tied_hook.t

 t/tied_items.t

+t/tied_store.t

 t/utf8.t

 t/utf8hash.t

 t/weak.t

diff --git a/Storable.pm b/Storable.pm

index 839c1d1..9d8b621 100644

--- a/Storable.pm

+++ b/Storable.pm

@@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter);

 use vars qw($canonical $forgive_me $VERSION);

-$VERSION = '2.51';

+$VERSION = '2.53';

 BEGIN {

     if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {

@@ -1088,8 +1088,8 @@ deal with them.

 The store functions will C<croak> if they run into such references

 unless you set C<$Storable::forgive_me> to some C<TRUE> value. In that

-case, the fatal message is turned in a warning and some

-meaningless string is stored instead.

+case, the fatal message is converted to a warning and some meaningless

+string is stored instead.

 Setting C<$Storable::canonical> may not yield frozen strings that

 compare equal due to possible stringification of numbers. When the

diff --git a/t/attach.t b/t/attach.t

new file mode 100644

index 0000000..5ffdae5

--- /dev/null

+++ b/t/attach.t

@@ -0,0 +1,42 @@

+#!./perl -w

+#

+# This file tests that Storable correctly uses STORABLE_attach hooks

+

+sub BEGIN {

+	unshift @INC, 't';

+	unshift @INC, 't/compat' if $] < 5.006002;

+	require Config; import Config;

+	if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {

+		print "1..0 # Skip: Storable was not built\n";

+		exit 0;

+	}

+}

+

+use Test::More tests => 3;

+use Storable ();

+

+{

+	my $destruct_cnt = 0;

+	my $obj = bless {data => 'ok'}, 'My::WithDestructor';

+	my $target = Storable::thaw( Storable::freeze( $obj ) );

+	is( $target->{data}, 'ok', 'We got correct object after freeze/thaw' );

+	is( $destruct_cnt, 0, 'No tmp objects created by Storable' );

+	undef $obj;

+	undef $target;

+	is( $destruct_cnt, 2, 'Only right objects destroyed at the end' );

+

+	package My::WithDestructor;

+

+	sub STORABLE_freeze {

+		my ($self, $clone) = @_;

+		return $self->{data};

+	}

+

+	sub STORABLE_attach {

+		my ($class, $clone, $string) = @_;

+		return bless {data => $string}, 'My::WithDestructor';

+	}

+

+	sub DESTROY { $destruct_cnt++; }

+}

+

diff --git a/t/attach_errors.t b/t/attach_errors.t

index c163ca0..6cebd97 100644

--- a/t/attach_errors.t

+++ b/t/attach_errors.t

@@ -234,7 +234,7 @@ use Storable ();

 	isa_ok( $thawed->[1], 'My::GoodAttach::MultipleReferences' );

 	is($thawed->[0], $thawed->[1], 'References to the same object are attached properly');

-	is($thawed->[1]{id}, $obj->{id}, 'Object with multiple references attchached properly');

+	is($thawed->[1]{id}, $obj->{id}, 'Object with multiple references attached properly');

     package My::GoodAttach::MultipleReferences;

diff --git a/t/canonical.t b/t/canonical.t

index 23e012f..35046de 100644

--- a/t/canonical.t

+++ b/t/canonical.t

@@ -34,7 +34,7 @@ $maxarraysize = 100;

 eval { require Digest::MD5; };

 $gotmd5 = !$@;

-diag "Will use Digest::MD5" if $gotmd5;

+note "Will use Digest::MD5" if $gotmd5;

 # Use Data::Dumper if debugging and it is available to create an ASCII dump

diff --git a/t/code.t b/t/code.t

index c383142..7fc40ba 100644

--- a/t/code.t

+++ b/t/code.t

@@ -102,7 +102,7 @@ is($thawed->{"b"}->(), "JAPH");

 $freezed = freeze $obj[2];

 $thawed  = thaw $freezed;

-is($thawed->(), 42);

+is($thawed->(), (ord "A") == 193 ? -118 : 42);

 ######################################################################

diff --git a/t/leaks.t b/t/leaks.t

new file mode 100644

index 0000000..06360d6

--- /dev/null

+++ b/t/leaks.t

@@ -0,0 +1,34 @@

+#!./perl

+

+use Test::More;

+use Storable ();

+BEGIN {

+eval "use Test::LeakTrace";

+plan 'skip_all' => 'Test::LeakTrace required for this tests' if $@;

+}

+plan 'tests' => 1;

+

+{

+    my $c = My::Simple->new;

+    my $d;

+    my $freezed = Storable::freeze($c);

+    no_leaks_ok

+    {

+        $d = Storable::thaw($freezed);

+        undef $d;

+    };

+

+    package My::Simple;

+    sub new {

+        my ($class, $arg) = @_;

+        bless {t=>$arg}, $class;

+    }

+    sub STORABLE_freeze {

+        return "abcderfgh";

+    }

+    sub STORABLE_attach {

+        my ($class, $c, $serialized) = @_;

+        return $class->new($serialized);

+    }

+}

+

diff --git a/t/tied_store.t b/t/tied_store.t

new file mode 100644

index 0000000..c657f95

--- /dev/null

+++ b/t/tied_store.t

@@ -0,0 +1,64 @@

+#!./perl

+

+sub BEGIN {

+    unshift @INC, 't';

+    unshift @INC, 't/compat' if $] < 5.006002;

+    require Config; import Config;

+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {

+        print "1..0 # Skip: Storable was not built\n";

+        exit 0;

+    }

+}

+

+use Storable ();

+use Test::More tests => 3;

+

+our $f;

+

+package TIED_HASH;

+

+sub TIEHASH { bless({}, $_[0]) }

+

+sub STORE {

+	$f = Storable::freeze(\$_[2]);

+	1;

+}

+

+package TIED_ARRAY;

+

+sub TIEARRAY { bless({}, $_[0]) }

+

+sub STORE {

+	$f = Storable::freeze(\$_[2]);

+	1;

+}

+

+package TIED_SCALAR;

+

+sub TIESCALAR { bless({}, $_[0]) }

+

+sub STORE {

+	$f = Storable::freeze(\$_[1]);

+	1;

+}

+

+package main;

+

+my($s, @a, %h);

+tie $s, "TIED_SCALAR";

+tie @a, "TIED_ARRAY";

+tie %h, "TIED_HASH";

+

+$f = undef;

+$s = 111;

+is $f, Storable::freeze(\111);

+

+$f = undef;

+$a[3] = 222;

+is $f, Storable::freeze(\222);

+

+$f = undef;

+$h{foo} = 333;

+is $f, Storable::freeze(\333);

+

+1;

diff --git a/t/utf8.t b/t/utf8.t

index fd20ef6..a8dd6cd 100644

--- a/t/utf8.t

+++ b/t/utf8.t

@@ -32,8 +32,10 @@ is($x, ${thaw freeze \$x});

 $x = join '', map {chr $_} (0..1023);

 is($x, ${thaw freeze \$x});

-# Char in the range 127-255 (probably) in utf8

-$x = chr (175) . chr (256);

+# Char in the range 127-255 (probably) in utf8.  This just won't work for

+# EBCDIC for early Perls.

+$x = ($] lt 5.007_003) ? chr(175) : chr(utf8::unicode_to_native(175))

+   . chr (256);

 chop $x;

 is($x, ${thaw freeze \$x});

-- 

2.1.0