r77380 - in /branches/upstream/libtest-spec-perl/current: Changes MANIFEST META.yml lib/Test/Spec.pm lib/Test/Spec/Context.pm lib/Test/Spec/SharedHash.pm t/another_shared_examples_spec.pl t/data_sharing.t t/shared_examples.t

ghedo-guest at users.alioth.debian.org ghedo-guest at users.alioth.debian.org
Mon Jul 11 18:02:22 UTC 2011


Author: ghedo-guest
Date: Mon Jul 11 18:02:20 2011
New Revision: 77380

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=77380
Log:
[svn-upgrade] new version libtest-spec-perl (0.38)

Added:
    branches/upstream/libtest-spec-perl/current/lib/Test/Spec/SharedHash.pm
    branches/upstream/libtest-spec-perl/current/t/another_shared_examples_spec.pl   (with props)
    branches/upstream/libtest-spec-perl/current/t/data_sharing.t   (with props)
Modified:
    branches/upstream/libtest-spec-perl/current/Changes
    branches/upstream/libtest-spec-perl/current/MANIFEST
    branches/upstream/libtest-spec-perl/current/META.yml
    branches/upstream/libtest-spec-perl/current/lib/Test/Spec.pm
    branches/upstream/libtest-spec-perl/current/lib/Test/Spec/Context.pm
    branches/upstream/libtest-spec-perl/current/t/shared_examples.t

Modified: branches/upstream/libtest-spec-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/Changes?rev=77380&op=diff
==============================================================================
--- branches/upstream/libtest-spec-perl/current/Changes (original)
+++ branches/upstream/libtest-spec-perl/current/Changes Mon Jul 11 18:02:20 2011
@@ -1,4 +1,11 @@
 Revision history for Perl extension Test::Spec.
+
+0.38 Sat Jul 09 23:16:00 EST 2011
+  - Added share() function to facilitate spec refactoring.
+
+0.37 Thu Jul 07 13:55:00 EST 2011
+  - Fixed bug where shared examples defined in one package could not be
+    used in another package.
 
 0.36 Tue Jul 05 18:23:00 EST 2011
   - Improved reporting of errors using spec_helper.

Modified: branches/upstream/libtest-spec-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/MANIFEST?rev=77380&op=diff
==============================================================================
--- branches/upstream/libtest-spec-perl/current/MANIFEST (original)
+++ branches/upstream/libtest-spec-perl/current/MANIFEST Mon Jul 11 18:02:20 2011
@@ -2,10 +2,13 @@
 lib/Test/Spec.pm
 lib/Test/Spec/Context.pm
 lib/Test/Spec/Mocks.pm
+lib/Test/Spec/SharedHash.pm
 Makefile.PL
 MANIFEST
 README
+t/another_shared_examples_spec.pl
 t/auto_inherit.t
+t/data_sharing.t
 t/define.t
 t/dying_spec.pl
 t/empty.t

Modified: branches/upstream/libtest-spec-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/META.yml?rev=77380&op=diff
==============================================================================
--- branches/upstream/libtest-spec-perl/current/META.yml (original)
+++ branches/upstream/libtest-spec-perl/current/META.yml Mon Jul 11 18:02:20 2011
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Test-Spec
-version:            0.36
+version:            0.38
 abstract:           Write tests in a declarative specification style
 author:
     - Philip Garrett <philip.garrett at icainformatics.com>

Modified: branches/upstream/libtest-spec-perl/current/lib/Test/Spec.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/lib/Test/Spec.pm?rev=77380&op=diff
==============================================================================
--- branches/upstream/libtest-spec-perl/current/lib/Test/Spec.pm (original)
+++ branches/upstream/libtest-spec-perl/current/lib/Test/Spec.pm Mon Jul 11 18:02:20 2011
@@ -3,7 +3,7 @@
 use warnings;
 use Test::Trap ();        # load as early as possible to override CORE::exit
 
