Deprecate tie $handle without *

diff --git a/gv.h b/gv.h
index c61f2e6..ecea60d 100644 (file)
--- a/gv.h
+++ b/gv.h
@@ -138,6 +138,9 @@ Return the SV from the GV.
 #define GVf_IMPORTED_HV          0x40
 #define GVf_IMPORTED_CV          0x80
 
+/* Temporary flag for the tie $handle deprecation warnings. */
+#define GVf_TIEWARNED  0x100
+
 #define GvINTRO(gv)            (GvFLAGS(gv) & GVf_INTRO)
 #define GvINTRO_on(gv)         (GvFLAGS(gv) |= GVf_INTRO)
 #define GvINTRO_off(gv)                (GvFLAGS(gv) &= ~GVf_INTRO)

diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index b099633..aa1f5c4 100644 (file)
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -5080,6 +5080,18 @@ only C.  This usually means there's a better way to do it in Perl.
 generally because there's a better way to do it, and also because the
 old way has bad side effects.
 
+=item Use of %s on a handle without * is deprecated
+
+(D deprecated) You used C<tie>, C<tied> or C<untie> on a scalar but that
+scalar happens to hold a typeglob, which means its filehandle will
+be tied. If you mean to tie a handle, use an explicit * as in
+C<tie *$handle>.
+
+This is a long-standing bug that will be removed in Perl 5.16, as
+there is currently no way to tie the scalar itself when it holds
+a typeglob, and no way to untie a scalar that has had a typeglob
+assigned to it.
+
 =item Use of -l on filehandle %s
 
 (W io) A filehandle represents an opened file, and when you opened the file

diff --git a/pp_sys.c b/pp_sys.c
index e068ec6..d27bde6 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -827,6 +827,10 @@ PP(pp_tie)
        case SVt_PVGV:
        case SVt_PVLV:
            if (isGV_with_GP(varsv)) {
+               if (SvFAKE(varsv) && !(GvFLAGS(varsv) & GVf_TIEWARNED)) {
+                   deprecate("tie on a handle without *");
+                   GvFLAGS(varsv) |= GVf_TIEWARNED;
+               }
                methname = "TIEHANDLE";
                how = PERL_MAGIC_tiedscalar;
                /* For tied filehandles, we apply tiedscalar magic to the IO
@@ -903,8 +907,14 @@ PP(pp_untie)
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
-    if (isGV_with_GP(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
+    if (isGV_with_GP(sv)) {
+      if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
+       deprecate("untie on a handle without *");
+       GvFLAGS(sv) |= GVf_TIEWARNED;
+      }
+      if (!(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHYES;
+    }
 
     if ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
@@ -941,8 +951,14 @@ PP(pp_tied)
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
-    if (isGV_with_GP(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
+    if (isGV_with_GP(sv)) {
+      if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
+       deprecate("tied on a handle without *");
+       GvFLAGS(sv) |= GVf_TIEWARNED;
+      }
+      if (!(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHUNDEF;
+    }
 
     if ((mg = SvTIED_mg(sv, how))) {
        SV *osv = SvTIED_obj(sv, mg);

diff --git a/t/op/tie.t b/t/op/tie.t
index 6e52a6e..b68102e 100644 (file)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -939,3 +939,26 @@ sub IO::File::TIEARRAY {
 fileno FOO; tie @a, "FOO"
 EXPECT
 Can't locate object method "TIEARRAY" via package "FOO" at - line 5.
+########
+
+# Deprecation warnings for tie $handle
+
+use warnings 'deprecated';
+$SIG{__WARN__} = sub { $w = shift };
+$handle = *foo;
+eval { tie $handle, "" };
+print $w =~ /^Use of tie on a handle without \* is deprecated/
+  ? "ok tie\n" : "$w\n";
+$handle = *bar;
+tied $handle;
+print $w =~ /^Use of tied on a handle without \* is deprecated/
+  ? "ok tied\n" : "$w\n";
+$handle = *baz;
+untie $handle;
+print $w =~ /^Use of untie on a handle without \* is deprecated/
+  ? "ok untie\n" : "$w\n";
+
+EXPECT
+ok tie
+ok tied
+ok untie