From: Vincent Pit <vince@profvince.com>
Date: Sun, 29 Jun 2008 15:12:56 +0000 (+0200)
Subject: Importing Bit-MorseSignals-0.06.tar.gz
X-Git-Tag: v0.06^0
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=d4cad38280f090c2057f4df1d6ef1fce88ccbcc6;p=perl%2Fmodules%2FBit-MorseSignals.git

Importing Bit-MorseSignals-0.06.tar.gz
---

diff --git a/Changes b/Changes
index 7dfb548..9780fe2 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,11 @@
 Revision history for Bit-MorseSignals
 
+0.06    2008-03-20 19:45 UTC
+        + Fix : Read the datatype bits in the right order (lowest weight bit
+                coming first).
+        + Fix : Propagate demangler errors correctly.
+        + Tst : Tests now cover 100% of the code.
+
 0.05    2008-03-13 23:05 UTC
         + Add : The len and pos emitter methods.
         + Fix : The usual set of POD typos.
diff --git a/MANIFEST b/MANIFEST
index 71cde0b..70309f8 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -15,6 +15,7 @@ t/22-emitter-utf8.t
 t/30-receiver-obj.t
 t/31-receiver-plain.t
 t/32-receiver-utf8.t
+t/33-receiver-misformed.t
 t/50-chitchat-plain.t
 t/51-chitchat-utf8.t
 t/52-chitchat-storable.t
diff --git a/META.yml b/META.yml
index ce749cd..290ecc2 100644
--- a/META.yml
+++ b/META.yml
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:                Bit-MorseSignals
-version:             0.05
+version:             0.06
 abstract:            The MorseSignals protocol.
 license:             perl
 author:              
diff --git a/Makefile.PL b/Makefile.PL
index c1e4b26..448a80b 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -36,5 +36,5 @@ WriteMakefile(
                       . build_req,
         COMPRESS   => 'gzip -9f', SUFFIX => 'gz'
     },
-    clean         => { FILES => 'Bit-MorseSignals-*' },
+    clean         => { FILES => 'Bit-MorseSignals-* *.gcov *.gcda *.gcno cover_db' },
 );
diff --git a/README b/README
index 4f57451..080c4a1 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ NAME
     Bit::MorseSignals - The MorseSignals protocol.
 
 VERSION
-    Version 0.05
+    Version 0.06
 
 SYNOPSIS
         use Bit::MorseSignals::Emitter;
@@ -109,6 +109,9 @@ SUPPORT
 
         perldoc Bit::MorseSignals
 
+    Tests code coverage report is available at
+    <http://www.profvince.com/perl/cover/Bit-MorseSignals>.
+
 COPYRIGHT & LICENSE
     Copyright 2008 Vincent Pit, all rights reserved.
 
diff --git a/lib/Bit/MorseSignals.pm b/lib/Bit/MorseSignals.pm
index 3add7d6..b51cb3a 100644
--- a/lib/Bit/MorseSignals.pm
+++ b/lib/Bit/MorseSignals.pm
@@ -9,11 +9,11 @@ Bit::MorseSignals - The MorseSignals protocol.
 
 =head1 VERSION
 
-Version 0.05
+Version 0.06
 
 =cut
 
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 
 =head1 SYNOPSIS
 
@@ -139,6 +139,8 @@ You can find documentation for this module with the perldoc command.
 
     perldoc Bit::MorseSignals
 
+Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Bit-MorseSignals>.
+
 =head1 COPYRIGHT & LICENSE
 
 Copyright 2008 Vincent Pit, all rights reserved.
diff --git a/lib/Bit/MorseSignals/Emitter.pm b/lib/Bit/MorseSignals/Emitter.pm
index 441e6e4..54249f2 100644
--- a/lib/Bit/MorseSignals/Emitter.pm
+++ b/lib/Bit/MorseSignals/Emitter.pm
@@ -15,11 +15,11 @@ Bit::MorseSignals::Emitter - Base class for Bit::MorseSignals emitters.
 
 =head1 VERSION
 
-Version 0.05
+Version 0.06
 
 =cut
 
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 
 =head1 SYNOPSIS
 
