Blame SOURCES/Storable-2.51-Upgrade-to-2.53.patch

1c0695
From fd2e79041c553c1220c6eca796293873246c5682 Mon Sep 17 00:00:00 2001
1c0695
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
1c0695
Date: Wed, 6 May 2015 09:39:53 +0200
1c0695
Subject: [PATCH] Upgrade to 2.53
1c0695
MIME-Version: 1.0
1c0695
Content-Type: text/plain; charset=UTF-8
1c0695
Content-Transfer-Encoding: 8bit
1c0695
1c0695
Signed-off-by: Petr Písař <ppisar@redhat.com>
1c0695
---
1c0695
 ChangeLog         |  2 +-
1c0695
 MANIFEST          |  3 +++
1c0695
 Storable.pm       |  6 +++---
1c0695
 t/attach.t        | 42 ++++++++++++++++++++++++++++++++++++
1c0695
 t/attach_errors.t |  2 +-
1c0695
 t/canonical.t     |  2 +-
1c0695
 t/code.t          |  2 +-
1c0695
 t/leaks.t         | 34 +++++++++++++++++++++++++++++
1c0695
 t/tied_store.t    | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
1c0695
 t/utf8.t          |  6 ++++--
1c0695
 10 files changed, 154 insertions(+), 9 deletions(-)
1c0695
 create mode 100644 t/attach.t
1c0695
 create mode 100644 t/leaks.t
1c0695
 create mode 100644 t/tied_store.t
1c0695
1c0695
diff --git a/ChangeLog b/ChangeLog
1c0695
index 4df921e..cbfdbab 100644
1c0695
--- a/ChangeLog
1c0695
+++ b/ChangeLog
1c0695
@@ -209,7 +209,7 @@ Fri Jun  7 23:55:41 BST 2002   Nicholas Clark
1c0695
 	The bug was introduced as development perl change 16442 (on
1c0695
 	2002/05/07), so has been present since 2.00.
1c0695
 	Patches to introduce more regression tests to reduce the chance of
1c0695
-	a reoccurence of this sort of goof are always welcome.
1c0695
+	a reoccurrence of this sort of goof are always welcome.
1c0695
 	
1c0695
 Thu May 30 20:31:08 BST 2002   Nicholas Clark <nick@ccl4.org>
1c0695
 
1c0695
diff --git a/MANIFEST b/MANIFEST
1c0695
index 84b72f1..2f5b725 100644
1c0695
--- a/MANIFEST
1c0695
+++ b/MANIFEST
1c0695
@@ -9,6 +9,7 @@ ppport.h
1c0695
 README
1c0695
 Storable.pm
1c0695
 Storable.xs
1c0695
+t/attach.t
1c0695
 t/attach_errors.t
1c0695
 t/attach_singleton.t
1c0695
 t/blessed.t
1c0695
@@ -33,6 +34,7 @@ t/HAS_OVERLOAD.pm
1c0695
 t/integer.t
1c0695
 t/interwork56.t
1c0695
 t/just_plain_nasty.t
1c0695
+t/leaks.t
1c0695
 t/lock.t
1c0695
 t/make_56_interwork.pl
1c0695
 t/make_downgrade.pl
1c0695
@@ -51,6 +53,7 @@ t/threads.t
1c0695
 t/tied.t
1c0695
 t/tied_hook.t
1c0695
 t/tied_items.t
1c0695
+t/tied_store.t
1c0695
 t/utf8.t
1c0695
 t/utf8hash.t
1c0695
 t/weak.t
1c0695
diff --git a/Storable.pm b/Storable.pm
1c0695
index 839c1d1..9d8b621 100644
1c0695
--- a/Storable.pm
1c0695
+++ b/Storable.pm
1c0695
@@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter);
1c0695
 
1c0695
 use vars qw($canonical $forgive_me $VERSION);
1c0695
 
1c0695
-$VERSION = '2.51';
1c0695
+$VERSION = '2.53';
1c0695
 
