@@ -1,5 +1,9 @@
 Revision history for Perl extension Test::Spec.
 
+0.33 Mon Jun 13 15:03:03 UTC 2011
+  - Added shared_examples_for/it_should_behave_like to allow
+    factorization of tests.
+
 0.32 Thu Jun  9 16:09:55 UTC 2011
   - Fixed a problem with the tests that occurred only when
     Package::Stash::XS was not installed (issue #8).

@@ -14,6 +14,8 @@ t/import_warnings.t
 t/mocks.t
 t/mocks_imports.t
 t/perl_warning_spec.pl
+t/shared_examples.t
+t/shared_examples_spec.pl
 t/show_exeptions.t
 t/strict_violating_spec.pl
 t/test_helper.pl

@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Test-Spec
-version:            0.32
+version:            0.33
 abstract:           Write tests in a declarative specification style
 author:
     - Philip Garrett <philip.garrett@icainformatics.com>
@@ -17,6 +17,7 @@ requires:
     List::Util:      0
     Package::Stash:  0.23
     Scalar::Util:    0
+    TAP::Parser:     0
     Test::Deep:      0.103
     Test::More:      0
     Test::Trap:      0
@@ -25,7 +26,7 @@ no_index:
     directory:
         - t
         - inc
-generated_by:       ExtUtils::MakeMaker version 6.56
+generated_by:       ExtUtils::MakeMaker version 6.54
 meta-spec:
     url:      http://module-build.sourceforge.net/META-spec-v1.4.html
     version:  1.4

@@ -11,6 +11,7 @@ WriteMakefile(
       'List::Util'     => 0,
       'Package::Stash' => 0.23,
       'Scalar::Util'   => 0,
+      'TAP::Parser'    => 0,
       'Test::Deep'     => 0.103, # earlier versions clash with UNIVERSAL::isa
       'Test::More'     => 0,
       'Test::Trap'     => 0,

@@ -30,6 +30,7 @@ This module requires these other modules and libraries:
  * List::Util
  * Package::Stash (>= 0.23)
  * Scalar::Util (XS version)
+ * TAP::Parser
  * Test::Deep (>= 0.103)
  * Test::More
  * Test::Trap

@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use Test::Trap ();        # load as early as possible to override CORE::exit
 
-our $VERSION = '0.32';
+our $VERSION = '0.33';
 
 use base qw(Exporter);
 
@@ -16,7 +16,8 @@ use constant { DEFINITION_PHASE => 0, EXECUTION_PHASE => 1 };
 our $TODO;
 our $Debug = $ENV{TEST_SPEC_DEBUG} || 0;
 
-our @EXPORT      = qw(runtests describe before after it they *TODO);
+our @EXPORT      = qw(runtests describe before after it they *TODO
+                      shared_examples_for it_should_behave_like);
 our @EXPORT_OK   = ( @EXPORT, qw(DEFINITION_PHASE EXECUTION_PHASE $Debug) );
 our %EXPORT_TAGS = ( all => \@EXPORT_OK,
                      constants => [qw(DEFINITION_PHASE EXECUTION_PHASE)] );
@@ -26,6 +27,8 @@ our $_Package_Contexts = _ixhash();
 our %_Package_Phase;
 our %_Package_Tests;
 
+our $_Shared_Example_Groups = {};
+
 # Avoid polluting the Spec namespace by loading these other modules into
 # what's essentially a mixin class.  When you write "use Test::Spec",
 # you'll get everything from Spec plus everything in ExportProxy. If you
@@ -179,7 +182,7 @@ sub describe(@) {
   }
   my $name = shift || $package;
 
-  my ($parent,$context);
+  my $parent;
   if ($_Current_Context) {
     $parent = $_Current_Context->context_lookup;
   }
@@ -187,14 +190,58 @@ sub describe(@) {
     $parent = $_Package_Contexts->{$package} ||= _ixhash();
   }
 
+  __PACKAGE__->_accumulate_examples({
+    parent => $parent,
+    name => $name,
+    class => $package,
+    code => $code,
+    label => $name,
+  });
+}
+
+# shared_examples_for DESC => CODE
+sub shared_examples_for($&) {
+  my $package = caller;
+  my ($name,$code) = @_;
+  if (not defined($name)) {
+    Carp::croak "expected example group name as first argument";
+  }
+  if (ref($code) ne 'CODE') {
+    Carp::croak "expected subroutine reference as last argument";
+  }
+
+  if ($_Current_Context) {
+    Carp::croak "shared_examples_for cannot be used inside any other context";
+  }
+
+  __PACKAGE__->_accumulate_examples({
+    parent => $_Shared_Example_Groups,
+    name => $name,
+    class => $package,
+    code => $code,
+    label => '',
+  });
+}
+
+# used by both describe() and shared_examples_for() to build example
+# groups in context
+sub _accumulate_examples {
+  my ($klass,$args) = @_;
+  my $parent = $args->{parent};
+  my $name = $args->{name};
+  my $class = $args->{class};
+  my $code = $args->{code};
+  my $label = $args->{label};
+
+  my $context;
   # Don't clobber contexts of the same name, aggregate them.
   if ($parent->{$name}) {
     $context = $parent->{$name};
   }
   else {
     $context = Test::Spec::Context->new;
-    $context->name( $name );
-    $context->class( $package );
+    $context->name( $label );
+    $context->class( $class );
     $context->parent( $_Current_Context ); # might be undef
     $parent->{$name} = $context;
   }
@@ -207,6 +254,23 @@ sub describe(@) {
   $context->contextualize(sub { $code->() }); 
 }
 
+# it_should_behave_like DESC
+sub it_should_behave_like($) {
+  my ($name) = @_;
+  if (not defined($name)) {
+    Carp::croak "expected example_group_name as first argument";
+  }
+  if (!$_Current_Context) {
+    Carp::croak "it_should_behave_like can only be used inside a describe or shared_examples_for context";
+  }
+  my $context = $_Shared_Example_Groups->{$name} ||
+    Carp::croak "unrecognized example group \"$name\"";
+
+  # add our shared_examples_for context as if it had been written inline
+  # as a describe() block
+  $_Current_Context->context_lookup->{"__shared_examples__:$name"} = $context;
+}
+
 # before CODE
 # before all => CODE
 # before each => CODE
@@ -568,8 +632,99 @@ respectively.  The default is "each".
 C<after "all"> blocks run I<after> C<after "each"> blocks.
 
 
+=item shared_examples_for DESCRIPTION => CODE
+
+Defines a group of examples that can later be included in
+C<describe> blocks or other C<shared_examples_for> blocks. See
+L</Shared Example Groups>.
+
+Example group names are B<global>.
+
+  shared_examples_for "all browsers" => sub {
+    it "should open a URL";
+    ...
+  };
+  describe "Firefox" => sub {
+    it_should_behave_like "all browsers";
+    it "should have firefox features";
+  };
+  describe "Safari" => sub {
+    it_should_behave_like "all browsers";
+    it "should have safari features";
+  };
+
+=item it_should_behave_like DESCRIPTION
+
+Asserts that the thing currently being tested passes all the tests in
+the example group identified by DESCRIPTION (having previously been
+defined with a C<shared_examples_for> block). In essence, this is like
+copying all the tests from the named C<shared_examples_for> block into
+the current context. See L</Shared example groups> and
+L<shared_examples_for>.
+
 =back
 
+=head2 Shared example groups
+
+This feature comes straight out of RSpec, as does this documentation:
+
+You can create shared example groups and include those groups into other
+groups.
+
+Suppose you have some behavior that applies to all editions of your
+product, both large and small.
+
+First, factor out the "shared" behavior:
+
+  shared_examples_for "all editions" => sub {
+    it "should behave like all editions" => sub {
+      ...
+    };
+  };
+
+then when you need to define the behavior for the Large and Small
+editions, reference the shared behavior using the
+C<it_should_behave_like()> function.
+
+  describe "SmallEdition" => sub {
+    it_should_behave_like "all editions";
+  };
+
+  describe "LargeEdition" => sub {
+    it_should_behave_like "all editions";
+    it "should also behave like a large edition" => sub {
+      ...
+    };
+  };
+
+C<it_should_behave_like> will search for an example group by its
+description string, in this case, "all editions".
+
+Shared example groups may be included in other shared groups:
+
+  shared_examples_for "All Employees" => sub {
+    it "should be payable" => sub {
+      ...
+    };
+  };
+
+  shared_examples_for "All Managers" => sub {
+    it_should_behave_like "All Employees";
+    it "should be bonusable" => sub {
+      ...
+    };
+  };
+
+  describe Officer => sub {
+    it_should_behave_like "All Managers";
+    it "should be optionable";
+  };
+
+  # generates:
+  ok 1 - Officer should be optionable
+  ok 2 - Officer should be bonusable
+  ok 3 - Officer should be payable
+
 =head2 Order of execution
 
 This example, shamelessly adapted from the RSpec website, gives an overview of

@@ -0,0 +1,40 @@
+#!/usr/bin/env perl
+#
+# shared_examples.t
+#
+# Test cases for Test::Spec shared example definition and inclusion.
+# Executes shared_examples_spec.pl and validates its TAP output.
+#
+########################################################################
+#
+use strict;
+use warnings;
+use FindBin qw($Bin);
+BEGIN { require "$Bin/test_helper.pl" };
+
+use Test::More;
+use TAP::Parser;
+
+my @results = parse_tap("shared_examples_spec.pl");
+my %passing = map { $_->description => 1 } grep { $_->is_test } @results;
+
+sub test_passed {
+  my $desc = shift;
+  my $testdesc = "- $desc";
+  ok(exists $passing{$testdesc}, $desc);
+}
+
+test_passed("A context importing an example group can take at least one example");
+test_passed("A context importing an example group can take more than one example");
+test_passed("A context importing an example group with an inner block nests properly");
+test_passed("A context importing an example group can have custom behavior");
+test_passed("A context importing an example group can be reopened");
+test_passed("Another context importing an example group can take at least one example");
+test_passed("Another context importing an example group can take more than one example");
+test_passed("Another context importing an example group with an inner block nests properly");
+test_passed("Another context importing an example group can have custom behavior, too");
+test_passed("Another context importing an example group can be reopened");
+test_passed("Another context can have behavior that doesn't interfere with example groups in sub-contexts");
+test_passed("Another context importing an example group accumulates examples in the same way that describe() does");
+
+done_testing();

@@ -0,0 +1,50 @@
+#!/usr/bin/env perl
+#
+# shared_examples_spec.pl
+#
+# Test cases for Test::Spec shared example definition and inclusion.
+# Generates TAP to be checked by shared_examples.t
+#
+########################################################################
+#
+package Testcase::Spec::SharedExamplesSpec;
+use Test::Spec;
+
+shared_examples_for "example group" => sub {
+  it "can take at least one example";
+  it "can take more than one example";
+  describe "with an inner block" => sub {
+    it "nests properly";
+  };
+};
+
+describe "A context importing an example group" => sub {
+  it_should_behave_like "example group";
+  it "can have custom behavior";
+};
+
+describe "Another context" => sub {
+  describe "importing an example group" => sub {
+    it_should_behave_like "example group";
+    it "can have custom behavior, too";
+  };
+  it "can have behavior that doesn't interfere with example groups in sub-contexts";
+};
+
+describe "Another context" => sub {
+  describe "importing an example group" => sub {
+    it "accumulates examples in the same way that describe() does";
+  };
+};
+
+shared_examples_for "example group" => sub {
+  it "can be reopened";
+};
+
+
+# A context importing an example group can take at least one example
+# A context importing an example group can take more than one example
+# A context importing an example group can be reopened
+# A context importing an example group with an inner block nests properly
+
+runtests unless caller;

@@ -1,5 +1,4 @@
 use strict;
-use File::Spec;
 use FindBin qw($Bin);
 
 {
@@ -22,6 +21,7 @@ sub stub_builder_in_packages {
 }
 
 sub capture_tap {
+  require File::Spec;
   my ($spec_name) = @_;
   my @incflags = map { "-I$_" } @INC;
   open(my $SPEC, '-|') || do {
@@ -33,4 +33,16 @@ sub capture_tap {
   return $tap;
 }
 
+sub parse_tap {
+  require TAP::Parser;
+  my ($spec_name) = @_;
+  my $tap = capture_tap($spec_name);
+  my $parser = TAP::Parser->new({ tap => $tap });
+  my @results;
+  while (my $result = $parser->next) {
+    push @results, $result;
+  }
+  return @results;
+}
+
 1;