1#!./perl 2# 3# Copyright (c) 1995-2000, Raphael Manfredi 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# Original Author: Ulrich Pfeifer 9# (C) Copyright 1997, Universitat Dortmund, all rights reserved. 10# 11 12sub BEGIN { 13 unshift @INC, 't'; 14 unshift @INC, 't/compat' if $] < 5.006002; 15 require Config; import Config; 16 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 17 print "1..0 # Skip: Storable was not built\n"; 18 exit 0; 19 } 20} 21 22use Storable qw(store retrieve); 23use Test::More; 24 25# problems with 5.00404 when in an BEGIN block, so this is defined here 26if (!eval { require File::Spec; 1 } || $File::Spec::VERSION < 0.8) { 27 plan(skip_all => "File::Spec 0.8 needed"); 28 # Mention $File::Spec::VERSION again, as 5.00503's harness seems to have 29 # warnings on. 30 exit $File::Spec::VERSION; 31} 32 33plan(tests => 8); 34 35*GLOB = *GLOB; # peacify -w 36my $bad = ['foo', \*GLOB, 'bar']; 37my $result; 38 39eval {$result = store ($bad , "store$$")}; 40is($result, undef); 41isnt($@, ''); 42 43$Storable::forgive_me=1; 44 45my $devnull = File::Spec->devnull; 46 47open(SAVEERR, ">&STDERR"); 48open(STDERR, '>', $devnull) or 49 ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); 50 51eval {$result = store ($bad , "store$$")}; 52 53open(STDERR, ">&SAVEERR"); 54 55isnt($result, undef); 56is($@, ''); 57 58my $ret = retrieve("store$$"); 59isnt($ret, undef); 60is($ret->[0], 'foo'); 61is($ret->[2], 'bar'); 62is(ref $ret->[1], 'SCALAR'); 63 64 65END { 1 while unlink "store$$" } 66