This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Document string- and number-specific bitops in perlop
[perl5.git] / dist / Storable / t / forgive.t
CommitLineData
7a6a85bf 1#!./perl
7a6a85bf
RG
2#
3# Copyright (c) 1995-2000, Raphael Manfredi
4#
9e21b3d0
JH
5# You may redistribute only under the same terms as Perl 5, as specified
6# in the README file that comes with the distribution.
7a6a85bf
RG
7#
8# Original Author: Ulrich Pfeifer
9# (C) Copyright 1997, Universitat Dortmund, all rights reserved.
10#
7a6a85bf
RG
11
12sub BEGIN {
48c887dd 13 unshift @INC, 't';
1afdebce 14 unshift @INC, 't/compat' if $] < 5.006002;
9f233367 15 require Config; import Config;
0c384302 16 if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
9f233367
PP
17 print "1..0 # Skip: Storable was not built\n";
18 exit 0;
19 }
7a6a85bf
RG
20}
21
22use Storable qw(store retrieve);
dddb60fc 23use Test::More;
372cb964 24
197b90bc 25# problems with 5.00404 when in an BEGIN block, so this is defined here
87baa35a 26if (!eval { require File::Spec; 1 } || $File::Spec::VERSION < 0.8) {
dddb60fc 27 plan(skip_all => "File::Spec 0.8 needed");
a2307be4
NC
28 # Mention $File::Spec::VERSION again, as 5.00503's harness seems to have
29 # warnings on.
30 exit $File::Spec::VERSION;
197b90bc 31}
7a6a85bf 32
dddb60fc 33plan(tests => 8);
7a6a85bf 34
464b080a
SR
35*GLOB = *GLOB; # peacify -w
36my $bad = ['foo', \*GLOB, 'bar'];
7a6a85bf
RG
37my $result;
38
39eval {$result = store ($bad , 'store')};
dddb60fc
NC
40is($result, undef);
41isnt($@, '');
7a6a85bf
RG
42
43$Storable::forgive_me=1;
44
29fc1735
JH
45my $devnull = File::Spec->devnull;
46
7a6a85bf 47open(SAVEERR, ">&STDERR");
f42118b2 48open(STDERR, ">$devnull") or
7a6a85bf
RG
49 ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
50
51eval {$result = store ($bad , 'store')};
52
53open(STDERR, ">&SAVEERR");
54
dddb60fc
NC
55isnt($result, undef);
56is($@, '');
7a6a85bf
RG
57
58my $ret = retrieve('store');
dddb60fc
NC
59isnt($ret, undef);
60is($ret->[0], 'foo');
61is($ret->[2], 'bar');
62is(ref $ret->[1], 'SCALAR');
7a6a85bf
RG
63
64
29fc1735 65END { 1 while unlink 'store' }