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

diff --git a/MANIFEST b/MANIFEST
index 205d399..302c771 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3861,6 +3861,7 @@ t/op/cond.t                       See if conditional expressions work
 t/op/context.t                 See if context propagation works
 t/op/cproto.t                  Check builtin prototypes
 t/op/crypt.t                   See if crypt works
+t/op/dbm.t                     See if dbmopen/dbmclose work
 t/op/defins.t                  See if auto-insert of defined() works
 t/op/delete.t                  See if delete works
 t/op/die_exit.t                        See if die and exit status interaction works

diff --git a/t/op/dbm.t b/t/op/dbm.t
new file mode 100644 (file)
index 0000000..5c552ac
--- /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 b906285..a67f47e 100644 (file)
--- 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;