From: Michael G. Schwern <schwern@pobox.com>
Date: Thu, 30 Jun 2005 01:02:30 +0000 (-0700)
Subject: Re: [PATCH] Convert File::Basename tests to Test::More
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e7204fba500967d2552f87b7859dd611261aa85a;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] Convert File::Basename tests to Test::More
Message-ID: <20050630080230.GC17965@windhund.schwern.org>

p4raw-id: //depot/perl@25017
---

diff --git a/lib/File/Basename.t b/lib/File/Basename.t
index 32d9bfb..b1719af 100755
--- a/lib/File/Basename.t
+++ b/lib/File/Basename.t
@@ -1,144 +1,139 @@
-#!./perl -T
+#!./perl -Tw
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
 
-use File::Basename qw(fileparse basename dirname);
+use Test::More 'no_plan';
 
-print "1..41\n";
+BEGIN { use_ok 'File::Basename' }
 
 # import correctly?
-print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
-        '' : 'not '),"ok 1\n";
+can_ok( __PACKAGE__, qw( basename fileparse dirname fileparse_set_fstype ) );
+
+### Testing Unix
+{
+    ok length fileparse_set_fstype('unix'), 'set fstype to unix';
+
+    my($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',
+                                      qr'\.book\d+');
+    is($base, 'draft');
+    is($path, '/virgil/aeneid/');
+    is($type, '.book7');
+
+    is(basename('/arma/virumque.cano'), 'virumque.cano');
+    is(dirname ('/arma/virumque.cano'), '/arma');
+    is(dirname('arma/'), '.');
+    is(dirname('/'), '/');
+}
 
-# set fstype -- should replace non-null default
-print +(length(File::Basename::fileparse_set_fstype('unix')) ?
-        '' : 'not '),"ok 2\n";
 