-our $VERSION = '0.36';
+our $VERSION = '0.38';
 
 use base qw(Exporter);
 
@@ -18,7 +18,7 @@
 our $Debug = $ENV{TEST_SPEC_DEBUG} || 0;
 
 our @EXPORT      = qw(runtests describe before after it they *TODO
-                      shared_examples_for it_should_behave_like
+                      share shared_examples_for it_should_behave_like
                       spec_helper);
 our @EXPORT_OK   = ( @EXPORT, qw(DEFINITION_PHASE EXECUTION_PHASE $Debug) );
 our %EXPORT_TAGS = ( all => \@EXPORT_OK,
@@ -184,16 +184,16 @@
   }
   my $name = shift || $package;
 
-  my $parent;
+  my $container;
   if ($_Current_Context) {
-    $parent = $_Current_Context->context_lookup;
+    $container = $_Current_Context->context_lookup;
   }
   else {
-    $parent = $_Package_Contexts->{$package} ||= _ixhash();
+    $container = $_Package_Contexts->{$package} ||= _ixhash();
   }
 
   __PACKAGE__->_accumulate_examples({
-    parent => $parent,
+    container => $container,
     name => $name,
     class => $package,
     code => $code,
@@ -217,9 +217,9 @@
   }
 
   __PACKAGE__->_accumulate_examples({
-    parent => $_Shared_Example_Groups,
+    container => $_Shared_Example_Groups,
     name => $name,
-    class => $package,
+    class => undef,   # shared examples are global
     code => $code,
     label => '',
   });
@@ -229,7 +229,7 @@
 # groups in context
 sub _accumulate_examples {
   my ($klass,$args) = @_;
-  my $parent = $args->{parent};
+  my $container = $args->{container};
   my $name = $args->{name};
   my $class = $args->{class};
   my $code = $args->{code};
@@ -237,15 +237,21 @@
 
   my $context;
   # Don't clobber contexts of the same name, aggregate them.
-  if ($parent->{$name}) {
-    $context = $parent->{$name};
+  if ($container->{$name}) {
+    $context = $container->{$name};
   }
   else {
-    $context = Test::Spec::Context->new;
+    $container->{$name} = $context = Test::Spec::Context->new;
     $context->name( $label );
-    $context->class( $class );
-    $context->parent( $_Current_Context ); # might be undef
-    $parent->{$name} = $context;
+    # A context gets either a parent or a class. This is because the
+    # class should be inherited from the parent to support classless
+    # shared example groups.
+    if ($_Current_Context) {
+      $context->parent( $_Current_Context );
+    }
+    else {
+      $context->class( $class );
+    }
   }
 
   # push a context onto the stack
@@ -253,7 +259,7 @@
 
   # evaluate the context function, which will set up lexical variables and
   # define tests and other contexts
-  $context->contextualize(sub { $code->() }); 
+  $context->contextualize($code); 
 }
 
 # it_should_behave_like DESC
@@ -268,9 +274,15 @@
   my $context = $_Shared_Example_Groups->{$name} ||
     Carp::croak "unrecognized example group \"$name\"";
 
+  # make a copy so we can assign the correct class name (via parent),
+  # which is needed for flattening the context into actual test
+  # functions later.
+  my $shim = $context->clone;
+  $shim->parent($_Current_Context);
+
   # 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;
+  $_Current_Context->context_lookup->{"__shared_examples__:$name"} = $shim;
 }
 
 # before CODE
@@ -333,6 +345,11 @@
   $sub->($load_path,$filespec);
 }
 
