Test dbmopen more thoroughly, including closing the coverage hole for

the code that automatically requires AnyDBM_File.pm in pp_dbmopen.

p4raw-id: //depot/perl@33705

2 files changed, 55 insertions, 30 deletions

diff --git a/t/op/dbm.t b/t/op/dbm.t
new file mode 100644
index 0000000000..5c552ac7a6
--- /dev/null
+++ b/t/op/dbm.t
@@ -0,0 +1,55 @@
+#!./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 $prog = <<'EOC';
+package Foo;
+sub new {
+        my $proto = shift;
+        my $class = ref($proto) || $proto;
+        my $self  = {};
+        bless($self,$class);
+        my %LT;
+        dbmopen(%LT, "dbmtest", 0666) ||
+	    die "Can't open dbmtest because of $!\n";
+        $self->{'LT'} = \%LT;
+        return $self;
+}
+sub DESTROY {
+        my $self = shift;
+	dbmclose(%{$self->{'LT'}});
+	1 while unlink 'dbmtest';
+	1 while unlink <dbmtest.*>;
+	print "ok\n";
+}
+package main;
+$test = Foo->new(); # must be package var
+EOC
+
+fresh_perl_is("require AnyDBM_File;\n$prog", 'ok', {}, 'explict require');
+fresh_perl_is($prog, 'ok', {}, 'implicit require');
+
+$prog = <<'EOC';
+@INC = ();
+dbmopen(%LT, "dbmtest", 0666);
+1 while unlink 'dbmtest';
+1 while unlink <dbmtest.*>;
+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');
diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t
index b906285514..a67f47ee9a 100644
--- a/t/run/fresh_perl.t
+++ b/t/run/fresh_perl.t
@@ -716,36 +716,6 @@ ok
 print join '', @a, "\n";
 EXPECT
 123456789
-######## [ID 20020104.007] "coredump on dbmclose"
-package Foo;
-eval { require AnyDBM_File }; # not all places have dbm* functions
-if ($@) {
-    print "ok\n";
-    exit 0;
-}
-package Foo;
-sub new {
-        my $proto = shift;
-        my $class = ref($proto) || $proto;
-        my $self  = {};
-        bless($self,$class);
-        my %LT;
-        dbmopen(%LT, "dbmtest", 0666) ||
-	    die "Can't open dbmtest because of $!\n";
-        $self->{'LT'} = \%LT;
-        return $self;
-}
-sub DESTROY {
-        my $self = shift;
-	dbmclose(%{$self->{'LT'}});
-	1 while unlink 'dbmtest';
-	1 while unlink <dbmtest.*>;
-	print "ok\n";
-}
-package main;
-$test = Foo->new(); # must be package var
-EXPECT
-ok
 ######## example from Camel 5, ch. 15, pp.406 (with my)
 # SKIP: ord "A" == 193 # EBCDIC
 use strict;