This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate:
authorNicholas Clark <nick@ccl4.org>
Wed, 29 Dec 2004 12:03:15 +0000 (12:03 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 29 Dec 2004 12:03:15 +0000 (12:03 +0000)
[ 23620]
Upgrade to Term::ANSIColor 1.09

[ 23630]
Upgrade to perldoc 3.14

[ 23654]
Upgrade to Test::Simple 0.54
p4raw-link: @23654 on //depot/perl: 0257f296204adb69c838f5fbb883eb20cd264593
p4raw-link: @23630 on //depot/perl: 363fa2a924dc3ff31819de4e72022b9173ad9e17
p4raw-link: @23620 on //depot/perl: 92c7d2a28ff4d4e762344a2c1468bb639335e0c9

p4raw-id: //depot/maint-5.8/perl@23692
p4raw-branched: from //depot/perl@23690 'branch in'
lib/Test/Simple/t/is_fh.t
p4raw-integrated: from //depot/perl@23690 'copy in'
lib/Test/Simple/t/maybe_regex.t lib/Test/Simple/t/undef.t
(@16154..) lib/Test/Simple/t/details.t (@17783..)
lib/Term/ANSIColor.pm lib/Term/ANSIColor/ChangeLog
lib/Term/ANSIColor/README lib/Term/ANSIColor/test.pl (@22345..)
lib/Pod/Perldoc.pm lib/Pod/Perldoc/ToMan.pm (@22916..)
lib/Test/Simple/t/fail-more.t
lib/Test/Simple/t/harness_active.t
lib/Test/Simple/t/plan_no_plan.t (@23523..) lib/Test/Builder.pm
lib/Test/More.pm lib/Test/Simple.pm lib/Test/Simple/Changes
lib/Test/Simple/t/is_deeply.t lib/Test/Simple/t/sort_bug.t
lib/Test/Simple/t/todo.t (@23566..)
p4raw-integrated: from //depot/perl@23654 'merge in' MANIFEST
(@23653..)

21 files changed:
MANIFEST
lib/Pod/Perldoc.pm
lib/Pod/Perldoc/ToMan.pm
lib/Term/ANSIColor.pm
lib/Term/ANSIColor/ChangeLog
lib/Term/ANSIColor/README
lib/Term/ANSIColor/test.pl
lib/Test/Builder.pm
lib/Test/More.pm
lib/Test/Simple.pm
lib/Test/Simple/Changes
lib/Test/Simple/t/details.t
lib/Test/Simple/t/fail-more.t
lib/Test/Simple/t/harness_active.t
lib/Test/Simple/t/is_deeply.t
lib/Test/Simple/t/is_fh.t [new file with mode: 0644]
lib/Test/Simple/t/maybe_regex.t
lib/Test/Simple/t/plan_no_plan.t
lib/Test/Simple/t/sort_bug.t
lib/Test/Simple/t/todo.t
lib/Test/Simple/t/undef.t

index 5bcdfeb..b05d136 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1804,6 +1804,7 @@ lib/Test/Simple/t/has_plan2.t     Test::More->plan tests
 lib/Test/Simple/t/has_plan.t   Test::Builder->plan tests
 lib/Test/Simple/t/import.t     Test::More test, importing functions
 lib/Test/Simple/t/is_deeply.t  Test::More test, is_deeply()
+lib/Test/Simple/t/is_fh.t      Test::Builder test, _is_fh()
 lib/Test/Simple/t/maybe_regex.t        Test::Builder->maybe_regex() tests
 lib/Test/Simple/t/missing.t    Test::Simple test, missing tests
 lib/Test/Simple/t/More.t       Test::More test, basic stuff
index 0a4381f..06ac86b 100644 (file)
@@ -12,7 +12,7 @@ use File::Spec::Functions qw(catfile catdir splitdir);
 use vars qw($VERSION @Pagers $Bindir $Pod2man
   $Temp_Files_Created $Temp_File_Lifetime
 );
-$VERSION = '3.13';
+$VERSION = '3.14';
 #..........................................................................
 
 BEGIN {  # Make a DEBUG constant very first thing...
@@ -1079,7 +1079,7 @@ sub MSWin_perldoc_tempfile {
   my $spec;
   
   do {
-    $spec = sprintf "%s/perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup
+    $spec = sprintf "%s\\perldoc_%s_T%x_%x%02x.%s", # used also in MSWin_temp_cleanup
       # Yes, we embed the create-time in the filename!
       $tempdir,
       $infix || 'x',
@@ -1232,6 +1232,13 @@ sub pagers_guessing {
         push @pagers, qw( more less pg view cat );
         unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
     }
+
+    if (IS_Cygwin) {
+        if (($pagers[0] eq 'less') || ($pagers[0] eq '/usr/bin/less')) {
+            unshift @pagers, '/usr/bin/less -isrR';
+        }
+    }
+
     unshift @pagers, $ENV{PERLDOC_PAGER} if $ENV{PERLDOC_PAGER};
     
     return;   
@@ -1494,6 +1501,12 @@ sub page {  # apply a pager to the output file
         # extension get the wrong default extension (such as .LIS for TYPE)
 
         $output = VMS::Filespec::rmsexpand($output, '.') if IS_VMS;
+
+        $output =~ s{/}{\\}g if IS_MSWin32 || IS_Dos;
+          # Altho "/" under MSWin is in theory good as a pathsep,
+          #  many many corners of the OS don't like it.  So we
+          #  have to force it to be "\" to make everyone happy.
+
         foreach my $pager (@pagers) {
             $self->aside("About to try calling $pager $output\n");
             if (IS_VMS) {
index 83b7142..4319122 100644 (file)
@@ -72,10 +72,14 @@ sub parse_from_file {
     $command .= ' -rLL=' . (int $c) . 'n' if $cols > 80;
   }
 
+  if(Pod::Perldoc::IS_Cygwin) {
+    $command .= ' -c';
+  }
+
   # I hear persistent reports that adding a -c switch to $render
   # solves many people's problems.  But I also hear that some mans
-  # don't have a -c switch, so that adding it here would presumably
-  # be a Bad Thing   -- sburke@cpan.org
+  # don't have a -c switch, so that unconditionally adding it here
+  # would presumably be a Bad Thing   -- sburke@cpan.org
 
   $command .= " | col -x" if Pod::Perldoc::IS_HPUX;
   
index e46c9c5..c48d414 100644 (file)
@@ -1,5 +1,5 @@
 # Term::ANSIColor -- Color screen output using ANSI escape sequences.
-# $Id: ANSIColor.pm,v 1.8 2004/02/20 06:21:26 eagle Exp $
+# $Id: ANSIColor.pm,v 1.9 2004/12/04 01:29:12 eagle Exp $
 #
 # Copyright 1996, 1997, 1998, 2000, 2001, 2002
 #   by Russ Allbery <rra@stanford.edu> and Zenin <zenin@bawdycaste.com>
@@ -34,7 +34,7 @@ Exporter::export_ok_tags ('constants');
 
 # Don't use the CVS revision as the version, since this module is also in Perl
 # core and too many things could munge CVS magic revision strings.
-$VERSION = 1.08;
+$VERSION = 1.09;
 
 ##############################################################################
 # Internal data structures
@@ -424,12 +424,14 @@ me flesh it out:
  PuTTY         yes     color     no      yes      no       yes      no
  Windows       yes      no       no      no       no       yes      no
  Cygwin SSH    yes      yes      no     color    color    color     yes
-
-Windows is Windows telnet, and Cygwin SSH is the OpenSSH implementation under
-Cygwin on Windows NT.  Where the entry is other than yes or no, that emulator
-displays the given attribute as something else instead.  Note that on an
-aixterm, clear doesn't reset colors; you have to explicitly set the colors
-back to what you want.  More entries in this table are welcome.
+ Mac Terminal  yes      yes      no      yes      yes      yes      yes
+
+Windows is Windows telnet, Cygwin SSH is the OpenSSH implementation under
+Cygwin on Windows NT, and Mac Terminal is the Terminal application in Mac OS
+X.  Where the entry is other than yes or no, that emulator displays the
+given attribute as something else instead.  Note that on an aixterm, clear
+doesn't reset colors; you have to explicitly set the colors back to what you
+want.  More entries in this table are welcome.
 
 Note that codes 3 (italic), 6 (rapid blink), and 9 (strikethrough) are
 specified in ANSI X3.64 and ECMA-048 but are not commonly supported by most
index a5d95ff..c98596e 100644 (file)
@@ -1,3 +1,14 @@
+2004-12-03  Russ Allbery  <rra@stanford.edu>
+
+       * ANSIColor.pm: Version 1.09 released.
+
+       * ANSIColor.pm: Add compatibility information for Mac OS X
+       Terminal from Daniel Lindsley.
+
+2004-02-20  Russ Allbery  <rra@stanford.edu>
+
+       * test.pl: Always use eq, not ==, for string comparisons.
+
 2004-02-19  Russ Allbery  <rra@stanford.edu>
 
        * ANSIColor.pm: Version 1.08 released.
index 8b9c2ad..016df9f 100644 (file)
@@ -1,4 +1,4 @@
-                       Term::ANSIColor version 1.08
+                       Term::ANSIColor version 1.09
               (A simple ANSI text attribute control module)
 
   Copyright 1996, 1997, 1998, 2000, 2001, 2002
@@ -90,4 +90,10 @@ THANKS
   To Richard Maus for pointing out DARK was missing from the exported
   constants list and CYAN and WHITE were missing from the documentation.
 
+  To Autrijus Tang for noticing a problem with string comparisons in the
+  test suite.
+
+  To Daniel Lindsley for the information about what Mac OS X Terminal
+  supports.
+
   To Larry Wall, as always, for Perl.
index b9d4b18..123a353 100755 (executable)
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: test.pl,v 1.3 2004/02/20 06:21:26 eagle Exp $
+# $Id: test.pl,v 1.4 2004/02/20 21:50:10 eagle Exp $
 #
 # test.pl -- Test suite for the Term::ANSIColor Perl module.
 #
@@ -91,12 +91,12 @@ if (join ('|', @names) eq 'bold|on_green|clear') {
 
 # Test ANSI_COLORS_DISABLED.
 $ENV{ANSI_COLORS_DISABLED} = 1;
-if (color ('blue') == '') {
+if (color ('blue') eq '') {
     print "ok 10\n";
 } else {
     print "not ok 10\n";
 }
-if (colored ('testing', 'blue', 'on_red') == 'testing') {
+if (colored ('testing', 'blue', 'on_red') eq 'testing') {
     print "ok 11\n";
 } else {
     print "not ok 11\n";
index 54bd199..9f6a3a4 100644 (file)
@@ -8,7 +8,7 @@ $^C ||= 0;
 
 use strict;
 use vars qw($VERSION);
-$VERSION = '0.21';
+$VERSION = '0.22';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 # Make Test::Builder thread-safe for ithreads.
@@ -145,7 +145,6 @@ my $Curr_Test;     share($Curr_Test);
 use vars qw($Level);
 my $Original_Pid;
 my @Test_Results;  share(@Test_Results);
-my @Test_Details;  share(@Test_Details);
 
 my $Exported_To;
 my $Expected_Tests;
@@ -168,7 +167,6 @@ sub reset {
     $Level     = 1;
     $Original_Pid = $$;
     @Test_Results = ();
-    @Test_Details = ();
 
     $Exported_To    = undef;
     $Expected_Tests = 0;
@@ -639,16 +637,26 @@ could be written as:
 
 
 sub maybe_regex {
-       my ($self, $regex) = @_;
+    my ($self, $regex) = @_;
     my $usable_regex = undef;
+
+    return $usable_regex unless defined $regex;
+
+    my($re, $opts);
+
+    # Check for qr/foo/
     if( ref $regex eq 'Regexp' ) {
         $usable_regex = $regex;
     }
-    # Check if it looks like '/foo/'
-    elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
+    # Check for '/foo/' or 'm,foo,'
+    elsif( ($re, $opts)        = $regex =~ m{^ /(.*)/ (\w*) $ }sx           or
+           (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
+         )
+    {
         $usable_regex = length $opts ? "(?$opts)$re" : $re;
-    };
-    return($usable_regex)
+    }
+
+    return $usable_regex;
 };
 
 sub _regex_ok {
@@ -781,7 +789,9 @@ sub skip {
 
     my $out = "ok";
     $out   .= " $Curr_Test" if $self->use_numbers;
-    $out   .= " # skip $why\n";
+    $out   .= " # skip";
+    $out   .= " $why"       if length $why;
+    $out   .= "\n";
 
     $Test->_print($out);
 
@@ -1120,22 +1130,37 @@ sub todo_output {
     return $Todo_FH;
 }
 
+
 sub _new_fh {
     my($file_or_fh) = shift;
 
     my $fh;
-    unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
+    if( _is_fh($file_or_fh) ) {
+        $fh = $file_or_fh;
+    }
+    else {
         $fh = do { local *FH };
         open $fh, ">$file_or_fh" or 
             die "Can't open test output log $file_or_fh: $!";
     }
-    else {
-        $fh = $file_or_fh;
-    }
 
     return $fh;
 }
 
+
+sub _is_fh {
+    my $maybe_fh = shift;
+
+    return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
+
+    return UNIVERSAL::isa($maybe_fh,               'GLOB')       ||
+           UNIVERSAL::isa($maybe_fh,               'IO::Handle') ||
+
+           # 5.5.4's tied() and can() doesn't like getting undef
+           UNIVERSAL::can((tied($maybe_fh) || ''), 'TIEHANDLE');
+}
+
+
 sub _autoflush {
     my($fh) = shift;
     my $old_fh = select $fh;
@@ -1183,9 +1208,12 @@ sub _open_testhandles {
     my $curr_test = $Test->current_test;
     $Test->current_test($num);
 
-Gets/sets the current test # we're on.
+Gets/sets the current test number we're on.  You usually shouldn't
+have to set this.
 
-You usually shouldn't have to set this.
+If set forward, the details of the missing tests are filled in as 'unknown'.
+if set backward, the details of the intervening tests are deleted.  You
+can erase history if you really want to.
 
 =cut
 
@@ -1200,6 +1228,8 @@ sub current_test {
         }
 
         $Curr_Test = $num;
+
+        # If the test counter is being pushed forward fill in the details.
         if( $num > @Test_Results ) {
             my $start = @Test_Results ? $#Test_Results + 1 : 0;
             for ($start..$num-1) {
@@ -1212,6 +1242,10 @@ sub current_test {
                 });
             }
         }
+        # If backward, wipe history.  Its their funeral.
+        elsif( $num < @Test_Results ) {
+            $#Test_Results = $num - 1;
+        }
     }
     return $Curr_Test;
 }
index 8f029e6..aa02808 100644 (file)
@@ -18,7 +18,7 @@ sub _carp {
 
 require Exporter;
 use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.53';
+$VERSION = '0.54';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 @ISA    = qw(Exporter);
@@ -855,8 +855,10 @@ the easiest way to illustrate:
 If the user does not have HTML::Lint installed, the whole block of
 code I<won't be run at all>.  Test::More will output special ok's
 which Test::Harness interprets as skipped, but passing, tests.
+
 It's important that $how_many accurately reflects the number of tests
 in the SKIP block so the # of tests run will match up with your plan.
+If your plan is C<no_plan> $how_many is optional and will default to 1.
 
 It's perfectly safe to nest SKIP blocks.  Each SKIP block must have
 the label C<SKIP>, or Test::More can't work its magic.
@@ -874,7 +876,7 @@ sub skip {
     unless( defined $how_many ) {
         # $how_many can only be avoided when no_plan is in use.
         _carp "skip() needs to know \$how_many tests are in the block"
-          unless $Test::Builder::No_Plan;
+          unless $Test->has_plan eq 'no_plan';
         $how_many = 1;
     }
 
@@ -954,7 +956,7 @@ sub todo_skip {
     unless( defined $how_many ) {
         # $how_many can only be avoided when no_plan is in use.
         _carp "todo_skip() needs to know \$how_many tests are in the block"
-          unless $Test::Builder::No_Plan;
+          unless $Test->has_plan eq 'no_plan';
         $how_many = 1;
     }
 
@@ -1084,6 +1086,19 @@ sub _format_stack {
 }
 
 
+sub _type {
+    my $thing = shift;
+
+    return '' if !ref $thing;
+
+    for my $type (qw(ARRAY HASH REF SCALAR GLOB Regexp)) {
+        return $type if UNIVERSAL::isa($thing, $type);
+    }
+
+    return '';
+}
+
+
 =item B<eq_array>
 
   eq_array(\@this, \@that);
@@ -1103,7 +1118,7 @@ sub eq_array {
 sub _eq_array  {
     my($a1, $a2) = @_;
 
-    if( grep !UNIVERSAL::isa($_, 'ARRAY'), $a1, $a2 ) {
+    if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) {
         warn "eq_array passed a non-array ref";
         return 0;
     }
@@ -1156,34 +1171,29 @@ sub _deep_check {
             $ok = 1;
         }
         else {
-            if( UNIVERSAL::isa($e1, 'ARRAY') and
-                UNIVERSAL::isa($e2, 'ARRAY') )
-            {
+            my $type = _type($e1);
+            $type = '' unless _type($e2) eq $type;
+
+            if( !$type ) {
+                push @Data_Stack, { vals => [$e1, $e2] };
+                $ok = 0;
+            }
+            elsif( $type eq 'ARRAY' ) {
                 $ok = _eq_array($e1, $e2);
             }
-            elsif( UNIVERSAL::isa($e1, 'HASH') and
-                   UNIVERSAL::isa($e2, 'HASH') )
-            {
+            elsif( $type eq 'HASH' ) {
                 $ok = _eq_hash($e1, $e2);
             }
-            elsif( UNIVERSAL::isa($e1, 'REF') and
-                   UNIVERSAL::isa($e2, 'REF') )
-            {
+            elsif( $type eq 'REF' ) {
                 push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
                 $ok = _deep_check($$e1, $$e2);
                 pop @Data_Stack if $ok;
             }
-            elsif( UNIVERSAL::isa($e1, 'SCALAR') and
-                   UNIVERSAL::isa($e2, 'SCALAR') )
-            {
+            elsif( $type eq 'SCALAR' ) {
                 push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
                 $ok = _deep_check($$e1, $$e2);
                 pop @Data_Stack if $ok;
             }
-            else {
-                push @Data_Stack, { vals => [$e1, $e2] };
-                $ok = 0;
-            }
         }
     }
 
@@ -1209,7 +1219,7 @@ sub eq_hash {
 sub _eq_hash {
     my($a1, $a2) = @_;
 
-    if( grep !UNIVERSAL::isa($_, 'HASH'), $a1, $a2 ) {
+    if( grep !_type($_) eq 'HASH', $a1, $a2 ) {
         warn "eq_hash passed a non-hash ref";
         return 0;
     }
index ea3f119..05b4dd5 100644 (file)
@@ -4,7 +4,7 @@ use 5.004;
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '0.53';
+$VERSION = '0.54';
 $VERSION = eval $VERSION;    # make the alpha version come out as a number
 
 
index 083d97f..f9e6483 100644 (file)
@@ -1,3 +1,18 @@
+0.54  Wed Dec 15 04:18:43 EST 2004
+    * $how_many is optional for skip() and todo_skip().  Thanks to 
+      Devel::Cover for pointing this out.
+    - Removed a user defined function called err() in the tests to placate
+      users of older versions of the dor patch before err() was weakend.
+      [rt.cpan.org 8734]
+
+0.53_01  Sat Dec 11 19:02:18 EST 2004
+    - current_test() can now be set backward.
+    - *output() methods now handle tied handles and *FOO{IO} properly.
+    - maybe_regex() now handles undef gracefully.
+    - maybe_regex() now handles 'm,foo,' style regexes.
+    - sort_bug.t wasn't checking for threads properly.  Would fail on
+      5.6 that had ithreads compiled in. [rt.cpan.org 8765]
+
 0.53  Mon Nov 29 04:43:24 EST 2004
     - Apparently its possible to have Module::Signature installed without
       it being functional.  Fixed the signature test to account for this.
index 65dcf8d..bd0ea9b 100644 (file)
@@ -14,7 +14,7 @@ use Test::More;
 use Test::Builder;
 my $Test = Test::Builder->new;
 
-$Test->plan( tests => 8 );
+$Test->plan( tests => 9 );
 $Test->level(0);
 
 my @Expected_Details;
@@ -29,11 +29,13 @@ push @Expected_Details, { 'ok'      => 1,
 
 # Inline TODO tests will confuse pre 1.20 Test::Harness, so we
 # should just avoid the problem and not print it out.
-my $out_fh = $Test->output;
+my $out_fh  = $Test->output;
+my $todo_fh = $Test->todo_output;
 my $start_test = $Test->current_test + 1;
 require TieOut;
 tie *FH, 'TieOut';
 $Test->output(\*FH);
+$Test->todo_output(\*FH);
 
 SKIP: {
     $Test->skip( 'just testing skip' );
@@ -67,6 +69,7 @@ push @Expected_Details, { 'ok'      => 1,
 
 for ($start_test..$Test->current_test) { print "ok $_\n" }
 $Test->output($out_fh);
+$Test->todo_output($todo_fh);
 
 $Test->is_num( scalar $Test->summary(), 4,   'summary' );
 push @Expected_Details, { 'ok'      => 1,
@@ -91,3 +94,14 @@ $Test->is_num( scalar @details, 6,
 
 $Test->level(1);
 is_deeply( \@details, \@Expected_Details );
+
+
+# This test has to come last because it thrashes the test details.
+{
+    my $curr_test = $Test->current_test;
+    $Test->current_test(4);
+    my @details = $Test->details();
+
+    $Test->current_test($curr_test);
+    $Test->is_num( scalar @details, 4 );
+}
index ab18b5b..2086df2 100644 (file)
@@ -38,7 +38,7 @@ sub ok ($;$) {
 }
 
 
-sub main::err ($) {
+sub main::err_ok ($) {
     my($expect) = @_;
     my $got = $err->read;
 
@@ -65,7 +65,7 @@ $tb->use_numbers(0);
 # Preserve the line numbers.
 #line 38
 ok( 0, 'failing' );
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 38)
 ERR
 
@@ -74,7 +74,7 @@ is( "foo", "bar", 'foo is bar?');
 is( undef, '',    'undef is empty string?');
 is( undef, 0,     'undef is 0?');
 is( '',    0,     'empty string is 0?' );
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 40)
 #          got: 'foo'
 #     expected: 'bar'
@@ -93,7 +93,7 @@ ERR
 isnt("foo", "foo", 'foo isnt foo?' );
 isn't("foo", "foo",'foo isn\'t foo?' );
 isnt(undef, undef, 'undef isnt undef?');
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 45)
 #     'foo'
 #         ne
@@ -111,7 +111,7 @@ ERR
 #line 48
 like( "foo", '/that/',  'is foo like that' );
 unlike( "foo", '/foo/', 'is foo unlike foo' );
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 48)
 #                   'foo'
 #     doesn't match '/that/'
@@ -122,21 +122,21 @@ ERR
 
 # Nick Clark found this was a bug.  Fixed in 0.40.
 like( "bug", '/(%)/',   'regex with % in it' );
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 60)
 #                   'bug'
 #     doesn't match '/(%)/'
 ERR
 
 fail('fail()');
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 67)
 ERR
 
 #line 52
 can_ok('Mooble::Hooble::Yooble', qw(this that));
 can_ok('Mooble::Hooble::Yooble', ());
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 52)
 #     Mooble::Hooble::Yooble->can('this') failed
 #     Mooble::Hooble::Yooble->can('that') failed
@@ -149,7 +149,7 @@ isa_ok(bless([], "Foo"), "Wibble");
 isa_ok(42,    "Wibble", "My Wibble");
 isa_ok(undef, "Wibble", "Another Wibble");
 isa_ok([],    "HASH");
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 55)
 #     The object isn't a 'Wibble' it's a 'Foo'
 #     Failed test ($0 at line 56)
@@ -168,7 +168,7 @@ cmp_ok( 1,     '&&', 0    , '       &&' );
 cmp_ok( 42,    '==', "foo", '       == with strings' );
 cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
 cmp_ok( undef, 'eq', 'foo', '       eq with undef' );
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 68)
 #          got: 'foo'
 #     expected: 'bar'
@@ -201,7 +201,7 @@ my $Errno_String = $!.'';
 #line 80
 cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
 cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
-err( <<ERR );
+err_ok( <<ERR );
 #     Failed test ($0 at line 80)
 #          got: '$Errno_String'
 #     expected: ''
@@ -264,6 +264,8 @@ ERR
     unless( My::Test::ok($$err =~ /^$more_err_re$/, 
                          'failing errors') ) {
         print $$err;
+        print "regex:\n";
+        print $more_err_re;
     }
 
     exit(0);
index be4bb85..fac5a7f 100644 (file)
@@ -37,7 +37,7 @@ sub ok ($;$) {
 }
 
 
-sub main::err ($) {
+sub main::err_ok ($) {
     my($expect) = @_;
     my $got = $err->read;
 
@@ -63,13 +63,13 @@ Test::More->builder->no_ending(1);
 
 #line 62
     fail( "this fails" );
-    err( <<ERR );
+    err_ok( <<ERR );
 #     Failed test ($0 at line 62)
 ERR
 
 #line 72
     is( 1, 0 );
-    err( <<ERR );
+    err_ok( <<ERR );
 #     Failed test ($0 at line 72)
 #          got: '1'
 #     expected: '0'
@@ -81,7 +81,7 @@ ERR
                    
 #line 71
     fail( "this fails" );
-    err( <<ERR );
+    err_ok( <<ERR );
 
 #     Failed test ($0 at line 71)
 ERR
@@ -89,7 +89,7 @@ ERR
 
 #line 84
     is( 1, 0 );
-    err( <<ERR );
+    err_ok( <<ERR );
 
 #     Failed test ($0 at line 84)
 #          got: '1'
index aa947d2..c6b1625 100644 (file)
@@ -23,7 +23,7 @@ local $ENV{HARNESS_ACTIVE} = 0;
 # Can't use Test.pm, that's a 5.005 thing.
 package main;
 
-print "1..34\n";
+print "1..38\n";
 
 my $test_num = 1;
 # Utility testing functions.
@@ -279,3 +279,25 @@ is( $err, <<ERR,        '    right diagnostic' );
 #          \$got->[1] = 'b'
 #     \$expected->[1] = 'c'
 ERR
+
+
+#line 285
+my $ref = \23;
+is_deeply( 23, $ref );
+is( $out, "not ok 21\n", 'scalar vs ref' );
+is( $err, <<ERR,        '  right diagnostic');
+#     Failed test ($0 at line 286)
+#     Structures begin differing at:
+#          \$got = '23'
+#     \$expected = '$ref'
+ERR
+
+#line 296
+is_deeply( $ref, 23 );
+is( $out, "not ok 22\n", 'ref vs scalar' );
+is( $err, <<ERR,        '  right diagnostic');
+#     Failed test ($0 at line 296)
+#     Structures begin differing at:
+#          \$got = '$ref'
+#     \$expected = '23'
+ERR
diff --git a/lib/Test/Simple/t/is_fh.t b/lib/Test/Simple/t/is_fh.t
new file mode 100644 (file)
index 0000000..f3da6b7
--- /dev/null
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Test::More tests => 6;
+use TieOut;
+
+ok( !Test::Builder::_is_fh("foo"), 'string is not a filehandle' );
+
+ok( open(FILE, '>foo') );
+END { unlink 'foo' }
+
+ok( Test::Builder::_is_fh(*FILE) );
+ok( Test::Builder::_is_fh(\*FILE) );
+ok( Test::Builder::_is_fh(*FILE{IO}) );
+
+tie *OUT, 'TieOut';
+ok( Test::Builder::_is_fh(*OUT) );
\ No newline at end of file
index dcc84f4..e4d7506 100644 (file)
@@ -11,7 +11,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 10;
+use Test::More tests => 13;
 
 use Test::Builder;
 my $Test = Test::Builder->new;
@@ -48,3 +48,11 @@ SKIP: {
        ok(('f00' =~ m/$r/), '"//" good match');
        ok(('b4r' !~ m/$r/), '"//" bad match');
 };
+
+
+{
+       my $r = $Test->maybe_regex('m,foo,i');
+       ok(defined $r, 'm,, detected');
+       ok(('fOO' =~ m/$r/), '"//" good match');
+       ok(('bar' !~ m/$r/), '"//" bad match');
+};
index 6ae06bf..8c4492a 100644 (file)
@@ -29,3 +29,24 @@ plan 'no_plan';
 
 pass('Just testing');
 ok(1, 'Testing again');
+
+{
+    my $warning = '';
+    local $SIG{__WARN__} = sub { $warning = join "", @_ };
+    SKIP: {
+        skip 'Just testing skip with no_plan';
+        fail("So very failed");
+    }
+    is( $warning, '', 'skip with no "how_many" ok with no_plan' );
+
+
+    $warning = '';
+    TODO: {
+        todo_skip "Just testing todo_skip";
+
+        fail("Just testing todo");
+        die "todo_skip should prevent this";
+        pass("Again");
+    }
+    is( $warning, '', 'skip with no "how_many" ok with no_plan' );
+}
index f99212a..aad806c 100644 (file)
@@ -17,21 +17,21 @@ use strict;
 use Config;
 
 BEGIN {
-    require threads if $Config{useithreads};
+    unless ( $] >= 5.008 && $Config{'useithreads'} && 
+             eval { require threads; 'threads'->import; 1; }) 
+    {
+        print "1..0 # Skip: no threads\n";
+        exit 0;
+    }
 }
 use Test::More;
 
 # Passes with $nthreads = 1 and with eq_set().
 # Passes with $nthreads = 2 and with eq_array().
 # Fails  with $nthreads = 2 and with eq_set().
-my $nthreads = 2;
+my $Num_Threads = 2;
 
-if( $Config{useithreads} ) {
-    plan tests => $nthreads;
-}
-else {
-    plan skip_all => 'no threads';
-}
+plan tests => $Num_Threads;
 
 
 sub do_one_thread {
@@ -52,7 +52,7 @@ sub do_one_thread {
 }
 
 my @kids = ();
-for my $i (1..$nthreads) {
+for my $i (1..$Num_Threads) {
     my $t = threads->new(\&do_one_thread, $i);
     print "# parent $$: continue\n";
     push(@kids, $t);
index 88b2e15..14a7b00 100644 (file)
@@ -10,15 +10,18 @@ BEGIN {
 require Test::Harness;
 use Test::More;
 
-# This feature requires a fairly new version of Test::Harness
-(my $th_version = $Test::Harness::VERSION) =~ s/_//; # for X.Y_Z alpha versions
+# Shut up a "used only once" warning in 5.5.4.
+my $th_version  = $Test::Harness::VERSION = $Test::Harness::VERSION;
+$th_version =~ s/_//;   # for X.Y_Z alpha versions
+
+# TODO requires a fairly new version of Test::Harness
 if( $th_version < 2.03 ) {
     plan tests => 1;
     fail "Need Test::Harness 2.03 or up.  You have $th_version.";
     exit;
 }
 
-plan tests => 16;
+plan tests => 18;
 
 
 $Why = 'Just testing the todo interface.';
@@ -69,3 +72,20 @@ TODO: {
     die "todo_skip should prevent this";
     pass("Again");
 }
+
+
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning = join "", @_ };
+    TODO: {
+        # perl gets the line number a little wrong on the first
+        # statement inside a block.
+        1 == 1;
+#line 82
+        todo_skip "Just testing todo_skip";
+        fail("So very failed");
+    }
+    is( $warning, "todo_skip() needs to know \$how_many tests are in the ".
+                  "block at $0 line 82\n",
+        'todo_skip without $how_many warning' );
+}
index 00ce8b1..e9180bb 100644 (file)
@@ -11,7 +11,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 14;
+use Test::More tests => 16;
 use TieOut;
 
 BEGIN { $^W = 1; }
@@ -58,3 +58,8 @@ $tb->failure_output($old_fail);
 
 is( $caught->read, "# undef\n" );
 is( $warnings, '',          'diag(undef)  no warnings' );
+
+
+$tb->maybe_regex(undef);
+is( $caught->read, '' );
+is( $warnings, '',          'maybe_regex(undef) no warnings' );