From bcd8349faa085f3bc64b048e8b3d859f98742bb2 Mon Sep 17 00:00:00 2001 From: Stephen Oberholtzer Date: Mon, 17 Aug 2015 15:46:08 -0400 Subject: [PATCH 1/3] Fix error_code() reporting errors in Data::BitStream instead of caller error_code() uses 'confess' to raise errors from the perspective of the caller. However, that caller is always a component of Data::BitStream, so the result looks like this: invalid parameters: bits must be <= 64 at C:/Perl64/site/lib/Data/BitStream/WordVec.pm line 107. By including 'ref $self' in @CARP_NOT, the error message points to the correct location: invalid parameters: bits must be <= 64 at myscript.pl line 125. --- lib/Data/BitStream/Base.pm | 4 ++++ t/73-error-loc.t | 30 ++++++++++++++++++++++++++++++ 2 files changed, 34 insertions(+) create mode 100644 t/73-error-loc.t diff --git a/lib/Data/BitStream/Base.pm b/lib/Data/BitStream/Base.pm index 7abe20f..39b7dd1 100644 --- a/lib/Data/BitStream/Base.pm +++ b/lib/Data/BitStream/Base.pm @@ -2,6 +2,7 @@ package Data::BitStream::Base; use strict; use warnings; use Carp; +our @CARP_NOT; BEGIN { $Data::BitStream::Base::AUTHORITY = 'cpan:DANAJ'; $Data::BitStream::Base::VERSION = '0.08'; @@ -316,6 +317,7 @@ sub code_pos_is_set { sub error_off_stream { my $self = shift; my $skipping = shift; + local @CARP_NOT = (@CARP_NOT, ref($self)); # Give the skip error only if we were not reading a code. if ( (defined $skipping) && (@{$self->_code_pos_array} == 0) ) { @@ -329,6 +331,7 @@ sub error_off_stream { sub error_stream_mode { my $self = shift; my $type = shift; + local @CARP_NOT = (@CARP_NOT, ref($self)); my $codename = $self->_code_restore_pos(); $codename = " ($codename)" if $codename ne ''; @@ -351,6 +354,7 @@ sub error_code { my $self = shift; my $type = shift; my $text = shift; + local @CARP_NOT = (@CARP_NOT, ref($self)); if ($type eq 'zeroval') { # Implied text $type = 'value'; $text = 'value must be >= 0'; diff --git a/t/73-error-loc.t b/t/73-error-loc.t new file mode 100644 index 0000000..6e5b4c3 --- /dev/null +++ b/t/73-error-loc.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More tests => 5; +use Test::Exception; + +use Moo::Role qw/apply_roles_to_object/; + +my $error_regex = qr/error-loc\.t/; + +require_ok 'Data::BitStream'; + +my $dbs = new Data::BitStream(mode => 'ro'); + +throws_ok { $dbs->read($dbs->maxbits + 1) } $error_regex, 'read(maxbits + 1) should fail'; +note "Message: $@"; +throws_ok { $dbs->write(42, 8) } $error_regex, 'write to read-only should fail'; +note "Message: $@"; +throws_ok { $dbs->skip(-999999) } $error_regex, 'negative skip() should fail'; +note "Message: $@"; + +# I'm not certain if this is the correct behavior, but a read() returns undef +# if there are exactly zero bytes left in the stream +$dbs = new Data::BitStream(); +$dbs->from_raw("\x00"); +throws_ok { $dbs->read(32) } $error_regex, 'read past EOF should fail'; +note "Message: $@"; + +done_testing; From e94b24e2ae3ae084f6f0526d0fc51f837bdd5b1c Mon Sep 17 00:00:00 2001 From: Stephen Oberholtzer Date: Tue, 18 Aug 2015 14:22:29 -0400 Subject: [PATCH 2/3] Fix broken optimization in WordVec::to_raw WordVec::to_raw returns the raw internal buffer directly, which may not be correct in all cases, due to optimizations elsewhere. The two cases in particular are as follows: * write(N, 0) does not actually store N '0' bits in the buffer; instead, it simply increments the internal length indicator. As such, if the last write to the stream wrote a zero value, to_raw() may be shorter than it ought to be. * Other write operations increase the size by multiples of 32 bits. Therefore, the return value could be up to 3 bytes longer than it should have been. --- lib/Data/BitStream/WordVec.pm | 14 +++++++++++++- t/74-to-raw.t | 31 +++++++++++++++++++++++++++++++ 2 files changed, 44 insertions(+), 1 deletion(-) create mode 100644 t/74-to-raw.t diff --git a/lib/Data/BitStream/WordVec.pm b/lib/Data/BitStream/WordVec.pm index ef1f6fd..d80ffc9 100644 --- a/lib/Data/BitStream/WordVec.pm +++ b/lib/Data/BitStream/WordVec.pm @@ -396,7 +396,19 @@ sub to_raw { my $self = shift; $self->write_close; my $rvec = $self->_vecref; - return $$rvec; + my $byte_count = int(($self->len + 7) / 8); + # $$rvec may have more or fewer zeroes than is appropriate based on + # optimizations + return $$rvec if length($$rvec) == $byte_count; + if (length($$rvec) > $byte_count) { + # return only the first $byte_count bytes + return substr($$rvec, 0, $byte_count); + } else { + # a more complex case: there are some virtual '0' bits at the end + # we need to make them appear here + my $zeroes_needed = $byte_count - length($$rvec); + return $$rvec . ("\x00" x $zeroes_needed); + } } sub from_raw { diff --git a/t/74-to-raw.t b/t/74-to-raw.t new file mode 100644 index 0000000..5c66817 --- /dev/null +++ b/t/74-to-raw.t @@ -0,0 +1,31 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Test::More; + +use Moo::Role qw/apply_roles_to_object/; + +sub test_case(&); + +require_ok 'Data::BitStream'; + +my $dbs; + +# write a single '1' bit; the result should be 1 byte long. +test_case { $dbs->write(1, 1) }; +# write a single '1' bit; the result should be 1 byte long. +test_case { $dbs->write(1, 0) }; + +sub test_case(&) { + my ($sub) = @_; + $dbs = new Data::BitStream(); + $sub->($dbs); + my $bits = $dbs->len; + my $expected_length = int(($bits + 7) / 8); + my $raw_data = $dbs->to_raw(); + my $actual_length = length($raw_data); + is($actual_length, $expected_length, "Expecting $bits bits to take $expected_length bytes"); +} + +done_testing; From c82c8efa3f1c88e3084c84a49379989c742b745a Mon Sep 17 00:00:00 2001 From: Stephen Oberholtzer Date: Tue, 18 Aug 2015 14:43:08 -0400 Subject: [PATCH 3/3] Change 'new X' syntax to 'X->new' --- t/73-error-loc.t | 4 ++-- t/74-to-raw.t | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/t/73-error-loc.t b/t/73-error-loc.t index 6e5b4c3..7aa7298 100644 --- a/t/73-error-loc.t +++ b/t/73-error-loc.t @@ -11,7 +11,7 @@ my $error_regex = qr/error-loc\.t/; require_ok 'Data::BitStream'; -my $dbs = new Data::BitStream(mode => 'ro'); +my $dbs = Data::BitStream->new(mode => 'ro'); throws_ok { $dbs->read($dbs->maxbits + 1) } $error_regex, 'read(maxbits + 1) should fail'; note "Message: $@"; @@ -22,7 +22,7 @@ note "Message: $@"; # I'm not certain if this is the correct behavior, but a read() returns undef # if there are exactly zero bytes left in the stream -$dbs = new Data::BitStream(); +$dbs = Data::BitStream->new(); $dbs->from_raw("\x00"); throws_ok { $dbs->read(32) } $error_regex, 'read past EOF should fail'; note "Message: $@"; diff --git a/t/74-to-raw.t b/t/74-to-raw.t index 5c66817..12d3cc5 100644 --- a/t/74-to-raw.t +++ b/t/74-to-raw.t @@ -19,7 +19,7 @@ test_case { $dbs->write(1, 0) }; sub test_case(&) { my ($sub) = @_; - $dbs = new Data::BitStream(); + $dbs = Data::BitStream->new(); $sub->($dbs); my $bits = $dbs->len; my $expected_length = int(($bits + 7) / 8);