Changeset 21777 for lang/perl/Test-Classy

Timestamp:

10/21/08 14:54:19 (5 years ago)

Author:

charsbar

Message:

Test-Classy: added $class->message and refined pods and 0.04 -> CPAN

Location:

lang/perl/Test-Classy/trunk

Files:

• Changes (modified) (1 diff)
• lib/Test/Classy.pm (modified) (1 diff)
• lib/Test/Classy/Base.pm (modified) (14 diffs)
• t/lib/Test/Classy/Test/Basic/Plain.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Basic/Skip.pm (modified) (4 diffs)
• t/lib/Test/Classy/Test/Basic/SkipClass.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Basic/SkipClassDeprecated.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Basic/Todo.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Inherit/Base.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Inherit/IgnoreMe.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Inherit/More.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Inherit/UseFurther.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Limit/Basic.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/Limit/WithoutTarget.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/NoPlan/NoPlan.pm (modified) (2 diffs)
• t/lib/Test/Classy/Test/OSTest/NotWin.pm (modified) (1 diff)
• t/lib/Test/Classy/Test/OSTest/Win.pm (modified) (1 diff)

lang/perl/Test-Classy/trunk/Changes

@@ -1 +1 @@
 Revision history for Test-Classy
+
+0.04 2008/10/21
+  - added $class->message to prepend test/class names to
+    a test message to make it easier to see which test
+    comes from which class.
 
 0.03 2008/08/03

lang/perl/Test-Classy/trunk/lib/Test/Classy.pm

@@ -6 +6 @@
 use Sub::Install qw( install_sub );
 
-our $VERSION = '0.03';
+our $VERSION = '0.04';
 
 my @tests;

lang/perl/Test-Classy/trunk/lib/Test/Classy/Base.pm

@@ -78 +78 @@
 
   my $tests = $class->_tests;
-  my $reason = 'tests only ' . ( join ', ', @monikers );
+  my $reason = 'limited by attributes';
 
 LOOP:
@@ -121 +121 @@
   my %sym = $class->_find_symbols;
 
+  $class->test_name( undef );
+
   $class->initialize(@args);
 
@@ -129 +131 @@
 
     if ( my $reason = $class->_should_skip_this_class ) {
-      SKIP: { Test::More::skip $reason, $tests->{$name}->{plan}; }
+      SKIP: { Test::More::skip $class->message($reason), $tests->{$name}->{plan}; }
       next;
     }
@@ -152 +154 @@
     if ( exists $test->{Skip} ) {  # todo skip
       TODO: {
-        Test::More::todo_skip $reason, $test->{plan};
+        Test::More::todo_skip $class->message($reason), $test->{plan};
       }
     }
@@ -158 +160 @@
       TODO: {
         no strict 'refs';
-        local ${"$class\::TODO"} = $reason; # perl 5.6.2 hates this
+        local ${"$class\::TODO"} = $class->message($reason); # perl 5.6.2 hates this
 
         $class->__run_test($test, @args);
@@ -169 +171 @@
       ? $test->{Skip}
       : "skipped $name";
-    SKIP: { Test::More::skip $reason, $test->{plan}; }
+    SKIP: { Test::More::skip $class->message($reason), $test->{plan}; }
     return;
   }
@@ -188 +190 @@
     if ( $rest ) {
       for ( 1 .. $rest ) {
-        Test::More->builder->skip( $reason );
+        Test::More->builder->skip( $class->message($reason) );
       }
     }
@@ -238 +240 @@
 }
 
+sub message {
+  my ($class, $message) = @_;
+
+  return $class->_prepend_class_name( $class->_prepend_test_name( $message ) );
+}
+
+sub _prepend_test_name {
+  my ($class, $message) = @_;
+
+  $message = '' unless defined $message;
+
+  if ( my $name = $class->test_name ) {
+    $message = "$name: $message" unless $message =~ /\b$name\b/;
+  }
+
+  return $message;
+}
+
+sub _prepend_class_name {
+  my ($class, $message) = @_;
+
+  $message = '' unless defined $message;
+
+  if ( my ($name) = $class =~ /(\w+)$/ ) {
+    $message = "$name: $message" unless $message =~ /\b$name\b/;
+  }
+
+  return $message;
+}
+
 sub initialize {}
 sub finalize {}
@@ -269 +301 @@
   sub mytest : Test {
     my $class = shift;
-    ok $class->model->find('something'), $class->test_name." works";
+    ok $class->model->find('something'), $class->message('works');
   }
 
@@ -275 +307 @@
     my $class = shift;
 
-    pass 'this test';
+    pass $class->message('this test');
 
     return $class->abort_this_test('for some reason');
 
-    fail 'this test';
+    fail $class->message('this test');
   }
 
@@ -296 +328 @@
 =head2 skip_this_class ( skip_the_rest -- deprecated )
 
