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 if ($ENV{PERL_CORE}){ 14 chdir('t') if -d 't'; 15 @INC = ('.', '../lib'); 16 } else { 17 unshift @INC, 't'; 18 } 19 require Config; import Config; 20 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { 21 print "1..0 # Skip: Storable was not built\n"; 22 exit 0; 23 } 24} 25 26use Storable qw(store retrieve); 27 28# problems with 5.00404 when in an BEGIN block, so this is defined here 29if (!eval { require File::Spec; 1 } || $File::Spec::VERSION < 0.8) { 30 print "1..0 # Skip: File::Spec 0.8 needed\n"; 31 exit 0; 32 # Mention $File::Spec::VERSION again, as 5.00503's harness seems to have 33 # warnings on. 34 exit $File::Spec::VERSION; 35} 36 37print "1..8\n"; 38 39my $test = 1; 40*GLOB = *GLOB; # peacify -w 41my $bad = ['foo', \*GLOB, 'bar']; 42my $result; 43 44eval {$result = store ($bad , 'store')}; 45print ((!defined $result)?"ok $test\n":"not ok $test\n"); $test++; 46print (($@ ne '')?"ok $test\n":"not ok $test\n"); $test++; 47 48$Storable::forgive_me=1; 49 50my $devnull = File::Spec->devnull; 51 52open(SAVEERR, ">&STDERR"); 53open(STDERR, ">$devnull") or 54 ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); 55 56eval {$result = store ($bad , 'store')}; 57 58open(STDERR, ">&SAVEERR"); 59 60print ((defined $result)?"ok $test\n":"not ok $test\n"); $test++; 61print (($@ eq '')?"ok $test\n":"not ok $test\n"); $test++; 62 63my $ret = retrieve('store'); 64print ((defined $ret)?"ok $test\n":"not ok $test\n"); $test++; 65print (($ret->[0] eq 'foo')?"ok $test\n":"not ok $test\n"); $test++; 66print (($ret->[2] eq 'bar')?"ok $test\n":"not ok $test\n"); $test++; 67print ((ref $ret->[1] eq 'SCALAR')?"ok $test\n":"not ok $test\n"); $test++; 68 69 70END { 1 while unlink 'store' } 71