From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 17 Apr 2008 12:44:56 +0000 (+0000)
Subject: Test dbmopen more thoroughly, including closing the coverage hole for
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=37698ac13e6c088d690d4d7ee5635c83f340f956;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
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
--- 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;