From: Perl 5 Porters <perl5-porters@africa.nicoh.com>
Date: Mon, 30 Sep 1996 04:54:37 +0000 (-0400)
Subject: perl 5.003_06: t/lib/basename.t
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=782014036373aee8ffee0c1b2c77f3a283d90dc7;p=p5sagit%2Fp5-mst-13.2.git

perl 5.003_06: t/lib/basename.t

Date: Sun, 22 Sep 1996 00:59:56 +0200
From: Gisle Aas <aas@aas.no>
Subject: More standard library test scripts

This is a collection of test scripts for the standard library modules.
Some of the tests does not pass unless some of the patches I have sent
out are applied.

Date: Mon, 30 Sep 1996 00:54:37 -0400
From: Spider Boardman <spider@Orb.Nashua.NH.US>

Fix the number of tests.

Date: Thu, 03 Oct 1996 16:31:46 -0400 (EDT)
From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU>
Subject: VMS patches to 5.003_05

A different set of tests for File::Basename and friends.
---

diff --git a/t/lib/basename.t b/t/lib/basename.t
new file mode 100644
index 0000000..56b1f7f
--- /dev/null
+++ b/t/lib/basename.t
@@ -0,0 +1,107 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use File::Basename qw(fileparse basename dirname);
+
+print "1..30\n";
+
+# import correctly?
+print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
+        '' : 'not '),"ok 1\n";
+
+# 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','\.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";
+
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('VMS') eq 'unix' ?
+        '' : 'not '),"ok 8\n";
+
+# VMS 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 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";
+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";
+}
+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";
+
+
+
+# set fstype -- should replace non-null default
+print +(File::Basename::fileparse_set_fstype('MacOS') eq 'MSDOS' ?
+        '' : 'not '),"ok 23\n";
+
+# 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";
+}
+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:') eq 'arma:' ? '' : 'not '),"ok 27\n";
+print +(dirname(':') eq ':' ? '' : 'not '),"ok 28\n";
+
+
+# Check quoting of metacharacters in suffix arg by basename()
+print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
+        '' : 'not '),"ok 29\n";
+print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
+        '' : 'not '),"ok 30\n";
+