diff options
| -rw-r--r-- | gv.h | 3 | ||||
| -rw-r--r-- | pod/perldiag.pod | 12 | ||||
| -rw-r--r-- | pp_sys.c | 20 | ||||
| -rw-r--r-- | t/op/tie.t | 23 |
4 files changed, 56 insertions, 2 deletions
@@ -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 b099633e48..aa1f5c4d72 100644 --- 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 @@ -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 6e52a6e043..b68102e3b3 100644 --- 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 |