In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/074ededac3b0d3c126e0affff0c86afc1257e665?hp=894d1dc6f7f68cbf514cad5a67cdfac31fedf4ec>
- Log -----------------------------------------------------------------
commit 074ededac3b0d3c126e0affff0c86afc1257e665
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri May 13 08:32:24 2011 -0700
Remove another bug workaround
M t/op/gmagic.t
commit 0e6309a848b5521a7f632fa9e4e49ba8dc4ac705
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri May 13 08:31:16 2011 -0700
Remove workaround for fixed bug
M t/op/gv.t
commit ca0d4ed9074a1f098ee5b72a8ddd05c500b180de
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri May 13 08:30:50 2011 -0700
Revert "Revert "Make untie check the FAKE flag on globs""
This reverts commit 84b9ac853508aaff52254b6cf2b95a2a6783ff00.
M pp_sys.c
M t/op/tie.t
commit 8bb5f78688d9af260b13d9c9ba5dd28f01f846ec
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri May 13 08:30:25 2011 -0700
Revert "Revert "[perl #77688] tie $scalar can tie a handle""
This reverts commit 7850f4d6b732ab5f426cd3bcd9757c70a46cfda1.
M pp_sys.c
M t/op/tie.t
commit 4be76e1f2b4f53b080616615372a4ebaff876c87
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri May 13 08:29:42 2011 -0700
Revert "Revert "[perl #77496] tied gets scalars and globs confused""
This reverts commit b029825916bf29623e00b45fa4226fab0d52d217.
M pp_sys.c
M t/op/tie.t
commit 68ef19bb9eb24fa24f8c7ecfd08a99a0f2831d28
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri May 13 08:24:16 2011 -0700
Revert âDeprecate tie $handle without *â
This reverts commit 7c7df8124bbdd7a0091f8ed82589548c8182f624,
except for the perldiag entry, which we still need for splainâs sake.
M gv.h
M pp_sys.c
M t/op/tie.t
-----------------------------------------------------------------------
Summary of changes:
gv.h | 3 ---
pp_sys.c | 22 +++-------------------
t/op/gmagic.t | 5 ++---
t/op/gv.t | 1 -
t/op/tie.t | 56 +++++++++++++++++++++++++++++++++-----------------------
5 files changed, 38 insertions(+), 49 deletions(-)
diff --git a/gv.h b/gv.h
index ab5c788..a70a906 100644
--- a/gv.h
+++ b/gv.h
@@ -145,9 +145,6 @@ 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/pp_sys.c b/pp_sys.c
index aa74cef..106a443 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -836,11 +836,7 @@ PP(pp_tie)
break;
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;
- }
+ if (isGV_with_GP(varsv) && !SvFAKE(varsv)) {
methname = "TIEHANDLE";
how = PERL_MAGIC_tiedscalar;
/* For tied filehandles, we apply tiedscalar magic to the IO
@@ -917,14 +913,8 @@ 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)) {
- if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
- deprecate("untie on a handle without *");
- GvFLAGS(sv) |= GVf_TIEWARNED;
- }
- if (!(sv = MUTABLE_SV(GvIOp(sv))))
+ if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
RETPUSHYES;
- }
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
@@ -961,14 +951,8 @@ 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)) {
- if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
- deprecate("tied on a handle without *");
- GvFLAGS(sv) |= GVf_TIEWARNED;
- }
- if (!(sv = MUTABLE_SV(GvIOp(sv))))
+ if (isGV_with_GP(sv) && !SvFAKE(sv) && !(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 6901609..8437695 100644
--- a/t/op/gmagic.t
+++ b/t/op/gmagic.t
@@ -51,12 +51,11 @@ ok($s eq '0', 'multiple magic in core functions');
expected_tie_calls(tied $c, 1, 1);
# was a glob
-my $tied_to = tied $c;
$c = *strat;
$s = $c;
ok($s eq *strat,
'Assignment should not ignore magic when the last thing assigned was a
glob');
-expected_tie_calls($tied_to, 1, 1);
+expected_tie_calls(tied $c, 1, 1);
# A plain *foo should not call get-magic on *foo.
# This method of scalar-tying an immutable glob relies on details of the
@@ -71,7 +70,7 @@ ok($wgot == 0, 'a plain *foo causes no set-magic');
# get-magic when exiting a non-lvalue sub in potentially autovivify-
# ing context
-$tied_to = tie $_{elem}, "Tie::Monitor";
+my $tied_to = tie $_{elem}, "Tie::Monitor";
eval { () = sub { delete $_{elem} }->()->[3] };
ok +($tied_to->init)[0],
'get-magic is called on mortal magic var on sub exit in autoviv context';
diff --git a/t/op/gv.t b/t/op/gv.t
index f796232..c4570e3 100644
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -830,7 +830,6 @@ 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 0b53b14..a4f969a 100644
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -925,29 +925,6 @@ 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
-########
#
# STORE freeing tie'd AV
sub TIEARRAY { bless [] }
@@ -1030,3 +1007,36 @@ tie $x, "";
print "ok\n";
EXPECT
ok
+########
+
+# 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
--
Perl5 Master Repository
