make new Storable tests forgiving of places where not built
[p5sagit/p5-mst-13.2.git] / t / lib / st-forgive.t
CommitLineData
7a6a85bf 1#!./perl
2
3# $Id: forgive.t,v 0.7.1.1 2000/08/03 22:04:45 ram Exp $
4#
5# Copyright (c) 1995-2000, Raphael Manfredi
6#
7# You may redistribute only under the terms of the Artistic License,
8# as specified in the README file that comes with the distribution.
9#
10# Original Author: Ulrich Pfeifer
11# (C) Copyright 1997, Universitat Dortmund, all rights reserved.
12#
13# $Log: forgive.t,v $
14# Revision 0.7.1.1 2000/08/03 22:04:45 ram
15# Baseline for second beta release.
16#
17# Revision 0.7 2000/08/03 22:04:45 ram
18# Baseline for second beta release.
19#
20
21sub BEGIN {
22 chdir('t') if -d 't';
9f233367 23 require Config; import Config;
24 if ($Config{'extensions'} !~ /\bStorable\b/) {
25 print "1..0 # Skip: Storable was not built\n";
26 exit 0;
27 }
7a6a85bf 28 unshift @INC, '../lib';
29}
30
31use Storable qw(store retrieve);
32
33print "1..8\n";
34
35my $test = 1;
36my $bad = ['foo', sub { 1 }, 'bar'];
37my $result;
38
39eval {$result = store ($bad , 'store')};
40print ((!defined $result)?"ok $test\n":"not ok $test\n"); $test++;
41print (($@ ne '')?"ok $test\n":"not ok $test\n"); $test++;
42
43$Storable::forgive_me=1;
44
45open(SAVEERR, ">&STDERR");
46open(STDERR, ">/dev/null") or
47 ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );
48
49eval {$result = store ($bad , 'store')};
50
51open(STDERR, ">&SAVEERR");
52
53print ((defined $result)?"ok $test\n":"not ok $test\n"); $test++;
54print (($@ eq '')?"ok $test\n":"not ok $test\n"); $test++;
55
56my $ret = retrieve('store');
57print ((defined $ret)?"ok $test\n":"not ok $test\n"); $test++;
58print (($ret->[0] eq 'foo')?"ok $test\n":"not ok $test\n"); $test++;
59print (($ret->[2] eq 'bar')?"ok $test\n":"not ok $test\n"); $test++;
60print ((ref $ret->[1] eq 'SCALAR')?"ok $test\n":"not ok $test\n"); $test++;
61
62
63END { unlink 'store' }