-If you called this with a reason why you want to skip (unsupported OS or lack of modules, for example), all the tests in the package will be skipped. Note that this is useful in the initialize phase. You need to use good old 'skip' and 'Skip:' block when you want to skip some of the tests in a test unit.
+If you called this with a reason why you want to skip (unsupported OS or lack of modules, for example), all the tests in the package will be skipped. Note that this is only useful in the initialize phase. You need to use good old 'skip' and 'Skip:' block when you want to skip some of the tests in a test unit.
 
   sub some_test : Tests(2) {
@@ -334 +366 @@
 =head2 initialize
 
-This is called before the tests runs. You might want to set up database or something like that here. You can store initialized thingy as a class data (via Class::Data::Inheritable), or as a package-wide variable, maybe. Note that you can set up thingy in a test script and pass it as an argument for each of the tests instead.
+This is called before the tests run. You might want to set up database or something like that here. You can store initialized thingy as a class data (via Class::Data::Inheritable), or as a package-wide variable, maybe. Note that you can set up thingy in a test script and pass it as an argument for each of the tests instead.
 
 =head2 finalize
@@ -343 +375 @@
 
 returns the name of the test running currently. Handy to write a meaningful test message.
+
+=head2 message
+
+prepends the last bit of the class name, and the test name currently running if any, to a message.
 
 =head2 dump
@@ -384 +420 @@
   sub not_for_base : Test { pass 'for children only' };
 
+=head1 CAVEATS
+
+Beware if you want to inherit only some of the tests from a base class (to remove or replace others). All the tests with a C<Test(s)> attribute will be counted while calculating the test plan (i.e. both the ones to replace and the ones to be replaced will be counted). The simplest remedy to avoid a plan error is to use C<no_plan> obviously, but you may find it better to split the class into the mandatory one, and the one which may be skipped while initializing.
+
 =head1 AUTHOR
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Basic/Plain.pm

@@ -6 +6 @@
 
 sub plain_1 : Test {
-  pass "first test";
+  my $class = shift;
+  pass $class->message("first test");
 }
 
 sub plain_2 : Tests(2) {
-  pass "second test";
-  pass "third test";
+  my $class = shift;
+  pass $class->message("second test");
+  pass $class->message("third test");
 }
 
 sub plain_3 : Tests(3) {
-  pass "fourth test";
-  pass "fifth test";
-  pass "sixth test";
+  my $class = shift;
+  pass $class->message("fourth test");
+  pass $class->message("fifth test");
+  pass $class->message("sixth test");
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Basic/Skip.pm

@@ -6 +6 @@
 
 sub skip_1 : Test Skip {
-  fail "but this is to be skipped: 1-1";
+  my $class = shift;
+  fail $class->message("but this is to be skipped: 1-1");
 }
 
 sub skip_2 : Test(2) Skip {
-  fail "but this is to be skipped: 2-1";
-  fail "but this is to be skipped: 2-2";
+  my $class = shift;
+  fail $class->message("but this is to be skipped: 2-1");
+  fail $class->message("but this is to be skipped: 2-2");
 }
 
 sub skip_3 : Tests(3) Skip(skipped by attribute) {
-  fail "but this is to be skipped: 3-1";
-  fail "but this is to be skipped: 3-2";
-  fail "but this is to be skipped: 3-3";
+  my $class = shift;
+  fail $class->message("but this is to be skipped: 3-1");
+  fail $class->message("but this is to be skipped: 3-2");
+  fail $class->message("but this is to be skipped: 3-3");
 }
 
 sub skip_4_partly : Tests(3) {
-  pass "this should pass";
+  my $class = shift;
+  pass $class->message("this should pass");
 
   SKIP: {
-    skip 'skip inside a test', 1;
-    fail "but this is to be skipped";
+    skip $class->message('skip inside a test'), 1;
+    fail $class->message("but this is to be skipped");
   }
 
-  pass "this should pass, too";
+  pass $class->message("this should pass, too");
 }
 
@@ -34 +38 @@
   my $class = shift;
 
-  pass 'pass';
+  pass $class->message('pass');
 
   return $class->abort_this_test('aborted');
 
-  fail 'but this is to be skipped: 5-1';
+  fail $class->message('but this is to be skipped: 5-1');
 }
 
@@ -44 +48 @@
   my $class = shift;
 
-  pass 'pass';
+  pass $class->message('pass');
 
   # this is the alias of abort_this_test
   return $class->skip_this_test;
 
-  fail 'but this is to be skipped: 6-1';
+  fail $class->message('but this is to be skipped: 6-1');
 }
 
@@ -55 +59 @@
   my $class = shift;
 
-  pass 'pass';
+  pass $class->message('pass');
 
   return $class->abort_this_test('actually not aborted');

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Basic/SkipClass.pm

