Change 33705: Test dbmopen more thoroughly, including closing the coverage hole for

Change 33705 by nicholas@nicholas-saigo on 2008/04/17 12:44:56

	Test dbmopen more thoroughly, including closing the coverage hole for
	the code that automatically requires AnyDBM_File.pm in pp_dbmopen.

Affected files ...

... //depot/perl/MANIFEST#1696 edit
... //depot/perl/t/op/dbm.t#1 add
... //depot/perl/t/run/fresh_perl.t#35 edit

Differences ...

==== //depot/perl/MANIFEST#1696 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1695~33692~	2008-04-15 08:04:29.000000000 -0700
+++ perl/MANIFEST	2008-04-17 05:44:56.000000000 -0700
@@ -3861,6 +3861,7 @@
 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

==== //depot/perl/t/op/dbm.t#1 (text) ====
Index: perl/t/op/dbm.t
--- /dev/null	2008-03-18 12:45:05.529577733 -0700
+++ perl/t/op/dbm.t	2008-04-17 05:44:56.000000000 -0700
@@ -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');

==== //depot/perl/t/run/fresh_perl.t#35 (text) ====
Index: perl/t/run/fresh_perl.t
--- perl/t/run/fresh_perl.t#34~28550~	2006-07-11 23:53:22.000000000 -0700
+++ perl/t/run/fresh_perl.t	2008-04-17 05:44:56.000000000 -0700
@@ -716,36 +716,6 @@
 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;
End of Patch.

• Change 33705: Test dbmopen more thoroughly, including closing the coverage hole for by Nicholas Clark