-# Unix syntax tests
-($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7',qr'\.book\d+');
-if ($base eq 'draft' and $path eq '/virgil/aeneid/' and $type eq '.book7') {
-  print "ok 3\n";
-}
-else {
-  print "not ok 3	|$base|$path|$type|\n";
-}
-print +(basename('/arma/virumque.cano') eq 'virumque.cano' ?
-        '' : 'not '),"ok 4\n";
-print +(dirname('/arma/virumque.cano') eq '/arma' ? '' : 'not '),"ok 5\n";
-print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 6\n";
-print +(dirname('/') eq '/' ? '' : 'not '),"ok 7\n";
+### Testing VMS
+{
+    is(fileparse_set_fstype('VMS'), 'unix', 'set fstype to VMS');
 
+    my($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7',
+                                      qr{\.book\d+});
+    is($base, 'draft');
+    is($path, 'virgil:[aeneid]');
+    is($type, '.book7');
 
-# set fstype -- should replace non-null default
-print +(File::Basename::fileparse_set_fstype('VMS') eq 'unix' ?
-        '' : 'not '),"ok 8\n";
+    is(basename('arma:[virumque]cano.trojae'), 'cano.trojae');
+    is(dirname('arma:[virumque]cano.trojae'),  'arma:[virumque]');
+    is(dirname('arma:<virumque>cano.trojae'),  'arma:<virumque>');
+    is(dirname('arma:virumque.cano'), 'arma:');
 
-# VMS syntax tests
-($base,$path,$type) = fileparse('virgil:[aeneid]draft.book7',qr{\.book\d+});
-if ($base eq 'draft' and $path eq 'virgil:[aeneid]' and $type eq '.book7') {
-  print "ok 9\n";
-}
-else {
-  print "not ok 9	|$base|$path|$type|\n";
-}
-print +(basename('arma:[virumque]cano.trojae') eq 'cano.trojae' ?
-        '' : 'not '),"ok 10\n";
-print +(dirname('arma:[virumque]cano.trojae') eq 'arma:[virumque]' ?
-        '' : 'not '),"ok 11\n";
-print +(dirname('arma:<virumque>cano.trojae') eq 'arma:<virumque>' ?
-        '' : 'not '),"ok 12\n";
-print +(dirname('arma:virumque.cano') eq 'arma:' ? '' : 'not '),"ok 13\n";
-$ENV{DEFAULT} = '' unless exists $ENV{DEFAULT};
-print +(dirname('virumque.cano') eq $ENV{DEFAULT} ? '' : 'not '),"ok 14\n";
-print +(dirname('arma/') eq '.' ? '' : 'not '),"ok 15\n";
-
-# set fstype -- should replace non-null default
-print +(File::Basename::fileparse_set_fstype('MSDOS') eq 'VMS' ?
-        '' : 'not '),"ok 16\n";
-
-# MSDOS syntax tests
-($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7','\.book\d+');
-if ($base eq 'draft' and $path eq 'C:\\virgil\\aeneid\\' and $type eq '.book7') {
-  print "ok 17\n";
-}
-else {
-  print "not ok 17	|$base|$path|$type|\n";
+    {
+        local $ENV{DEFAULT} = '' unless exists $ENV{DEFAULT};
+        is(dirname('virumque.cano'), $ENV{DEFAULT});
+        is(dirname('arma/'), '.');
+    }
 }
-print +(basename('A:virumque\\cano.trojae') eq 'cano.trojae' ?
-        '' : 'not '),"ok 18\n";
-print +(dirname('A:\\virumque\\cano.trojae') eq 'A:\\virumque' ?
-        '' : 'not '),"ok 19\n";
-print +(dirname('A:\\') eq 'A:\\' ? '' : 'not '),"ok 20\n";
-print +(dirname('arma\\') eq '.' ? '' : 'not '),"ok 21\n";
 
-# Yes "/" is a legal path separator under MSDOS
-basename("lib/File/Basename.pm") eq "Basename.pm" or print "not ";
-print "ok 22\n";
 
+### Testing MSDOS
+{
+    is(fileparse_set_fstype('MSDOS'), 'VMS', 'set fstype to MSDOS');
 
+    my($base,$path,$type) = fileparse('C:\\virgil\\aeneid\\draft.book7',
+                                      '\.book\d+');
+    is($base, 'draft');
+    is($path, 'C:\\virgil\\aeneid\\');
+    is($type, '.book7');
 
-# set fstype -- should replace non-null default
-print +(File::Basename::fileparse_set_fstype('MacOS') eq 'MSDOS' ?
-        '' : 'not '),"ok 23\n";
+    is(basename('A:virumque\\cano.trojae'),  'cano.trojae');
+    is(dirname('A:\\virumque\\cano.trojae'), 'A:\\virumque');
+    is(dirname('A:\\'), 'A:\\');
+    is(dirname('arma\\'), '.');
 
-# MacOS syntax tests
-($base,$path,$type) = fileparse('virgil:aeneid:draft.book7','\.book\d+');
-if ($base eq 'draft' and $path eq 'virgil:aeneid:' and $type eq '.book7') {
-  print "ok 24\n";
+    # Yes "/" is a legal path separator under MSDOS
+    is(basename("lib/File/Basename.pm"), "Basename.pm");
 }
-else {
-  print "not ok 24	|$base|$path|$type|\n";
-}
-print +(basename(':arma:virumque:cano.trojae') eq 'cano.trojae' ?
-        '' : 'not '),"ok 25\n";
-print +(dirname(':arma:virumque:cano.trojae') eq ':arma:virumque:' ?
-        '' : 'not '),"ok 26\n";
-print +(dirname(':arma:virumque:') eq ':arma:' ? '' : 'not '),"ok 27\n";
-print +(dirname(':arma:virumque') eq ':arma:' ? '' : 'not '),"ok 28\n";
-print +(dirname(':arma:') eq ':' ? '' : 'not '),"ok 29\n";
-print +(dirname(':arma') eq ':' ? '' : 'not '),"ok 30\n";
-print +(dirname('arma:') eq 'arma:' ? '' : 'not '),"ok 31\n";
-print +(dirname('arma') eq ':' ? '' : 'not '),"ok 32\n";
-print +(dirname(':') eq ':' ? '' : 'not '),"ok 33\n";
-
-
-# Check quoting of metacharacters in suffix arg by basename()
-print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
-        '' : 'not '),"ok 34\n";
-print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
-        '' : 'not '),"ok 35\n";
-
-# extra tests for a few specific bugs
-
-File::Basename::fileparse_set_fstype 'MSDOS';
-# perl5.003_18 gives C:/perl/.\
-print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 36\n";
-# perl5.003_18 gives C:\perl\
-print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 37\n";
-
-File::Basename::fileparse_set_fstype 'UNIX';
-# perl5.003_18 gives '.'
-print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 38\n";
-# perl5.003_18 gives '/perl/lib'
-print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 39\n";
-
-#   The empty tainted value, for tainting strings
-my $TAINT = substr($^X, 0, 0);
-# How to identify taint when you see it
-sub any_tainted (@) {
-    not eval { join("",@_), kill 0; 1 };
-}
-sub tainted ($) {
-    any_tainted @_;
+
+
+### Testing MacOS
+{
+    is(fileparse_set_fstype('MacOS'), 'MSDOS', 'set fstype to MacOS');
+
+    my($base,$path,$type) = fileparse('virgil:aeneid:draft.book7',
+                                      '\.book\d+');
+    is($base, 'draft');
+    is($path, 'virgil:aeneid:');
+    is($type, '.book7');
+
+    is(basename(':arma:virumque:cano.trojae'), 'cano.trojae');
+    is(dirname(':arma:virumque:cano.trojae'),  ':arma:virumque:');
+    is(dirname(':arma:virumque:'), ':arma:');
+    is(dirname(':arma:virumque'), ':arma:');
+    is(dirname(':arma:'), ':');
+    is(dirname(':arma'),  ':');
+    is(dirname('arma:'), 'arma:');
+    is(dirname('arma'), ':');
+    is(dirname(':'), ':');
+
+
+    # Check quoting of metacharacters in suffix arg by basename()
+    is(basename(':arma:virumque:cano.trojae','.trojae'), 'cano');
+    is(basename(':arma:virumque:cano_trojae','.trojae'), 'cano_trojae');
 }
-sub all_tainted (@) {
-    for (@_) { return 0 unless tainted $_ }
-    1;
+
+
+### extra tests for a few specific bugs
+{
+    fileparse_set_fstype 'MSDOS';
+    # perl5.003_18 gives C:/perl/.\
+    is((fileparse 'C:/perl/lib')[1], 'C:/perl/');
+    # perl5.003_18 gives C:\perl\
+    is(dirname('C:\\perl\\lib\\'), 'C:\\perl');
+
+    fileparse_set_fstype 'UNIX';
+    # perl5.003_18 gives '.'
+    is(dirname('/perl/'), '/');
+    # perl5.003_18 gives '/perl/lib'
+    is(dirname('/perl/lib//'), '/perl');
 }
 
-print +(tainted(dirname($TAINT.'/perl/lib//')) ? '' : 'not '), "ok 40\n";
-print +(all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'))
-		? '' : 'not '), "ok 41\n";
+
+### Test tainting
+{
+    #   The empty tainted value, for tainting strings
+    my $TAINT = substr($^X, 0, 0);
+
+    # How to identify taint when you see it
+    sub any_tainted (@) {
+        return ! eval { eval("#" . substr(join("", @_), 0, 0)); 1 };
+    }
+
+    sub tainted ($) {
+        any_tainted @_;
+    }
+
+    sub all_tainted (@) {
+        for (@_) { return 0 unless tainted $_ }
+        1;
+    }
+
+    ok tainted(dirname($TAINT.'/perl/lib//'));
+    ok all_tainted(fileparse($TAINT.'/dir/draft.book7','\.book\d+'));
+}