1#!./perl -w 2# 3# Copyright 2004, Larry Wall. 4# 5# You may redistribute only under the same terms as Perl 5, as specified 6# in the README file that comes with the distribution. 7# 8 9sub BEGIN { 10 # This lets us distribute Test::More in t/ 11 unshift @INC, 't'; 12 unshift @INC, 't/compat' if $] < 5.006002; 13 require Config; import Config; 14 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 15 print "1..0 # Skip: Storable was not built\n"; 16 exit 0; 17 } 18 if ($Config{extensions} !~ /\bList\/Util\b/) { 19 print "1..0 # Skip: List::Util was not built\n"; 20 exit 0; 21 } 22 23 require Scalar::Util; 24 Scalar::Util->import(qw(weaken isweak)); 25 if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) { 26 print("1..0 # Skip: No support for weaken in Scalar::Util\n"); 27 exit 0; 28 } 29} 30 31use Test::More 'no_plan'; 32use Storable qw (store retrieve freeze thaw nstore nfreeze dclone); 33require 'testlib.pl'; 34our $file; 35use strict; 36 37# $Storable::flags = Storable::FLAGS_COMPAT; 38 39sub tester { 40 my ($contents, $sub, $testersub, $what) = @_; 41 # Test that if we re-write it, everything still works: 42 my $clone = &$sub ($contents); 43 is ($@, "", "There should be no error extracting for $what"); 44 &$testersub ($clone, $what); 45} 46 47my $r = {}; 48my $s1 = [$r, $r]; 49weaken $s1->[1]; 50ok (isweak($s1->[1]), "element 1 is a weak reference"); 51 52my $s0 = [$r, $r]; 53weaken $s0->[0]; 54ok (isweak($s0->[0]), "element 0 is a weak reference"); 55 56my $w = [$r]; 57weaken $w->[0]; 58ok (isweak($w->[0]), "element 0 is a weak reference"); 59 60package OVERLOADED; 61 62use overload 63 '""' => sub { $_[0][0] }; 64 65package main; 66 67$a = bless [77], 'OVERLOADED'; 68 69my $o = [$a, $a]; 70weaken $o->[0]; 71ok (isweak($o->[0]), "element 0 is a weak reference"); 72 73my @tests = ( 74[$s1, 75 sub { 76 my ($clone, $what) = @_; 77 isa_ok($clone,'ARRAY'); 78 isa_ok($clone->[0],'HASH'); 79 isa_ok($clone->[1],'HASH'); 80 ok(!isweak $clone->[0], "Element 0 isn't weak"); 81 ok(isweak $clone->[1], "Element 1 is weak"); 82} 83], 84# The weak reference needs to hang around long enough for other stuff to 85# be able to make references to it. So try it second. 86[$s0, 87 sub { 88 my ($clone, $what) = @_; 89 isa_ok($clone,'ARRAY'); 90 isa_ok($clone->[0],'HASH'); 91 isa_ok($clone->[1],'HASH'); 92 ok(isweak $clone->[0], "Element 0 is weak"); 93 ok(!isweak $clone->[1], "Element 1 isn't weak"); 94} 95], 96[$w, 97 sub { 98 my ($clone, $what) = @_; 99 isa_ok($clone,'ARRAY'); 100 if ($what eq 'nothing') { 101 # We're the original, so we're still a weakref to a hash 102 isa_ok($clone->[0],'HASH'); 103 ok(isweak $clone->[0], "Element 0 is weak"); 104 } else { 105 is($clone->[0],undef); 106 } 107} 108], 109[$o, 110sub { 111 my ($clone, $what) = @_; 112 isa_ok($clone,'ARRAY'); 113 isa_ok($clone->[0],'OVERLOADED'); 114 isa_ok($clone->[1],'OVERLOADED'); 115 ok(isweak $clone->[0], "Element 0 is weak"); 116 ok(!isweak $clone->[1], "Element 1 isn't weak"); 117 is ("$clone->[0]", 77, "Element 0 stringifies to 77"); 118 is ("$clone->[1]", 77, "Element 1 stringifies to 77"); 119} 120], 121); 122 123foreach (@tests) { 124 my ($input, $testsub) = @$_; 125 126 tester($input, sub {return shift}, $testsub, 'nothing'); 127 128 ok (defined store($input, $file)); 129 130 # Read the contents into memory: 131 my $contents = slurp ($file); 132 133 tester($contents, \&store_and_retrieve, $testsub, 'file'); 134 135 # And now try almost everything again with a Storable string 136 my $stored = freeze $input; 137 tester($stored, \&freeze_and_thaw, $testsub, 'string'); 138 139 ok (defined nstore($input, $file)); 140 141 tester($contents, \&store_and_retrieve, $testsub, 'network file'); 142 143 $stored = nfreeze $input; 144 tester($stored, \&freeze_and_thaw, $testsub, 'network string'); 145} 146 147{ 148 # [perl #134179] sv_upgrade from type 7 down to type 1 149 my $foo = [qr//,[]]; 150 weaken($foo->[1][0][0] = $foo->[1]); 151 my $out = dclone($foo); # croaked here 152 is_deeply($out, $foo, "check they match"); 153} 154