+sub share(\%) {
+  my $hashref = shift;
+  tie %$hashref, 'Test::Spec::SharedHash';
+}
+
 sub _materialize_tests {
   my $class = shift;
   my $contexts = $_Package_Contexts->{$class};
@@ -392,6 +409,7 @@
 
 # load context implementation
 require Test::Spec::Context;
+require Test::Spec::SharedHash;
 
 1;
 
@@ -466,9 +484,11 @@
 
 =over 4
 
-=item * C<describe>, C<it>, C<before>, C<after>, and C<runtests>
-
-These are the functions you will use to define behaviors and run your specs.
+=item * Spec definition functions
+
+These are the functions you will use to define behaviors and run your specs:
+C<describe>, C<it>, C<they>, C<before>, C<after>, C<runtests>, C<share>,
+C<shared_examples_for>, C<it_should_behave_like>, and C<spec_helper>.
 
 =item * The stub/mock functions in L<Test::Spec::Mocks>.
 
@@ -668,15 +688,18 @@
 
 Example group names are B<global>.
 
+  my $browser;
   shared_examples_for "all browsers" => sub {
-    it "should open a URL";
+    it "should open a URL" => sub { ok($browser->open("http://www.google.com/")) };
     ...
   };
   describe "Firefox" => sub {
+    before all => sub { $browser = Firefox->new };
     it_should_behave_like "all browsers";
     it "should have firefox features";
   };
   describe "Safari" => sub {
+    before all => sub { $browser = Safari->new };
     it_should_behave_like "all browsers";
     it "should have safari features";
   };
@@ -690,6 +713,33 @@
 the current context. See L</Shared example groups> and
 L<shared_examples_for>.
 
+=item share %HASH
+
+Registers C<%HASH> for sharing data between tests and example groups.
+This lets you share variables with code in different lexical scopes
+without resorting to using package (i.e. global) variables or jumping
+through other hoops to circumvent scope problems.
+
+Every hash that is C<share>d refers to the B<same data>. Sharing a hash
+will make its existing contents inaccessible, because afterwards it
+contains the same data that all other shared hashes contain. The result
+is that you get a hash with global semantics but with lexical scope
+(assuming C<%HASH> is a lexical variable).
+
+There are a few benefits of using C<share> over using a "regular"
+global hash. First, you don't have to decide what package the hash will
+belong to, which is annoying when you have specs in several packages
+referencing the same shared examples. You also don't have to clutter
+your examples with colons for fully-qualified names. For example, at my
+company our specs go in the "ICA::TestCase" hierarchy, and
+"$ICA::TestCase::Some::Package::variable" is exhausting to both the eyes
+and the hands. Lastly, using C<share> allows C<Test::Spec> to provide
+this functionality without deciding on the variable name for you (and
+thereby potentially clobbering one of your variables).
+
+  share %vars;      # %vars now refers to the global share
+  share my %vars;   # declare and share %vars in one step
+
 =item spec_helper FILESPEC
 
 Loads the Perl source in C<FILESPEC> into the current spec's package. If
@@ -765,6 +815,61 @@
   ok 1 - Officer should be optionable
   ok 2 - Officer should be bonusable
   ok 3 - Officer should be payable
+
+=head3 Refactoring into files
+
+If you want to factor specs into separate files, variable scopes can be
+tricky. This is especially true if you follow the recommended pattern
+and give each spec its own package name. C<Test::Spec> offers a couple
+of functions that ease this process considerably: L<share|/share %HASH>
+and L<spec_helper|/spec_helper FILESPEC>.
+
+Consider the browsers example from C<shared_examples_for>. A real
+browser specification would be large, so putting the specs for all
+browsers in the same file would be a bad idea. So let's say we create
+C<all_browsers.pl> for the shared examples, and give Safari and Firefox
+C<safari.t> and C<firefox.t>, respectively. 
+
+The problem then becomes: how does the code in C<all_browsers.pl> access
+the C<$browser> variable? In L<the example code|/shared_examples_for DESCRIPTION =E<gt> CODE>, 
+C<$browser> is a lexical variable that is in scope for all the examples.
+But once those examples are split into multiple files, you would have to
+use either package global variables or worse, come up with some other
+hack. This is where C<share> and C<spec_helper> come in.
+
+  # safari.t
+  package Testcase::Safari;
+  use Test::Spec;
+  spec_helper 'all_browsers.pl';
+
+  describe "Safari" => sub {
+    share my %vars;
+    before all => sub { $vars{browser} = Safari->new };
+    it_should_behave_like "all browsers";
+    it "should have safari features";
+  };
+
+  # firefox.t
+  package Testcase::Firefox;
+  use Test::Spec;
+  spec_helper 'all_browsers.pl';
+
+  describe "Firefox" => sub {
+    share my %vars;
+    before all => sub { $vars{browser} = Firefox->new };
+    it_should_behave_like "all browsers";
+    it "should have firefox features";
+  };
+
+  # in all_browsers.pl
+  shared_examples_for "all browsers" => sub {
+    # doesn't have to be the same name!
+    share my %t;
+    it "should open a URL" => sub {
+      ok $t{browser}->open("http://www.google.com/");
+    };
+    ...
+  };
 
 =head2 Order of execution
 

Modified: branches/upstream/libtest-spec-perl/current/lib/Test/Spec/Context.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/lib/Test/Spec/Context.pm?rev=77380&op=diff
==============================================================================
--- branches/upstream/libtest-spec-perl/current/lib/Test/Spec/Context.pm (original)
+++ branches/upstream/libtest-spec-perl/current/lib/Test/Spec/Context.pm Mon Jul 11 18:02:20 2011
@@ -44,6 +44,23 @@
   return $self;
 }
 
