Merge branch 'tie-scalar' into blead

2 files changed, 62 insertions, 5 deletions

diff --git a/lib/Tie/Scalar.pm b/lib/Tie/Scalar.pm
index 9bf03f9105..24e4ae79c3 100644
--- a/lib/Tie/Scalar.pm
+++ b/lib/Tie/Scalar.pm
@@ -1,6 +1,6 @@
 package Tie::Scalar;
 
-our $VERSION = '1.01';
+our $VERSION = '1.02';
 
 =head1 NAME
 
@@ -73,6 +73,18 @@ destruction of an instance.
 
 =back
 
+=head2 Tie::Scalar vs Tie::StdScalar
+
+C<< Tie::Scalar >> provides all the necessary methods, but one should realize
+they do not do anything useful. Calling C<< Tie::Scalar::FETCH >> or 
+C<< Tie::Scalar::STORE >> results in a (trappable) croak. And if you inherit
+from C<< Tie::Scalar >>, you I<must> provide either a C<< new >> or a
+C<< TIESCALAR >> method. 
+
+If you are looking for a class that does everything for you you don't
+define yourself, use the C<< Tie::StdScalar >> class, not the
+C<< Tie::Scalar >> one.
+
 =head1 MORE INFORMATION
 
 The L<perltie> section uses a good example of tying scalars by associating
@@ -92,9 +104,20 @@ sub new {
 
 sub TIESCALAR {
     my $pkg = shift;
-	if ($pkg->can('new') and $pkg ne __PACKAGE__) {
-	warnings::warnif("WARNING: calling ${pkg}->new since ${pkg}->TIESCALAR 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 TIESCALAR() or a new() method";
+        }
+
+	warnings::warnif ("WARNING: calling ${pkg}->new since " .
+                          "${pkg}->TIESCALAR is missing");
+	$pkg -> new (@_);
     }
     else {
 	croak "$pkg doesn't define a TIESCALAR method";
diff --git a/lib/Tie/Scalar.t b/lib/Tie/Scalar.t
index 3c5d9b6146..fb33ca13cb 100644
--- a/lib/Tie/Scalar.t
+++ b/lib/Tie/Scalar.t
@@ -17,7 +17,7 @@ sub new { 'Fooled you.' }
 package main;
 
 use vars qw( $flag );
-use Test::More tests => 13;
+use Test::More tests => 16;
 
 use_ok( 'Tie::Scalar' );
 
@@ -74,3 +74,37 @@ sub new {
 sub DESTROY {
 	$main::flag = 1;
 }
+
+
+#
+# Bug #72878: don't recurse forever if both new and TIESCALAR are missing.
+#
+package main;
+
+@NoMethods::ISA = qw [Tie::Scalar];
+
+eval {tie my $foo => "NoMethods"};
+
+like $@ =>
+    qr /\QNoMethods must define either a TIESCALAR() or a new() method/,
+    "croaks if both new() and TIESCALAR() are missing";
+
+#
+# Don't croak on missing new/TIESCALAR if you're inheriting one.
+#
+my $called1 = 0;
+my $called2 = 0;
+
+sub HasMethod1::new {$called1 ++}
+   @HasMethod1::ISA        = qw [Tie::Scalar];
+   @InheritHasMethod1::ISA = qw [HasMethod1];
+
+sub HasMethod2::TIESCALAR {$called2 ++}
+   @HasMethod2::ISA        = qw [Tie::Scalar];
+   @InheritHasMethod2::ISA = qw [HasMethod2];
+
+my $r1 = eval {tie my $foo => "InheritHasMethod1"; 1};
+my $r2 = eval {tie my $foo => "InheritHasMethod2"; 1};
+
+ok $r1 && $called1, "inheriting new() does not croak";
+ok $r2 && $called2, "inheriting TIESCALAR() does not croak";