In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/7c7df8124bbdd7a0091f8ed82589548c8182f624?hp=8cbe99e5b6fe99a6bc17c0b0cee249bac3565da4>
- Log ----------------------------------------------------------------- commit 7c7df8124bbdd7a0091f8ed82589548c8182f624 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 2 09:52:36 2010 -0800 Deprecate tie $handle without * M gv.h M pod/perldiag.pod M pp_sys.c M t/op/tie.t commit 6cd32d3b3481cbe3a38da6bbdf70e01ffe99d05a Author: Father Chrysostomos <[email protected]> Date: Thu Dec 2 09:38:02 2010 -0800 Fix up tests to work around tie $handle M t/op/gmagic.t M t/op/gv.t commit b029825916bf29623e00b45fa4226fab0d52d217 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 2 09:36:48 2010 -0800 Revert "[perl #77496] tied gets scalars and globs confused" This reverts commit 8752206e276cffe588c0932b5a9f2331640e8447. M pp_sys.c M t/op/tie.t commit 7850f4d6b732ab5f426cd3bcd9757c70a46cfda1 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 2 09:36:41 2010 -0800 Revert "[perl #77688] tie $scalar can tie a handle" This reverts commit 9aa8b00892d81bb5e94565d3cb9841dd57b7b9cf. M pp_sys.c M t/op/tie.t commit 84b9ac853508aaff52254b6cf2b95a2a6783ff00 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 2 09:36:35 2010 -0800 Revert "Make untie check the FAKE flag on globs" This reverts commit 830748013f81bcc28d145baf4024efd1b6537704. M pp_sys.c M t/op/tie.t ----------------------------------------------------------------------- Summary of changes: gv.h | 3 +++ pod/perldiag.pod | 12 ++++++++++++ pp_sys.c | 22 +++++++++++++++++++--- t/op/gmagic.t | 5 ++++- t/op/gv.t | 1 + t/op/tie.t | 52 +++++++++++++++++++++------------------------------- 6 files changed, 60 insertions(+), 35 deletions(-) diff --git a/gv.h b/gv.h index c61f2e6..ecea60d 100644 --- 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 --- 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 c3d0505..d27bde6 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -826,7 +826,11 @@ PP(pp_tie) break; case SVt_PVGV: case SVt_PVLV: - if (isGV_with_GP(varsv) && !SvFAKE(varsv)) { + 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) && !SvFAKE(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) && !SvFAKE(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/gmagic.t b/t/op/gmagic.t index bc8a926..850f50d 100644 --- a/t/op/gmagic.t +++ b/t/op/gmagic.t @@ -10,10 +10,11 @@ print "1..24\n"; my $t = 1; tie my $c => 'Tie::Monitor'; +my $tied_to; sub ok { my($ok, $got, $exp, $rexp, $wexp) = @_; - my($rgot, $wgot) = (tied $c)->init(0); + my($rgot, $wgot) = ($tied_to || tied $c)->init(0); print $ok ? "ok $t\n" : "# expected $exp, got $got\nnot ok $t\n"; ++$t; if ($rexp == $rgot && $wexp == $wgot) { @@ -56,9 +57,11 @@ ok_string($s, '0', 1, 1); # Assignment should not ignore magic when the last thing assigned # was a glob +$tied_to = tied $c; $c = *strat; $s = $c; ok_string $s, *strat, 1, 1; +$tied_to = undef; # A plain *foo should not call get-magic on *foo. # This method of scalar-tying an immutable glob relies on details of the diff --git a/t/op/gv.t b/t/op/gv.t index 862a0cf..e9fde9d 100644 --- a/t/op/gv.t +++ b/t/op/gv.t @@ -825,6 +825,7 @@ pass('Can assign strings to typeglobs'); tie my $a, "thrext"; () = "$a"; # do a fetch; now $a holds a glob eval { *$a = sub{} }; + eval { $a = undef }; # workaround for untie($handle) bug untie $a; eval { $a = "bar" }; ::is $a, "bar", diff --git a/t/op/tie.t b/t/op/tie.t index 6bad251..b68102e 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -941,34 +941,24 @@ EXPECT Can't locate object method "TIEARRAY" via package "FOO" at - line 5. ######## -# tied() should still work on tied scalars after glob assignment -sub TIESCALAR {bless[]} -sub FETCH {*foo} -sub f::TIEHANDLE{bless[],f} -tie *foo, "f"; -tie $rin, ""; -[$rin]; # call FETCH -print ref tied $rin, "\n"; -print ref tied *$rin, "\n"; -EXPECT -main -f -######## - -# (un)tie $glob_copy vs (un)tie *$glob_copy -sub TIESCALAR { print "TIESCALAR\n"; bless [] } -sub TIEHANDLE{ print "TIEHANDLE\n"; bless [] } -sub FETCH { print "never called\n" } -$f = *foo; -tie *$f, ""; -tie $f, ""; -untie $f; -print "ok 1\n" if !tied $f; -() = $f; # should not call FETCH -untie *$f; -print "ok 2\n" if !tied *foo; -EXPECT -TIEHANDLE -TIESCALAR -ok 1 -ok 2 +# 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 -- Perl5 Master Repository
