develooper Front page | perl.perl5.porters | Postings from September 2010

Enhancements to t/test.pl

Thread Next
From:
Michael G Schwern
Date:
September 13, 2010 19:19
Subject:
Enhancements to t/test.pl
Message ID:
4C8EDB8F.6050408@pobox.com
--------------000607080507050008070303
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: 7bit

I'm using t/test.pl to test Test::Builder2, I needed a completely decoupled
but well featured test library.  Its replacing Test::More, so here's some
enhancements to make it act more like Test::More.

1.  Shut up some "used only once" warnings.  I did it in the simplest way
possible to avoid using $^W or warnings.pm.

2.  Add done_testing, the safer alternative to no_plan.

3.  Add note() to put comments into the TAP stream.

4.  Add new_ok() to create an object and test it in one go.


-- 
52. Not allowed to yell "Take that Cobra" at the rifle range.
    -- The 213 Things Skippy Is No Longer Allowed To Do In The U.S. Army
           http://skippyslist.com/list/


--------------000607080507050008070303
Content-Type: text/x-diff;
 name="0001-Shut-up-used-only-once-warnings.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename="0001-Shut-up-used-only-once-warnings.patch"

From d6682c8e56566d0bc20678a6575315fbe8844444 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 13 Sep 2010 19:10:18 -0700
Subject: [PATCH 1/4] Shut up "used only once" warnings.

Not very elegant, but it avoids using $^W or warnings.pm.
---
 t/test.pl |    8 ++++++--
 1 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/t/test.pl b/t/test.pl
index 2bf429c..eeb71ef 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -546,7 +546,8 @@ sub runperl {
     return $result;
 }
 
-*run_perl = \&runperl; # Nice alias.
+# Nice alias
+*run_perl = *run_perl = \&runperl; # shut up "used only once" warning
 
 sub DIE {
     _print_stderr "# @_\n";
@@ -824,9 +825,12 @@ sub watchdog ($;$)
         goto WATCHDOG_VIA_ALARM;
     }
 
+    # shut up use only once warning
+    my $threads_on = $threads::threads && $threads::threads;
+
     # Don't use a watchdog process if 'threads' is loaded -
     #   use a watchdog thread instead
-    if (! $threads::threads) {
+    if (!$threads_on) {
 
         # On Windows and VMS, try launching a watchdog process
         #   using system(1, ...) (see perlport.pod)
-- 
1.7.2.1


--------------000607080507050008070303
Content-Type: text/x-diff;
 name="0002-Add-done_testing-from-Test-More.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename="0002-Add-done_testing-from-Test-More.patch"

From 98e151cd367d420d0644fbb031d44b5ae2ecdb97 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 13 Sep 2010 19:14:04 -0700
Subject: [PATCH 2/4] Add done_testing from Test::More

---
 t/test.pl |   11 +++++++++++
 1 files changed, 11 insertions(+), 0 deletions(-)

diff --git a/t/test.pl b/t/test.pl
index eeb71ef..f6ad09c 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -54,6 +54,17 @@ sub plan {
     $planned = $n;
 }
 
+
+# Set the plan at the end.  See Test::More::done_testing.
+sub done_testing {
+    my $n = $test - 1;
+    $n = shift if @_;
+
+    _print "1..$n\n";
+    $planned = $n;
+}
+
+
 END {
     my $ran = $test - 1;
     if (!$NO_ENDING) {
-- 
1.7.2.1


--------------000607080507050008070303
Content-Type: text/x-diff;
 name="0003-Add-note-to-put-informational-notes-into-the-TAP-fro.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename*0="0003-Add-note-to-put-informational-notes-into-the-TAP-fro.pa";
 filename*1="tch"

From ebfc240034c154254061792514ff2eeb934e35e4 Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 13 Sep 2010 19:14:30 -0700
Subject: [PATCH 3/4] Add note() to put informational notes into the TAP (from Test::More)

---
 t/test.pl |   18 ++++++++++++++----
 1 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/t/test.pl b/t/test.pl
index f6ad09c..1d4a8cd 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -77,19 +77,29 @@ END {
     }
 }
 
-# Use this instead of "print STDERR" when outputing failure diagnostic
-# messages
 sub _diag {
     return unless @_;
-    my @mess = map { /^#/ ? "$_\n" : "# $_\n" }
-               map { split /\n/ } @_;
+    my @mess = _comment(@_);
     $TODO ? _print(@mess) : _print_stderr(@mess);
 }
 
+# Use this instead of "print STDERR" when outputing failure diagnostic
+# messages
 sub diag {
     _diag(@_);
 }
 
+# Use this instead of "print" when outputing informational messages
+sub note {
+    return unless @_;
+    _print( _comment(@_) );
+}
+
+sub _comment {
+    return map { /^#/ ? "$_\n" : "# $_\n" }
+           map { split /\n/ } @_;
+}
+
 sub skip_all {
     if (@_) {
         _print "1..0 # Skip @_\n";
-- 
1.7.2.1


--------------000607080507050008070303
Content-Type: text/x-diff;
 name="0004-Add-new_ok-to-create-and-test-objects.-From-Test-Mor.patch"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
 filename*0="0004-Add-new_ok-to-create-and-test-objects.-From-Test-Mor.pa";
 filename*1="tch"

From 9b6652cad65fd10f42ab2f2f0954f5cf5df5737f Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Mon, 13 Sep 2010 19:14:54 -0700
Subject: [PATCH 4/4] Add new_ok() to create and test objects.  From Test::More.

---
 t/test.pl |   27 +++++++++++++++++++++++++++
 1 files changed, 27 insertions(+), 0 deletions(-)

diff --git a/t/test.pl b/t/test.pl
index 1d4a8cd..f26627d 100644
--- a/t/test.pl
+++ b/t/test.pl
@@ -788,6 +788,33 @@ sub can_ok ($@) {
     _ok( !@nok, _where(), $name );
 }
 
+
+# Call $class->new( @$args ); and run the result through isa_ok.
+# See Test::More::new_ok
+sub new_ok {
+    my($class, $args, $obj_name) = @_;
+    $args ||= [];
+    $object_name = "The object" unless defined $obj_name;
+
+    local $Level = $Level + 1;
+
+    my $obj;
+    my $ok = eval { $obj = $class->new(@$args); 1 };
+    my $error = $@;
+
+    if($ok) {
+        isa_ok($obj, $class, $object_name);
+    }
+    else {
+        ok( 0, "new() died" );
+        diag("Error was:  $@");
+    }
+
+    return $obj;
+
+}
+
+
 sub isa_ok ($$;$) {
     my($object, $class, $obj_name) = @_;
 
-- 
1.7.2.1


--------------000607080507050008070303--

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About