From e7204fba500967d2552f87b7859dd611261aa85a Mon Sep 17 00:00:00 2001 From: "Michael G. Schwern" Date: Wed, 29 Jun 2005 18:02:30 -0700 Subject: [PATCH] Re: [PATCH] Convert File::Basename tests to Test::More Message-ID: <20050630080230.GC17965@windhund.schwern.org> p4raw-id: //depot/perl@25017 --- lib/File/Basename.t | 235 +++++++++++++++++++++++++--------------------------- 1 file changed, 115 insertions(+), 120 deletions(-) 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:cano.trojae'), 'arma:'); + 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:cano.trojae') eq 'arma:' ? - '' : '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+')); +} -- 2.7.4