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 | |
1c25d394 |
16 | my $filename = tempfile(); |
17 | |
37698ac1 |
18 | my $prog = <<'EOC'; |
19 | package Foo; |
1c25d394 |
20 | $filename = '@@@@'; |
37698ac1 |
21 | sub new { |
22 | my $proto = shift; |
23 | my $class = ref($proto) || $proto; |
24 | my $self = {}; |
25 | bless($self,$class); |
26 | my %LT; |
1c25d394 |
27 | dbmopen(%LT, $filename, 0666) || |
28 | die "Can't open $filename because of $!\n"; |
37698ac1 |
29 | $self->{'LT'} = \%LT; |
30 | return $self; |
31 | } |
32 | sub DESTROY { |
33 | my $self = shift; |
34 | dbmclose(%{$self->{'LT'}}); |
1c25d394 |
35 | 1 while unlink $filename; |
36 | 1 while unlink glob "$filename.*"; |
37698ac1 |
37 | print "ok\n"; |
38 | } |
39 | package main; |
40 | $test = Foo->new(); # must be package var |
41 | EOC |
42 | |
1c25d394 |
43 | $prog =~ s/\@\@\@\@/$filename/; |
44 | |
37698ac1 |
45 | fresh_perl_is("require AnyDBM_File;\n$prog", 'ok', {}, 'explict require'); |
46 | fresh_perl_is($prog, 'ok', {}, 'implicit require'); |
47 | |
48 | $prog = <<'EOC'; |
49 | @INC = (); |
1c25d394 |
50 | dbmopen(%LT, $filename, 0666); |
51 | 1 while unlink $filename; |
52 | 1 while unlink glob "$filename.*"; |
37698ac1 |
53 | die "Failed to fail!"; |
54 | EOC |
55 | |
56 | fresh_perl_like($prog, qr/No dbm on this machine/, {}, |
57 | 'implicit require fails'); |
58 | fresh_perl_like('delete $::{"AnyDBM_File::"}; ' . $prog, |
59 | qr/No dbm on this machine/, {}, |
60 | 'implicit require and no stash fails'); |