+sub clone {
+  my $orig = shift;
+  my $clone = bless { %$orig }, ref($orig);
+
+  my $orig_contexts = $clone->context_lookup;
+  my $new_contexts  = Test::Spec::_ixhash();
+
+  while (my ($name,$ctx) = each %$orig_contexts) {
+    my $new_ctx = $ctx->clone;
+    $new_ctx->parent($clone);
+    $new_contexts->{$name} = $new_ctx;
+  }
+  $clone->{_context_lookup} = $new_contexts;
+
+  return $clone;
+}
+
 # The reference we keep to our parent causes the garbage collector to
 # destroy the innermost context first, which is what we want. If that
 # becomes untrue at some point, it will be easy enough to descend the
@@ -76,7 +93,15 @@
 sub class {
   my $self = shift;
   $self->{_class} = shift if @_;
-  return $self->{_class};
+  if ($self->{_class}) {
+    return $self->{_class};
+  }
+  elsif ($self->parent) {
+    return $self->parent->class;
+  }
+  else {
+    return undef;
+  }
 }
 
 sub context_lookup {

Added: branches/upstream/libtest-spec-perl/current/lib/Test/Spec/SharedHash.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/lib/Test/Spec/SharedHash.pm?rev=77380&op=file
==============================================================================
--- branches/upstream/libtest-spec-perl/current/lib/Test/Spec/SharedHash.pm (added)
+++ branches/upstream/libtest-spec-perl/current/lib/Test/Spec/SharedHash.pm Mon Jul 11 18:02:20 2011
@@ -1,0 +1,23 @@
+package Test::Spec::SharedHash;
+use strict;
+use warnings;
+use Tie::Hash;
+use base qw(Tie::StdHash);
+
+# a semaphore
+our $Initialized = 0;
+
+our %STASH;
+
+sub TIEHASH {
+  my $class = shift;
+  my $ref = \%STASH;
+  bless $ref, $class;
+  return $ref;
+}
+
+sub reset {
+  %STASH = ();
+}
+
+1;

Added: branches/upstream/libtest-spec-perl/current/t/another_shared_examples_spec.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/t/another_shared_examples_spec.pl?rev=77380&op=file
==============================================================================
--- branches/upstream/libtest-spec-perl/current/t/another_shared_examples_spec.pl (added)
+++ branches/upstream/libtest-spec-perl/current/t/another_shared_examples_spec.pl Mon Jul 11 18:02:20 2011
@@ -1,0 +1,26 @@
+#!/usr/bin/env perl
+#
+# another_shared_examples_spec.pl
+#
+# Test cases for Test::Spec shared example definition and inclusion.
+# 
+# This spec requires a shared example group that is expected to already
+# have been defined in shared_examples_spec.pl.
+#
+########################################################################
+#
+package Testcase::Spec::AnotherSharedExamplesSpec;
+use Test::Spec;
+
+spec_helper 'shared_examples_spec.pl';
+
+describe "A context in a second spec importing an example group defined in another package" => sub {
+  it_should_behave_like "example group";
+#   it "can take at least one example";
+#   it "can take more than one example";
+#   describe "with an inner block" =>
+#     it "nests properly";
+#   it "can be reopened";
+};
+
+runtests unless caller;

Propchange: branches/upstream/libtest-spec-perl/current/t/another_shared_examples_spec.pl
------------------------------------------------------------------------------
    svn:executable = *

Added: branches/upstream/libtest-spec-perl/current/t/data_sharing.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/t/data_sharing.t?rev=77380&op=file
==============================================================================
--- branches/upstream/libtest-spec-perl/current/t/data_sharing.t (added)
+++ branches/upstream/libtest-spec-perl/current/t/data_sharing.t Mon Jul 11 18:02:20 2011
@@ -1,0 +1,60 @@
+#!/usr/bin/env perl
+#
+# stash.t
+#
+# Test cases for context stash.
+#
+########################################################################
+#
+package Testcase::Spec::Stash;
+use strict;
+use warnings;
+use Test::Spec;
+
+describe "An example group" => sub {
+
+  share my %stash;
+
+  $stash{outside} = "outside";
+  $stash{inside}  = "outside";  # expected to be overridden
+
+  before all => sub {
+    $stash{inside} .= 'inside';  # overrides earlier
+  };
+  before each => sub {
+    $stash{each1} = 'each1';
+  };
+  before each => sub {
+    $stash{each2} = 'each2';
+  };
+
+  my %expected = (
+    outside => 'outside',
+    inside => 'outsideinside',
+    each1 => 'each1',
+    each2 => 'each2',
+  );
+
+  it "should set up the stash properly" => sub {
+    is_deeply({ %stash }, \%expected);
+  };
+
+  describe "within an example group" => sub {
+    it "should get the same stash as its parents" => sub {
+      is_deeply({ %stash }, { %expected, each3 => 'each3' });
+    };
+    before each => sub {
+      $stash{each3} = 'each3';
+    };
+
+    share my %second;
+    it "should have the same data in every shared hash" => sub {
+      $second{key} = 'value';
+      is_deeply({ %second }, { %stash });
+    };
+  };
+
+};
+
+runtests unless caller;
+

Propchange: branches/upstream/libtest-spec-perl/current/t/data_sharing.t
------------------------------------------------------------------------------
    svn:executable = *

Modified: branches/upstream/libtest-spec-perl/current/t/shared_examples.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libtest-spec-perl/current/t/shared_examples.t?rev=77380&op=diff
==============================================================================
--- branches/upstream/libtest-spec-perl/current/t/shared_examples.t (original)
+++ branches/upstream/libtest-spec-perl/current/t/shared_examples.t Mon Jul 11 18:02:20 2011
@@ -37,4 +37,12 @@
 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");
 
+ at results = parse_tap("another_shared_examples_spec.pl");
+%passing = map { $_->description => 1 } grep { $_->is_test } @results;
+
+test_passed("A context in a second spec importing an example group defined in another package can take at least one example");
+test_passed("A context in a second spec importing an example group defined in another package can take more than one example");
+test_passed("A context in a second spec importing an example group defined in another package with an inner block nests properly");
+test_passed("A context in a second spec importing an example group defined in another package can be reopened");
+
 done_testing();




More information about the Pkg-perl-cvs-commits mailing list