1c0695
 BEGIN {
1c0695
     if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
1c0695
@@ -1088,8 +1088,8 @@ deal with them.
1c0695
 
1c0695
 The store functions will C<croak> if they run into such references
1c0695
 unless you set C<$Storable::forgive_me> to some C<TRUE> value. In that
1c0695
-case, the fatal message is turned in a warning and some
1c0695
-meaningless string is stored instead.
1c0695
+case, the fatal message is converted to a warning and some meaningless
1c0695
+string is stored instead.
1c0695
 
1c0695
 Setting C<$Storable::canonical> may not yield frozen strings that
1c0695
 compare equal due to possible stringification of numbers. When the
1c0695
diff --git a/t/attach.t b/t/attach.t
1c0695
new file mode 100644
1c0695
index 0000000..5ffdae5
1c0695
--- /dev/null
1c0695
+++ b/t/attach.t
1c0695
@@ -0,0 +1,42 @@
1c0695
+#!./perl -w
1c0695
+#
1c0695
+# This file tests that Storable correctly uses STORABLE_attach hooks
1c0695
+
1c0695
+sub BEGIN {
1c0695
+	unshift @INC, 't';
1c0695
+	unshift @INC, 't/compat' if $] < 5.006002;
1c0695
+	require Config; import Config;
1c0695
+	if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
1c0695
+		print "1..0 # Skip: Storable was not built\n";
1c0695
+		exit 0;
1c0695
+	}
1c0695
+}
1c0695
+
1c0695
+use Test::More tests => 3;
1c0695
+use Storable ();
1c0695
+
1c0695
+{
1c0695
+	my $destruct_cnt = 0;
1c0695
+	my $obj = bless {data => 'ok'}, 'My::WithDestructor';
1c0695
+	my $target = Storable::thaw( Storable::freeze( $obj ) );
1c0695
+	is( $target->{data}, 'ok', 'We got correct object after freeze/thaw' );
1c0695
+	is( $destruct_cnt, 0, 'No tmp objects created by Storable' );
1c0695
+	undef $obj;
1c0695
+	undef $target;
1c0695
+	is( $destruct_cnt, 2, 'Only right objects destroyed at the end' );
1c0695
+
1c0695
+	package My::WithDestructor;
1c0695
+
1c0695
+	sub STORABLE_freeze {
1c0695
+		my ($self, $clone) = @_;
1c0695
+		return $self->{data};
1c0695
+	}
1c0695
+
1c0695
+	sub STORABLE_attach {
1c0695
+		my ($class, $clone, $string) = @_;
1c0695
+		return bless {data => $string}, 'My::WithDestructor';
1c0695
+	}
1c0695
+
1c0695
+	sub DESTROY { $destruct_cnt++; }
1c0695
+}
1c0695
+
1c0695
diff --git a/t/attach_errors.t b/t/attach_errors.t
1c0695
index c163ca0..6cebd97 100644
1c0695
--- a/t/attach_errors.t
1c0695
+++ b/t/attach_errors.t
1c0695
@@ -234,7 +234,7 @@ use Storable ();
1c0695
 	isa_ok( $thawed->[1], 'My::GoodAttach::MultipleReferences' );
1c0695
 
1c0695
 	is($thawed->[0], $thawed->[1], 'References to the same object are attached properly');
1c0695
-	is($thawed->[1]{id}, $obj->{id}, 'Object with multiple references attchached properly');
1c0695
+	is($thawed->[1]{id}, $obj->{id}, 'Object with multiple references attached properly');
1c0695
 
1c0695
     package My::GoodAttach::MultipleReferences;
1c0695
 
1c0695
diff --git a/t/canonical.t b/t/canonical.t
1c0695
index 23e012f..35046de 100644
1c0695
--- a/t/canonical.t
1c0695
+++ b/t/canonical.t
1c0695
@@ -34,7 +34,7 @@ $maxarraysize = 100;
1c0695
 
1c0695
 eval { require Digest::MD5; };
1c0695
 $gotmd5 = !$@;
1c0695
-diag "Will use Digest::MD5" if $gotmd5;
1c0695
+note "Will use Digest::MD5" if $gotmd5;
1c0695
 
1c0695
 # Use Data::Dumper if debugging and it is available to create an ASCII dump
1c0695
 
1c0695
diff --git a/t/code.t b/t/code.t
1c0695
index c383142..7fc40ba 100644
1c0695
--- a/t/code.t
1c0695
+++ b/t/code.t
1c0695
@@ -102,7 +102,7 @@ is($thawed->{"b"}->(), "JAPH");
1c0695
 $freezed = freeze $obj[2];
1c0695
 $thawed  = thaw $freezed;
1c0695
 
1c0695
-is($thawed->(), 42);
1c0695
+is($thawed->(), (ord "A") == 193 ? -118 : 42);
1c0695
 
1c0695
 ######################################################################
1c0695
 