@@ -12 +12 @@
 
 sub failing_test : Test {
-  fail "but this is to be skipped";
+  my $class = shift;
+
+  fail $class->message("but this is to be skipped");
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Basic/SkipClassDeprecated.pm

@@ -13 +13 @@
 
 sub failing_test2 : Test {
-  fail "but this is to be skipped";
+  my $class = shift;
+
+  fail $class->message("but this is to be skipped");
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Basic/Todo.pm

@@ -6 +6 @@
 
 sub todo_1 : Test TODO {
-  fail "but this is a todo test: 1-1";
+  my $class = shift;
+
+  fail $class->message("but this is a todo test: 1-1");
 }
 
 sub todo_2 : Test(2) TODO {
-  fail "but this is a todo test: 2-1";
-  fail "but this is a todo test: 2-2";
+  my $class = shift;
+
+  fail $class->message("but this is a todo test: 2-1");
+  fail $class->message("but this is a todo test: 2-2");
 }
 
 sub todo_3 : Tests(3) TODO(skipped by attribute) {
-  fail "but this is a todo test: 3-1";
-  fail "but this is a todo test: 3-2";
-  fail "but this is a todo test: 3-3";
+  my $class = shift;
+
+  fail $class->message("but this is a todo test: 3-1");
+  fail $class->message("but this is a todo test: 3-2");
+  fail $class->message("but this is a todo test: 3-3");
 }
 
 sub todo_4 : Tests(3) TODO Skip {
-  fail "but this is a todo test: 4-1";
-  fail "but this is a todo test: 4-2";
-  fail "but this is a todo test: 4-3";
-  fail "but this is a todo test: 4-4";
+  my $class = shift;
+
+  fail $class->message("but this is a todo test: 4-1");
+  fail $class->message("but this is a todo test: 4-2");
+  fail $class->message("but this is a todo test: 4-3");
+  fail $class->message("but this is a todo test: 4-4");
 }
 
 sub todo_5_partly : Tests(3) {
-  pass "this should pass";
+  my $class = shift;
+
+  pass $class->message("this should pass");
 
   TODO: {
-    local $TODO = 'this is not implemented';
-    fail "this is a todo test";
+    local $TODO = $class->message('this is not implemented');
+    fail $class->message("this is a todo test");
   }
 
-  pass "this should pass, too";
+  pass $class->message("this should pass, too");
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Inherit/Base.pm

@@ -11 +11 @@
   my ($class, @args) = @_;
 
-  pass "tested ".$class->data; # should be ignored here
+  pass $class->message("tested ".$class->data); # should be ignored here
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Inherit/IgnoreMe.pm

@@ -11 +11 @@
   my ($class, @args) = @_;
 
-  pass "tested ".$class->data; # should be ignored here
+  pass $class->message("tested ".$class->data); # should be ignored here
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Inherit/More.pm

@@ -9 +9 @@
 
 sub more_test : Test {
-  pass "yet another test";
+  my $class = shift;
+  pass $class->message("yet another test");
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Inherit/UseFurther.pm

@@ -8 +8 @@
 
 sub further_test : Test {
-  pass "further test";
+  my $class = shift;
+
+  pass $class->message("further test");
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Limit/Basic.pm

@@ -6 +6 @@
 
 sub limit_test : Test Target {
-  pass 'this test will be executed';
+  my $class = shift;
+
+  pass $class->message('this test will be executed');
 }
 
 sub not_targeted : Test {
-  fail 'this test should be skipped';
+  my $class = shift;
+
+  fail $class->message('this test should be skipped');
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/Limit/WithoutTarget.pm

@@ -6 +6 @@
 
 sub not_targeted_at_all : Test {
-  fail 'this test should be skipped';
+  my $class = shift;
+
+  fail $class->message('this test should be skipped');
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/NoPlan/NoPlan.pm

@@ -6 +6 @@
 
 sub test : Test(no_plan) {
-  pass 'no plan';
+  my $class = shift;
+
+  pass $class->message('no plan');
 }
 
 sub test2 : Test('no_plan') {
-  pass 'no plan with single quotes';
+  my $class = shift;
+
+  pass $class->message('no plan with single quotes');
 }
 
 sub test3 : Test("no_plan") {
-  pass 'no plan with double quotes';
+  my $class = shift;
+
+  pass $class->message('no plan with double quotes');
 }
 
@@ -20 +26 @@
 
 sub test4 : Test("no_plan') {
-  fail 'quotes mismatch';
+  my $class = shift;
+
+  fail $class->message('quotes mismatch');
 }
 
 sub test5 : Test(no_plan') {
-  fail 'quotes mismatch';
+  my $class = shift;
+
+  fail $class->message('quotes mismatch');
 }
 
 sub test6 : Test(no_plan") {
-  fail 'quotes mismatch';
+  my $class = shift;
+
+  fail $class->message('quotes mismatch');
 }
 
 sub test7 : Test(noplan) {
-  fail 'bad plan name';
+  my $class = shift;
+
+  fail $class->message('bad plan name');
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/OSTest/NotWin.pm

@@ -15 +15 @@
 sub not_for_win : Test {
   my $class = shift;
-  pass $class->test_name;
+  pass $class->message;
 }
 

lang/perl/Test-Classy/trunk/t/lib/Test/Classy/Test/OSTest/Win.pm

@@ -15 +15 @@
 sub win_only : Test {
   my $class = shift;
-  pass $class->test_name;
+  pass $class->message;
 }