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