Front page | perl.perl5.porters |
Postings from May 2002
Re: [PATCH] Re: perl@16433
From:
Jarkko Hietaniemi
Date:
May 8, 2002 16:40
Subject:
Re: [PATCH] Re: perl@16433
Message ID:
20020509024050.W12565@alpha.hut.fi
On Wed, May 08, 2002 at 10:16:42AM -0700, Yitzchak Scott-Thoennes wrote:
> 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??
Weird. Why I removed is that I *thought* I had applied the sv.c
patch this morning and all tests were succeeding. But I obviously
did not apply it. Maybe there was something was funny in my coffee.
> 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
Thanks.
> 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.
--
$jhi++; # http://www.iki.fi/jhi/
# There is this special biologist word we use for 'stable'.
# It is 'dead'. -- Jack Cohen