Front page | perl.perl5.porters |
Postings from May 2002
Re: [PATCH] Re: perl@16433
From:
sthoenna
Date:
May 8, 2002 14:06
Subject:
Re: [PATCH] Re: perl@16433
Message ID:
61V28gzkg+jG092yn@efn.org
In article <cII28gzkgaOS092yn@efn.org>,
sthoenna@efn.org (Yitzchak Scott-Thoennes) wrote:
>In article <20020507061915.Z31692@alpha.hut.fi>,
>Jarkko Hietaniemi <jhi@iki.fi> wrote:
>>On Mon, May 06, 2002 at 08:01:10PM -0700, Yitzchak Scott-Thoennes wrote:
>>> In article <20020506175038.P31692@alpha.hut.fi>,
>>> Jarkko Hietaniemi <jhi@iki.fi> wrote:
>>> >- IO::Scalar 'inner references' problem [Yitzchak?]
>>>
>>> This isn't an IO::Scalar problem, it's a self-tie problem. Haven't
>>
>>Ooops, sorry, forgot to update the detail.
And now its gone completely??
>>
>>> had a lot of time to look at it, perhaps someone who knows something
>>> about self-ties could take a look? The change to the sv_magic call in
>>
>>Not me, sorry. All I did back then (AFAICR) was to put in
>>a stopgap for disabling self-ties until we figure out a solution--
>>maybe I shouldn't have, since then we seemingly forgot about it.
>>The simplest change would be to back out the stopgap changes, I think.
>
>That doesn't help. That was only one of the two things breaking self-tied
>globs.
>
>>
>>> broke self-tied globs (and I think scalars) one way; the change to tie
>>> the pvio not the pvgv broke self-tied globs another way. I think the
>>> fix will lie in adding additional non-refcounted cases to sv_magicext
>>> but am not sure that will work right for globs. And I haven't yet
>>> found the code that handled mg_obj for self-tied objects being Nullsv.
>
>Here's a fix (minimally tested...full build and tests are still running):
>
>--- sv.c.orig Mon May 6 11:50:00 2002
>+++ sv.c Tue May 7 17:52:12 2002
>@@ -4466,7 +4466,9 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj,
> (SvTYPE(obj) == SVt_PVGV &&
> (GvSV(obj) == sv || GvHV(obj) == (HV*)sv || GvAV(obj) == (AV*)sv ||
> GvCV(obj) == (CV*)sv || GvIOp(obj) == (IO*)sv ||
>- GvFORM(obj) == (CV*)sv)))
>+ GvFORM(obj) == (CV*)sv)) ||
>+ (how == PERL_MAGIC_tiedscalar &&
>+ SvROK(obj) && (SvRV(obj) == sv || GvIO(SvRV(obj)) == (IO*)sv)))
> {
> mg->mg_obj = obj;
> }
>End of Patch.
Passed all tests ok. While adding tests to op/tie.t I noticed
something that will delight your heart, Jarkko. The code in op/tie.t
was broken and was ignoring failures whenever either $expected or
$results were empty. (When $expected was empty, it was also leaving
'EXPECT' as the last line of the code to test :).) Fixed the test
code and added TODO capability. The following tests were failing (but
not reported as such):
test 14 "Forbidden aggregate self-ties":
This was broken. pp_tie was checking SvTYPE(sv) when it should
have checked SvTYPE(varsv). Patched.
test 15 "Allowed scalar self-ties":
Scalar self-ties were indeed broken, but this test seems to have
some errors too. Fixed it to simply check for proper refcounting. If
anyone can figure out what else it was supposed to test, let me know.
I added tests 16 and 17 to test glob and io self-ties. Without the
sv.c patch above, 15, 16, and 17 will all fail.
test 19 (was 17) "An attempt at lvalueable barewords broke this":
Test fails (and failed in 5.6.1 also), and I don't know anything
about it. TODO'd it for someone else to deal with.
--- t/op/tie.t.orig Mon May 6 11:50:12 2002
+++ t/op/tie.t Wed May 8 10:09:20 2002
@@ -16,24 +16,32 @@
$SIG{__DIE__} = sub { die @_ };
undef $/;
-@prgs = split "\n########\n", <DATA>;
+@prgs = split /^########\n/m, <DATA>;
print "1..", scalar @prgs, "\n";
for (@prgs){
- my($prog,$expected) = split(/\nEXPECT\n/, $_);
+ ++$i;
+ my($prog,$expected) = split(/\nEXPECT\n/, $_, 2);
+ print("not ok $i # bad test format\n"), next
+ unless defined $expected;
+ my ($testname) = $prog =~ /^(# .*)\n/;
+ $testname ||= '';
eval "$prog" ;
$status = $?;
$results = $@ ;
$results =~ s/\n+$//;
$expected =~ s/\n+$//;
- if ( $status or $results and $results !~ /^(WARNING: )?$expected/){
+ if ( $status || ($expected eq '') != ($results eq '') ||
+ $results !~ /^(WARNING: )?$expected/){
print STDERR "STATUS: $status\n";
print STDERR "PROG: $prog\n";
print STDERR "EXPECTED:\n$expected\n";
print STDERR "GOT:\n$results\n";
- print "not ";
+ print "not ok $i $testname\n";
+ }
+ else {
+ print "ok $i $testname\n";
}
- print "ok ", ++$i, "\n";
}
__END__
@@ -163,26 +171,47 @@
EXPECT
########
# Forbidden aggregate self-ties
-my ($a, $b) = (0, 0);
sub Self::TIEHASH { bless $_[1], $_[0] }
-sub Self::DESTROY { $b = $_[0] + 1; }
{
- my %c = 42;
+ my %c;
tie %c, 'Self', \%c;
}
EXPECT
Self-ties of arrays and hashes are not supported
########
# Allowed scalar self-ties
-my ($a, $b) = (0, 0);
+my $destroyed = 0;
sub Self::TIESCALAR { bless $_[1], $_[0] }
-sub Self::DESTROY { $b = $_[0] + 1; }
+sub Self::DESTROY { $destroyed = 1; }
{
my $c = 42;
- $a = $c + 0;
tie $c, 'Self', \$c;
}
-die unless $a == 0 && $b == 43;
+die "self-tied scalar not DESTROYd" unless $destroyed == 1;
+EXPECT
+########
+# Allowed glob self-ties
+my $destroyed = 0;
+sub Self2::TIEHANDLE { bless $_[1], $_[0] }
+sub Self2::DESTROY { $destroyed = 1; }
+{
+ use Symbol;
+ my $c = gensym;
+ tie *$c, 'Self2', $c;
+}
+die "self-tied glob not DESTROYd" unless $destroyed == 1;
+EXPECT
+########
+# Allowed IO self-ties
+my $destroyed = 0;
+sub Self3::TIEHANDLE { bless $_[1], $_[0] }
+sub Self3::DESTROY { $destroyed = 1; }
+{
+ use Symbol 'geniosym';
+ my $c = geniosym;
+ tie *$c, 'Self3', $c;
+}
+die "self-tied IO not DESTROYd" unless $destroyed == 1;
EXPECT
########
# Interaction of tie and vec
@@ -197,7 +226,7 @@
die unless $a eq $b;
EXPECT
########
-# An attempt at lvalueable barewords broke this
+# TODO An attempt at lvalueable barewords broke this
tie FH, 'main';
EXPECT
--- pp_sys.c.orig Mon May 6 11:50:08 2002
+++ pp_sys.c Tue May 7 23:34:34 2002
@@ -824,9 +824,7 @@ PP(pp_tie)
if (sv_isobject(sv)) {
sv_unmagic(varsv, how);
/* Croak if a self-tie on an aggregate is attempted. */
- if (varsv == SvRV(sv) &&
- (SvTYPE(sv) == SVt_PVAV ||
- SvTYPE(sv) == SVt_PVHV))
+ if (varsv == SvRV(sv) && how == PERL_MAGIC_tied)
Perl_croak(aTHX_
"Self-ties of arrays and hashes are not supported");
sv_magic(varsv, sv, how, Nullch, 0);
End of Patch.