The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!./perl

BEGIN {
    unshift @INC, 't/CORE/lib';
    require 't/CORE/test.pl';
}

eval q{ 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
# $test = undef; # this force the DESTROY method on compiled binary
EOC

$prog =~ s/\@\@\@\@/$filename/;

fresh_perl_is("require AnyDBM_File;\n$prog", 'ok', {}, 'explicit require');
# perlcc issue 208 - https://code.google.com/p/perl-compiler/issues/detail?id=208
fresh_perl_is($prog, 'ok', {}, 'implicit require');

$prog = <<'EOC';
$filename = '@@@@';
@INC = ();
dbmopen(%LT, $filename, 0666);
1 while unlink $filename;
1 while unlink glob "$filename.*";
die "Failed to fail!";
EOC

$prog =~ s/\@\@\@\@/$filename/;

# perlcc wontfix issue 226 - https://code.google.com/p/perl-compiler/issues/detail?id=226
# dbmopen is resolved at compile-time (require "AnyDBM_File.pm"), not run-time
# So this dbmopen error - can("TIEHASH") - does not trigger.
SKIP: {
  if (is_perlcc_compiled()) { # test if runnning compiled
    skip "wontfix issue 226 in perlcc";
  } else {
    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');