diff options
| author | Ævar Arnfjörð Bjarmason <avar@cpan.org> | 2007-05-01 21:06:47 +0000 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-05-02 12:17:22 +0000 |
| commit | 22846ab4665d8b0497bab48ce4cd23d9c17b64e5 (patch) | |
| tree | ebe212eb5cb4a6126961d8e4ec9c4814da98b869 /t/op/tiearray.t | |
| parent | 08ea85ebb7e662ede09f8aeca53b33a16b8e6a1e (diff) | |
| download | perl-22846ab4665d8b0497bab48ce4cd23d9c17b64e5.tar.gz | |
When FETCHSIZE returns <0 perl segfaults
From: "Ævar Arnfjörð Bjarmason" <avarab@gmail.com>
Message-ID: <51dd1af80705011406j7897772bm58e9c770183ef3ed@mail.gmail.com>
p4raw-id: //depot/perl@31116
Diffstat (limited to 't/op/tiearray.t')
| -rwxr-xr-x | t/op/tiearray.t | 21 |
1 files changed, 20 insertions, 1 deletions
diff --git a/t/op/tiearray.t b/t/op/tiearray.t index e7b547bcd9..5ef6bfbdd4 100755 --- a/t/op/tiearray.t +++ b/t/op/tiearray.t @@ -134,9 +134,20 @@ sub EXISTS { exists $ob->[$id]; } +# +# Returning -1 from FETCHSIZE used to get casted to U32 causing a +# segfault +# + +package NegFetchsize; + +sub TIEARRAY { bless [] } +sub FETCH { } +sub FETCHSIZE { -1 } + package main; -print "1..61\n"; +print "1..62\n"; my $test = 1; {my @ary; @@ -324,6 +335,14 @@ untie @ary; +{ + tie my @dummy, "NegFetchsize"; + eval { "@dummy"; }; + print "# $@" if $@; + print "not " unless $@ =~ /^FETCHSIZE returned a negative value/; + print "ok ", $test++, " - croak on negative FETCHSIZE\n"; +} + print "not " unless $seen{'DESTROY'} == 3; print "ok ", $test++,"\n"; |