Commit | Line | Data |
37698ac1 |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't'; |
5 | @INC = '../lib'; |
6 | require './test.pl'; |
7 | |
8 | eval { require AnyDBM_File }; # not all places have dbm* functions |
eb5a2f3c |
9 | skip_all("No dbm functions") if $@; |
37698ac1 |
10 | } |
11 | |
12 | plan tests => 4; |
13 | |
14 | # This is [20020104.007] "coredump on dbmclose" |
15 | |
16 | my $prog = <<'EOC'; |
17 | package Foo; |
18 | sub new { |
19 | my $proto = shift; |
20 | my $class = ref($proto) || $proto; |
21 | my $self = {}; |
22 | bless($self,$class); |
23 | my %LT; |
24 | dbmopen(%LT, "dbmtest", 0666) || |
25 | die "Can't open dbmtest because of $!\n"; |
26 | $self->{'LT'} = \%LT; |
27 | return $self; |
28 | } |
29 | sub DESTROY { |
30 | my $self = shift; |
31 | dbmclose(%{$self->{'LT'}}); |
32 | 1 while unlink 'dbmtest'; |
33 | 1 while unlink <dbmtest.*>; |
34 | print "ok\n"; |
35 | } |
36 | package main; |
37 | $test = Foo->new(); # must be package var |
38 | EOC |
39 | |
40 | fresh_perl_is("require AnyDBM_File;\n$prog", 'ok', {}, 'explict require'); |
41 | fresh_perl_is($prog, 'ok', {}, 'implicit require'); |
42 | |
43 | $prog = <<'EOC'; |
44 | @INC = (); |
45 | dbmopen(%LT, "dbmtest", 0666); |
46 | 1 while unlink 'dbmtest'; |
47 | 1 while unlink <dbmtest.*>; |
48 | die "Failed to fail!"; |
49 | EOC |
50 | |
51 | fresh_perl_like($prog, qr/No dbm on this machine/, {}, |
52 | 'implicit require fails'); |
53 | fresh_perl_like('delete $::{"AnyDBM_File::"}; ' . $prog, |
54 | qr/No dbm on this machine/, {}, |
55 | 'implicit require and no stash fails'); |