Stop Tie::Hash->TIEHASH() looping forever.

This change is analogous to bc3707112523ba7a in Tie::Scalar, but with far fewer
tests.

2 files changed, 28 insertions, 4 deletions

diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm
index 1ca8887e7e..1acd829c34 100644
--- a/lib/Tie/Hash.pm
+++ b/lib/Tie/Hash.pm
@@ -1,6 +1,6 @@
 package Tie::Hash;
 
-our $VERSION = '1.03';
+our $VERSION = '1.04';
 
 =head1 NAME
 
@@ -197,9 +197,20 @@ sub new {
 
 sub TIEHASH {
     my $pkg = shift;
-    if (defined &{"${pkg}::new"}) {
-	warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIEHASH is missing");
-	$pkg->new(@_);
+    my $pkg_new = $pkg -> can ('new');
+
+    if ($pkg_new and $pkg ne __PACKAGE__) {
+        my $my_new = __PACKAGE__ -> can ('new');
+        if ($pkg_new == $my_new) {  
+            #
+            # Prevent recursion
+            #
+            croak "$pkg must define either a TIEHASH() or a new() method";
+        }
+
+	warnings::warnif ("WARNING: calling ${pkg}->new since " .
+                          "${pkg}->TIEHASH is missing");
+	$pkg -> new (@_);
     }
     else {
 	croak "$pkg doesn't define a TIEHASH method";
diff --git a/lib/Tie/Hash.t b/lib/Tie/Hash.t
new file mode 100644
index 0000000000..70cafd3f06
--- /dev/null
+++ b/lib/Tie/Hash.t
@@ -0,0 +1,13 @@
+#!./perl
+
+# These tests are not complete. Patches welcome.
+
+use Test::More tests => 3;
+
+BEGIN {use_ok( 'Tie::Hash' )};
+
+# these are "abstract virtual" parent methods
+for my $method qw( TIEHASH EXISTS ) {
+	eval { Tie::Hash->$method() };
+	like( $@, qr/doesn't define an? $method/, "croaks on inherited $method()" );
+}