Permalink
Browse files

Talk as given at YAPC::EU 2010

  • Loading branch information...
0 parents commit 2c9c99ac8b8954204fdc7f7e3db27b5d1e408a85 @pmakholm committed Aug 4, 2010
Showing with 372 additions and 0 deletions.
  1. +15 −0 intro.txt
  2. +55 −0 lib/Queue/Timed.pm
  3. +115 −0 outline.txt
  4. +2 −0 setup.sh
  5. +14 −0 synopsis.txt
  6. +10 −0 t/01-raw_tap.t
  7. +12 −0 t/02-test-more.t
  8. +24 −0 t/03-data_structure.t
  9. +24 −0 t/04-wait_time-sleep.t
  10. +35 −0 t/05-wait_time-overwrite.t
  11. +37 −0 t/06-wait_time_overwrite-highres.t
  12. +29 −0 xt/01.mockobject.t
@@ -0,0 +1,15 @@
+
+
+
+
+
+
+
+
+ Does your code work correctly?
+ ==============================
+
+
+
+
+ - peter@makholm.net
@@ -0,0 +1,55 @@
+package Queue::Timed;
+
+use strict;
+use warnings;
+
+use Carp;
+
+use Time::HiRes qw(time);
+
+sub new {
+ my ($class, %args) = @_;
+
+ return bless { queue => [] }, $class;
+}
+
+sub enqueue {
+ my ($self, $object) = @_;
+
+ push @{ $self->{queue} }, [ $object, time() ];
+
+ return $self;
+}
+
+sub dequeue {
+ my ($self) = @_;
+ my $object;
+
+ ($object) = @{ shift @{ $self->{queue} } } # Bug #1;
+ until $object
+ or scalar @{ $self->{queue} } == 0;
+
+ return $object;
+}
+
+sub length {
+ my ($self) = @_;
+
+ return scalar @{ $self->{queue} };
+}
+
+sub empty {
+ my ($self) = @_;
+
+ return $self->length == 0;
+}
+
+sub wait_time {
+ my ($self) = @_;
+
+ return 0 if $self->empty;
+ return (time() - $self->{queue}->[0]->[1]);
+}
+
+1;
+
@@ -0,0 +1,115 @@
+Does your code work correctly? (outline)
+========================================
+
+The Case Story
+--------------
+
+Queue::Timed
+
+ my $queue = Queue::Timed->new() # constructor
+ $queue->enqueue($obj) # add $obj to queue
+ $obj = $queue->dequeue() # get object form queue
+
+ $queue->length # Get length of queue
+ $queue->empty # is the queue empty
+
+ $queue->wait_time # The time the front object has been waiting
+
+
+What is TAP
+-----------
+
+Simple protocol for writing test output.
+
+ #!/usr/bin/perl
+
+ use Queue::Timed;
+ my $queue = Queue::Timed->new;
+
+ print "1..3\n";
+ print defined($queue) ? "ok 1\n" : "not ok 1\n";
+ print $queue->isa("Queue::Timed")? "ok 2\n" : "not ok 2\n";
+ print $queue->length == 0 ? "ok 3\n" : "not ok 3\n";
+
+
+prove(1) run tests and parses the TAP output.
+
+Test::More
+----------
+
+Or the same test using Test::More
+
+ #!/usr/bin/perl
+
+ use Test::More plan => 3;
+
+ use Queue::Timed;
+ my $queue = Queue::Timed->new();
+
+ ok( defined($queue), "new() returns defined value");
+ isa_ok( $queue, "Queue::Timed", "... of the right type");
+ is( $queue->length, 0, "... with length 0");
+
+
+Comparing data structures
+-------------------------
+
+Let us look at a more complex issue - t/03-datastructures.t
+
+Hey, look at the failure... Well I don't dare to fix it on stage. Mark it as
+todo...
+
+ TODO: {
+ local $TODO = "reason";
+
+ ...;
+ }
+
+Test cases to be skipped for some reason can be handled almost the same
+way:
+
+ SKIP: {
+ skip "reason", 4 if $skip_these;
+
+ ...;
+ }
+
+For a much more complete testing of deep datastructures see Test::Deep;
+
+Testing external dependencies
+-----------------------------
+
+How do we test wait_time()?
+
+The naïve way is to use sleep() - t/04-wait_time-sleep.t
+
+A better way is to override the time() function - t/05-wait_time-overwrite.t
+
+Using Time::HiRes breaks both solutions. Have to override the imported
+subroutine after loading.
+
+These methods works for all kinds of subroutines...
+
+
+Mocking objects
+---------------
+
+Assum I have some code that uses Queue::Timed and I only want to test my code.
+Enter Test::MockObject - xt/01-mock.t
+
+For another approach see Test::Mock
+
+
+ExtUtils::MakeMaker and Module::Build
+-------------------------------------
+
+Devel::Cover
+------------
+
+Smolder
+-------
+
+cpantesters.org
+---------------
+
+
@@ -0,0 +1,2 @@
+export PERL5LIB=./lib
+export SLIDES="intro.txt synopsis.txt t/*.t xt/*.t"
@@ -0,0 +1,14 @@
+Queue::Timed
+============
+
+ my $queue = Queue::Timed->new() # constructor
+ $queue->enqueue($obj) # add $obj to queue
+ $obj = $queue->dequeue() # get object form queue
+
+ $queue->length # Get length of queue
+ $queue->empty # is the queue empty
+
+ $queue->wait_time # The time the front object
+ # has been waiting
+
+
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+
+use Queue::Timed;
+my $queue = Queue::Timed->new;
+
+print "1..3\n";
+print defined($queue) ? "ok 1\n" : "not ok 1\n";
+print $queue->isa("Queue::Timed")? "ok 2\n" : "not ok 2\n";
+print $queue->length == 0 ? "ok 3\n" : "not ok 3\n";
+
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use Test::More tests => 3;
+
+use Queue::Timed;
+my $queue = Queue::Timed->new();
+
+ok( defined($queue), "new returns defined value");
+isa_ok( $queue, "Queue::Timed", "... of the right type");
+is( $queue->length, 0, "... with length 0");
+
+
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Queue::Timed;
+
+my $queue = Queue::Timed->new();
+
+my @input = ( 3, 6, 1, undef, 3, 9 );
+
+$queue->enqueue( $_ ) for @input;
+
+is ($queue->length, 6, "Queue has the right length");
+
+my @output;
+push @output, $queue->dequeue while not $queue->empty;
+
+SKIP: {
+ skip "Bug found while presentating", 1;
+is_deeply( \@output, \@input,
+ "Queue has the right content");
+}
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use Queue::Timed;
+
+my $queue = Queue::Timed->new();
+
+$queue->enqueue( 42 );
+
+sleep 5;
+
+is( $queue->wait_time, 5, "Wait time is now 5");
+
+sleep 5;
+
+is( $queue->wait_time, 10, "Wait time is now 10");
+
+sleep 5;
+
+is( $queue->wait_time, 15, "Wait time is now 15");
+
@@ -0,0 +1,35 @@
+
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+
+my $NOW;
+BEGIN {
+ $NOW = time();
+
+ *CORE::GLOBAL::time = sub {
+ return $NOW;
+ };
+}
+
+use Queue::Timed;
+
+my $queue = Queue::Timed->new();
+
+$queue->enqueue( 42 );
+
+$NOW += 5;
+
+is( $queue->wait_time, 5, "Wait time is now 5");
+
+$NOW += 5;
+
+is( $queue->wait_time, 10, "Wait time is now 10");
+
+$NOW += 5;
+
+is( $queue->wait_time, 15, "Wait time is now 15");
+
@@ -0,0 +1,37 @@
+
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More 'no_plan';
+use Time::HiRes;
+
+my $NOW;
+BEGIN {
+ $NOW = time();
+
+ no warnings 'redefine';
+ sub Time::HiRes::time() {
+ return $NOW;
+ };
+}
+
+use Queue::Timed;
+
+my $queue = Queue::Timed->new();
+
+$queue->enqueue( 42 );
+
+$NOW += 5;
+
+is( $queue->wait_time, 5, "Wait time is now 5");
+
+$NOW += 5;
+
+is( $queue->wait_time, 10, "Wait time is now 10");
+
+$NOW += 5;
+
+is( $queue->wait_time, 15, "Wait time is now 15");
+
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 3;
+use Test::MockObject;
+
+my @list;
+my $mock = Test::MockObject->new;
+
+$mock->mock( enqueue => sub { push @list, @_ } );
+$mock->mock( dequeue => sub { shift @list } );
+
+# Complex code follows
+$mock->enqueue(1);
+$mock->enqueue(2);
+$mock->dequeue;
+$mock->enqueue(3);
+$mock->dequeue;
+$mock->dequeue;
+# Complex code ends
+
+my %call;
+$call{$name}++ while (my $name = $mock->next_call);
+
+is( $call{enqueue}, $call{dequeue},
+ "Enqueue and dequeue call an equal number of times");
+

0 comments on commit 2c9c99a

Please sign in to comment.