diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tie/Hash.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tie/Hash.pm | 19 |
1 files changed, 15 insertions, 4 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tie/Hash.pm b/Master/tlpkg/tlperl/lib/Tie/Hash.pm index 1ca8887e7e3..1acd829c347 100644 --- a/Master/tlpkg/tlperl/lib/Tie/Hash.pm +++ b/Master/tlpkg/tlperl/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"; |