@@ -70,7 +70,7 @@ L<Bit::MorseSignals::Emitter> object constructor. Currently does not take any op
 
 sub new {
  my $class = shift;
- $class = ref $class || $class || return;
+ return unless $class = ref $class || $class;
  croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
  my %opts = @_;
  my $self = {
@@ -128,8 +128,8 @@ sub post {
  $self->{state} = 2;
 
  my $head = '';
- vec($head, 0, 1) = ($type & 2) >> 1;
- vec($head, 1, 1) = ($type & 1);
+ vec($head, 0, 1) = ($type & 1);
+ vec($head, 1, 1) = ($type & 2) >> 1;
  vec($head, 2, 1) = 0;
  my $hlen = 3;
 
@@ -279,6 +279,8 @@ You can find documentation for this module with the perldoc command.
 
     perldoc Bit::MorseSignals::Emitter
 
+Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Bit-MorseSignals>.
+
 =head1 COPYRIGHT & LICENSE
 
 Copyright 2008 Vincent Pit, all rights reserved.
diff --git a/lib/Bit/MorseSignals/Receiver.pm b/lib/Bit/MorseSignals/Receiver.pm
index a829f36..52f444b 100644
--- a/lib/Bit/MorseSignals/Receiver.pm
+++ b/lib/Bit/MorseSignals/Receiver.pm
@@ -15,11 +15,11 @@ Bit::MorseSignals::Receiver - Base class for Bit::MorseSignals receivers.
 
 =head1 VERSION
 
-Version 0.05
+Version 0.06
 
 =cut
 
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 
 =head1 SYNOPSIS
 
@@ -54,7 +54,7 @@ L<Bit::MorseSignals::Receiver> object constructor. With the C<'done'> option, yo
 
 sub new {
  my $class = shift;
- $class = ref $class || $class || return;
+ return unless $class = ref $class || $class;
  croak 'Optional arguments must be passed as key => value pairs' if @_ % 2;
  my %opts = @_;
  my $self = {
@@ -100,11 +100,8 @@ sub push {
     #        BM_DATA_{PLAIN,         UTF8,          STORABLE}
     $self->{msg} = defined $demanglers[$self->{type}]
                     ? do {
-                       my $msg = eval {
-                        local $SIG{__DIE__} = sub { warn @_ };
-                        $demanglers[$self->{type}]->($self->{buf})
-                       };
-                       $@ ? undef : $msg;
+                       local $SIG{__DIE__} = sub { warn @_ };
+                       $demanglers[$self->{type}]->($self->{buf})
                       }
                     : $self->{buf};
     $self->reset;
@@ -117,8 +114,8 @@ sub push {
 
   vec($self->{buf}, $self->{len}++, 1) = $bit;
   if ($self->{len} >= 3) {
-   my $type = 2 * vec($self->{buf}, 0, 1)
-                + vec($self->{buf}, 1, 1);
+   my $type = 2 * vec($self->{buf}, 1, 1)
+                + vec($self->{buf}, 0, 1);
    $type = BM_DATA_PLAIN if vec($self->{buf}, 2, 1);
    @{$self}{qw/state type buf len/} = (3, $type, '', 0);
   }
@@ -207,6 +204,8 @@ You can find documentation for this module with the perldoc command.
 
     perldoc Bit::MorseSignals::Receiver
 
+Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Bit-MorseSignals>.
+
 =head1 COPYRIGHT & LICENSE
 
 Copyright 2008 Vincent Pit, all rights reserved.
diff --git a/t/20-emitter-obj.t b/t/20-emitter-obj.t
index b405700..1c25382 100644
--- a/t/20-emitter-obj.t
+++ b/t/20-emitter-obj.t
@@ -3,15 +3,32 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 25;
 
 use Bit::MorseSignals::Emitter;
 
 my $deuce = new Bit::MorseSignals::Emitter;
 ok(defined $deuce, 'BME object is defined');
-ok(ref $deuce eq 'Bit::MorseSignals::Emitter', 'BME object is valid');
+is(ref $deuce, 'Bit::MorseSignals::Emitter', 'BME object is valid');
+
+my $deuce2 = $deuce->new;
+ok(defined $deuce2, 'BME::new called as an object method works' );
+is(ref $deuce2, 'Bit::MorseSignals::Emitter', 'BME::new called as an object method works is valid');
+ok(!defined Bit::MorseSignals::Emitter::new(), 'BME::new called without a class is invalid');
+
+eval { $deuce2 = new Bit::MorseSignals::Emitter qw/a b c/ };
+like($@, qr/Optional\s+arguments/, 'BME::new gets parameters as key => value pairs');
 
 my $fake = { };
 bless $fake, 'Bit::MorseSignal::Hlagh';
-eval { Bit::MorseSignals::Emitter::reset($fake) };
-ok($@ && $@ =~ /^First\s+argument/, "BME methods only apply to BME objects");
+for (qw/post pop len pos reset flush busy queued/) {
+ eval "Bit::MorseSignals::Emitter::$_('Bit::MorseSignals::Emitter')";
+ like($@, qr/^First\s+argument/, "BME::$_ isn't a class method");
+ eval "Bit::MorseSignals::Emitter::$_(\$fake)";
+ like($@, qr/^First\s+argument/, "BME::$_ only applies to BME objects");
+}
+
+eval { $deuce->post('foo', qw/a b c/) };
+like($@, qr/Optional\s+arguments/, 'BME::post gets parameters after the first as key => value pairs');
+ok(!defined($deuce->post(sub { 1 })), 'BME::post doesn\'t take CODE references');
+ok(!defined($deuce->post(\*STDERR)), 'BME::post doesn\'t take GLOB references');
diff --git a/t/21-emitter-plain.t b/t/21-emitter-plain.t
index 83ee09a..812389a 100644
--- a/t/21-emitter-plain.t
+++ b/t/21-emitter-plain.t
@@ -9,40 +9,42 @@ use Bit::MorseSignals::Emitter;
 
 my $deuce = new Bit::MorseSignals::Emitter;
 
-my $i;
-sub test_bit {
- my ($desc, $b, $e) = @_;
- ok(defined $b && $b == $e,
-    "$desc: bit $i : " . (defined $b ? "got $b, expected $e" : 'undef'));
- ++$i;
-}
-
 sub test_msg {
- my ($desc, $exp) = @_;
+ my ($desc, $exp, $try_post) = @_;
+ my $len = @$exp;
  my $last = pop @$exp;
 
- $i = 0;
+ my $i = 0;
  for (@$exp) {
+  is($deuce->pos, $deuce->busy ? $i : undef, "$desc: BME position is correct");
   my $b = $deuce->pop;
-  ok($deuce->busy, "$desc: BME object is busy after pop $i");
-  test_bit $desc, $b, $_;
+  if ($try_post) {
+   ok(!defined($deuce->post),   "$desc: posting undef while sending returns undef");
+   is($deuce->post('what'), -1, "$desc: posting while sending enqueues");
+   $deuce->flush;
+   is($deuce->queued, 0,        "$desc: flushing dequeues");
+  }
+  is($deuce->len, $len, "$desc: BME length is correct");
+  ok($deuce->busy,      "$desc: BME object is busy after pop $i");
+  is($b, $_,            "$desc: bit $i is correct");
+  ++$i;
  }
 
  my $b = $deuce->pop;
  ok(!$deuce->busy, "$desc: BME object is no longer busy when over");
- test_bit $desc, $b, $last;
+ is($b, $last,     "$desc: last bit is correct");
 }
 
 my $msg = 'x';
 my @exp = split //, '111110' . '000' . '00011110' . '011111';
 
-my $ret = eval { $deuce->post($msg) };
+my $ret = eval { $deuce->post($msg, type => 4675412) }; # defaults to PLAIN
 ok(!$@, "simple post doesn't croak ($@)");
 ok(defined $ret && $ret > 0, 'simple post was successful');
 ok($deuce->busy, 'BME object is busy after simple post');
 ok(!$deuce->queued, 'BME object has no message queued after simple post');
 
-test_msg 'simple post', [ @exp ];
+test_msg 'simple post', [ @exp ], 1;
 ok(!defined $deuce->pop, "simple post: message is over");
 
 $ret = eval { $deuce->post($msg) };
@@ -61,3 +63,26 @@ test_msg 'first double post', [ @exp ];
 ok(!$deuce->busy && $deuce->queued, 'first double post: BME object is no longer busy but still has something in queue between the two posts');
 test_msg 'second double post', [ @exp ];
 ok(!defined $deuce->pop, "second double post: message is over");
+
+my $exp1 = join '', @exp;
+my $msg2 = 'y';
+my $exp2 = '00001' . '000' . '10011110' . '10000';
+my $msg3 = 'z';
+my $exp3 = '000001' . '000' . '01011110' . '100000';
+
+$deuce->post($msg);
+$deuce->post($msg2);
+my $s = ''; $s .= $deuce->pop for 1 .. length $exp1;
+is($s, $exp1, 'first send successful');
+ok(!$deuce->busy, 'after the first send, the emitter isn\'t busy anymore' );
+is($deuce->queued, 1, 'after the fist send, the emitter has still one item queued');
+isnt($deuce->post($msg3), -1, 'posting between the two messages doesn\'t return -1');
+ok($deuce->busy, 'after the new post, the emitter is busy, ready to send');
+is($deuce->queued, 1, 'after the new post, there\'s a new element in the queue');
+$s = ''; $s .= $deuce->pop for 1 .. length $exp2;
+is($s, $exp2, 'second send successful');
+$s = ''; $s .= $deuce->pop for 1 .. length $exp3;
+is($s, $exp3, 'third send successful');
+
+
+
diff --git a/t/22-emitter-utf8.t b/t/22-emitter-utf8.t
index 09df2d2..575c66a 100644
--- a/t/22-emitter-utf8.t
+++ b/t/22-emitter-utf8.t
@@ -12,32 +12,24 @@ use Bit::MorseSignals::Emitter;
 
 my $deuce = new Bit::MorseSignals::Emitter utf8 => 'DO WANT';
 
-my $i;
-sub test_bit {
- my ($desc, $b, $e) = @_;
- ok(defined $b && $b == $e,
-    "$desc: bit $i : " . (defined $b ? "got $b, expected $e" : 'undef'));
- ++$i;
-}
-
 sub test_msg {
  my ($desc, $exp) = @_;
  my $last = pop @$exp;
 
- $i = 0;
+ my $i = 0;
  for (@$exp) {
   my $b = $deuce->pop;
   ok($deuce->busy, "$desc: BME object is busy after pop $i");
-  test_bit $desc, $b, $_;
+  is($b, $_,       "$desc: bit $i is correct");
  }
 
  my $b = $deuce->pop;
  ok(!$deuce->busy, "$desc: BME object is no longer busy when over");
- test_bit $desc, $b, $last;
+ is($b, $last, "$desc: last bit is correct");
 }
 
 my $msg = 'é';
-my @exp = split //, '11110' . '010' . '11000011' . '10010101' . '01111';
+my @exp = split //, '11110' . '100' . '11000011' . '10010101' . '01111';
 
 my $ret = eval { $deuce->post($msg) };
 ok(!$@, "simple post doesn't croak ($@)");
diff --git a/t/30-receiver-obj.t b/t/30-receiver-obj.t
index 87817a5..53f8d44 100644
--- a/t/30-receiver-obj.t
+++ b/t/30-receiver-obj.t
@@ -3,15 +3,32 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 15;
 
 use Bit::MorseSignals::Receiver;
 
 my $pants = new Bit::MorseSignals::Receiver;
 ok(defined $pants, 'BMR object is defined');
-ok(ref $pants eq 'Bit::MorseSignals::Receiver', 'BMR object is valid');
+is(ref $pants, 'Bit::MorseSignals::Receiver', 'BMR object is valid');
+
+my $pants2 = $pants->new;
+ok(defined $pants2, 'BMR::new called as an object method works' );
+is(ref $pants2, 'Bit::MorseSignals::Receiver', 'BMR::new called as an object method works is valid');
+ok(!defined Bit::MorseSignals::Receiver::new(), 'BMR::new called without a class is invalid');
+
+eval { $pants2 = new Bit::MorseSignals::Receiver qw/a b c/ };
+like($@, qr/Optional\s+arguments/, 'BME::new gets parameters as key => value pairs');
 
 my $fake = { };
 bless $fake, 'Bit::MorseSignal::Hlagh';
-eval { Bit::MorseSignals::Receiver::reset($fake) };
-ok($@ && $@ =~ /^First\s+argument/, "BMR methods only apply to BMR objects");
+for (qw/push reset busy msg/) {
+ eval "Bit::MorseSignals::Receiver::$_('Bit::MorseSignals::Receiver')";
+ like($@, qr/^First\s+argument/, "BMR::$_ isn't a class method");
+ eval "Bit::MorseSignals::Receiver::$_(\$fake)";
+ like($@, qr/^First\s+argument/, "BMR::$_ only applies to BMR objects");
+}
+
+{
+ local $_;
+ ok(!defined($pants->push), 'BMR::push returns undef when \$_ isn\'t defined');
+}
diff --git a/t/31-receiver-plain.t b/t/31-receiver-plain.t
index 9c4326e..899f3f2 100644
--- a/t/31-receiver-plain.t
+++ b/t/31-receiver-plain.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::More tests => 2;
 
 use Bit::MorseSignals::Receiver;
 
@@ -14,6 +14,7 @@ my $pants = new Bit::MorseSignals::Receiver done => sub { $hlagh = $_[1] };
 my $msg  = 'x';
 my @bits = split //, '111110' . '000' . '00011110' . '011111';
 
-$pants->push for @bits;
+$pants->push($_) for @bits;
 
-ok(defined $hlagh && $hlagh eq $msg, 'message properly received');
+is($hlagh,      $msg, 'message properly received');
+is($pants->msg, $msg, 'message properly stored');
diff --git a/t/32-receiver-utf8.t b/t/32-receiver-utf8.t
index 65b614e..f11a431 100644
--- a/t/32-receiver-utf8.t
+++ b/t/32-receiver-utf8.t
@@ -5,17 +5,15 @@ use warnings;
 
 use utf8;
 
-use Test::More 'no_plan';
+use Test::More tests => 1;
 
 use Bit::MorseSignals::Receiver;
 
-my $hlagh;
-
-my $pants = new Bit::MorseSignals::Receiver done => sub { $hlagh = $_[1] };
+my $pants = new Bit::MorseSignals::Receiver;
 
 my $msg  = 'é';
-my @bits = split //, '11110' . '010' . '11000011' . '10010101' . '01111';
+my @bits = split //, '11110' . '100' . '11000011' . '10010101' . '01111';
 
 $pants->push for @bits;
 
-ok(defined $hlagh && $hlagh eq $msg, 'message properly received');
+is($pants->msg, $msg, 'message properly stored');
diff --git a/t/33-receiver-misformed.t b/t/33-receiver-misformed.t
new file mode 100644
index 0000000..9fde631
--- /dev/null
+++ b/t/33-receiver-misformed.t
@@ -0,0 +1,40 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use utf8;
+
+use Test::More tests => 5;
+
+use Bit::MorseSignals::Receiver;
+
+my $hlagh;
+
+my $pants = new Bit::MorseSignals::Receiver done => sub { $hlagh = $_[1] };
+
+my $wrong = "\x{FF}\x{FF}";
+
+my @bits = split //, '001' . '010' . (unpack 'b*', $wrong) . '100';
+eval {
+ local $SIG{__WARN__} = sub { die "WARNED @_" };
+ $pants->push for @bits;
+};
+ok($@, 'invalid Storable data warns');
+
+$pants->reset;
+@bits = split //, '0001' . '001' . (unpack 'b*', $wrong) . '1000';
+eval {
+ local $SIG{__WARN__} = sub { die "WARNED @_" };
+ $pants->push for @bits;
+};
+ok(!$@,            "third bit lit doesn't warn ($@)");
+is($hlagh, $wrong, 'third bit lit defaults to plain');
+
+@bits = split //, '0001' . '110' . (unpack 'b*', $wrong) . '1000';
+eval {
+ local $SIG{__WARN__} = sub { die "WARNED @_" };
+ $pants->push for @bits;
+};
+ok(!$@,            "unused type doesn't warn ($@)");
+is($hlagh, $wrong, 'unused type returns raw data');