1c0695
diff --git a/t/leaks.t b/t/leaks.t
1c0695
new file mode 100644
1c0695
index 0000000..06360d6
1c0695
--- /dev/null
1c0695
+++ b/t/leaks.t
1c0695
@@ -0,0 +1,34 @@
1c0695
+#!./perl
1c0695
+
1c0695
+use Test::More;
1c0695
+use Storable ();
1c0695
+BEGIN {
1c0695
+eval "use Test::LeakTrace";
1c0695
+plan 'skip_all' => 'Test::LeakTrace required for this tests' if $@;
1c0695
+}
1c0695
+plan 'tests' => 1;
1c0695
+
1c0695
+{
1c0695
+    my $c = My::Simple->new;
1c0695
+    my $d;
1c0695
+    my $freezed = Storable::freeze($c);
1c0695
+    no_leaks_ok
1c0695
+    {
1c0695
+        $d = Storable::thaw($freezed);
1c0695
+        undef $d;
1c0695
+    };
1c0695
+
1c0695
+    package My::Simple;
1c0695
+    sub new {
1c0695
+        my ($class, $arg) = @_;
1c0695
+        bless {t=>$arg}, $class;
1c0695
+    }
1c0695
+    sub STORABLE_freeze {
1c0695
+        return "abcderfgh";
1c0695
+    }
1c0695
+    sub STORABLE_attach {
1c0695
+        my ($class, $c, $serialized) = @_;
1c0695
+        return $class->new($serialized);
1c0695
+    }
1c0695
+}
1c0695
+
1c0695
diff --git a/t/tied_store.t b/t/tied_store.t
1c0695
new file mode 100644
1c0695
index 0000000..c657f95
1c0695
--- /dev/null
1c0695
+++ b/t/tied_store.t
1c0695
@@ -0,0 +1,64 @@
1c0695
+#!./perl
1c0695
+
1c0695
+sub BEGIN {
1c0695
+    unshift @INC, 't';
1c0695
+    unshift @INC, 't/compat' if $] < 5.006002;
1c0695
+    require Config; import Config;
1c0695
+    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
1c0695
+        print "1..0 # Skip: Storable was not built\n";
1c0695
+        exit 0;
1c0695
+    }
1c0695
+}
1c0695
+
1c0695
+use Storable ();
1c0695
+use Test::More tests => 3;
1c0695
+
1c0695
+our $f;
1c0695
+
1c0695
+package TIED_HASH;
1c0695
+
1c0695
+sub TIEHASH { bless({}, $_[0]) }
1c0695
+
1c0695
+sub STORE {
1c0695
+	$f = Storable::freeze(\$_[2]);
1c0695
+	1;
1c0695
+}
1c0695
+
1c0695
+package TIED_ARRAY;
1c0695
+
1c0695
+sub TIEARRAY { bless({}, $_[0]) }
1c0695
+
1c0695
+sub STORE {
1c0695
+	$f = Storable::freeze(\$_[2]);
1c0695
+	1;
1c0695
+}
1c0695
+
1c0695
+package TIED_SCALAR;
1c0695
+
1c0695
+sub TIESCALAR { bless({}, $_[0]) }
1c0695
+
1c0695
+sub STORE {
1c0695
+	$f = Storable::freeze(\$_[1]);
1c0695
+	1;
1c0695
+}
1c0695
+
1c0695
+package main;
1c0695
+
1c0695
+my($s, @a, %h);
1c0695
+tie $s, "TIED_SCALAR";
1c0695
+tie @a, "TIED_ARRAY";
1c0695
+tie %h, "TIED_HASH";
1c0695
+
1c0695
+$f = undef;
1c0695
+$s = 111;
1c0695
+is $f, Storable::freeze(\111);
1c0695
+
1c0695
+$f = undef;
1c0695
+$a[3] = 222;
1c0695
+is $f, Storable::freeze(\222);
1c0695
+
1c0695
+$f = undef;
1c0695
+$h{foo} = 333;
1c0695
+is $f, Storable::freeze(\333);
1c0695
+
1c0695
+1;
1c0695
diff --git a/t/utf8.t b/t/utf8.t
1c0695
index fd20ef6..a8dd6cd 100644
1c0695
--- a/t/utf8.t
1c0695
+++ b/t/utf8.t
1c0695
@@ -32,8 +32,10 @@ is($x, ${thaw freeze \$x});
1c0695
 $x = join '', map {chr $_} (0..1023);
1c0695
 is($x, ${thaw freeze \$x});
1c0695
 
1c0695
-# Char in the range 127-255 (probably) in utf8
1c0695
-$x = chr (175) . chr (256);
1c0695
+# Char in the range 127-255 (probably) in utf8.  This just won't work for
1c0695
+# EBCDIC for early Perls.
1c0695
+$x = ($] lt 5.007_003) ? chr(175) : chr(utf8::unicode_to_native(175))
1c0695
+   . chr (256);
1c0695
 chop $x;
1c0695
 is($x, ${thaw freeze \$x});
1c0695
 
1c0695
-- 
1c0695
2.1.0
1c0695