develooper Front page | perl.perl5.porters | Postings from May 2002

Re: [PATCH] Re: perl@16433

Thread Previous | Thread Next
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

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About