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.

diff --git a/t/lib/checktree.t b/t/lib/checktree.t
new file mode 100644 (file)
index 0000000..b5426ca
--- /dev/null
+++ b/t/lib/checktree.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use File::CheckTree;
+
+# We assume that we run from the perl "t" directory.
+
+validate q{
+    lib              -d || die
+    lib/checktree.t  -f || die
+};
+
+print "ok 1\n";

diff --git a/t/lib/env.t b/t/lib/env.t
new file mode 100644 (file)
index 0000000..5a82207
--- /dev/null
+++ b/t/lib/env.t
@@ -0,0 +1,18 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+BEGIN {
+       $ENV{FOO} = "foo";
+}
+
+use Env qw(FOO);
+
+$FOO .= "/bar";
+
+print "1..1\n";
+print "not " if $FOO ne 'foo/bar';
+print "ok 1\n";

diff --git a/t/lib/fatal.t b/t/lib/fatal.t
new file mode 100644 (file)
index 0000000..fe2f63d
--- /dev/null
+++ b/t/lib/fatal.t
@@ -0,0 +1,23 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..2\n";
+
+sub false { 0; }
+
+sub true  { 1; }
+
+use Fatal qw(true false);
+
+eval { true(); };
+
+print "not " if $@;
+print "ok 1\n";
+
+eval { false(); };
+print "not " unless $@;
+print "ok 2\n";

diff --git a/t/lib/filecache.t b/t/lib/filecache.t
new file mode 100644 (file)
index 0000000..a97fdd5
--- /dev/null
+++ b/t/lib/filecache.t
@@ -0,0 +1,25 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use FileCache;
+
+# This is really not a complete test as I don't bother to open enough
+# files to make real swapping of open filedescriptor happen.
+
+$path = "foo";
+cacheout $path;
+
+print $path "\n";
+
+close $path;
+
+print "not " unless -f $path;
+print "ok 1\n";
+
+unlink $path;

diff --git a/t/lib/filecopy.t b/t/lib/filecopy.t
new file mode 100644 (file)
index 0000000..4a5d1d7
--- /dev/null
+++ b/t/lib/filecopy.t
@@ -0,0 +1,34 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\n";
+
+$| = 1;
+
+use File::Copy;
+
+# First we create a file
+open(F, ">file-$$") or die;
+print F "ok 3\n";
+close F;
+
+copy "file-$$", "copy-$$";
+
+open(F, "copy-$$") or die;
+$foo = <F>;
+close(F);
+
+print "not " if -s "file-$$" != -s "copy-$$";
+print "ok 1\n";
+
+print "not " unless $foo eq "ok 3\n";
+print "ok 2\n";
+
+copy "copy-$$", \*STDOUT;
+
+unlink "file-$$";
+unlink "copy-$$";

diff --git a/t/lib/filefind.t b/t/lib/filefind.t
new file mode 100644 (file)
index 0000000..21e29a2
--- /dev/null
+++ b/t/lib/filefind.t
@@ -0,0 +1,13 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use File::Find;
+
+# hope we will eventually find ourself
+find(sub { print "ok 1\n" if $_ eq 'filefind.t'; }, ".");

diff --git a/t/lib/filepath.t b/t/lib/filepath.t
new file mode 100644 (file)
index 0000000..c014f74
--- /dev/null
+++ b/t/lib/filepath.t
@@ -0,0 +1,20 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..2\n";
+
+use File::Path;
+
+mkpath("foo/bar");
+
+print "not " unless -d "foo" && -d "foo/bar";
+print "ok 1\n";
+
+rmtree("foo");
+
+print "not " if -e "foo";
+print "ok 2\n";

diff --git a/t/lib/findbin.t b/t/lib/findbin.t
new file mode 100644 (file)
index 0000000..8d5347c
--- /dev/null
+++ b/t/lib/findbin.t
@@ -0,0 +1,13 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..1\n";
+
+use FindBin qw($Bin);
+
+print "not " unless $Bin =~ m,t/lib$,;
+print "ok 1\n";

diff --git a/t/lib/getopt.t b/t/lib/getopt.t
new file mode 100644 (file)
index 0000000..ec2ea49
--- /dev/null
+++ b/t/lib/getopt.t
@@ -0,0 +1,71 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..11\n";
+
+use Getopt::Std;
+
+# First we test the getopt function
+@ARGV = qw(-xo -f foo -y file);
+getopt('f');
+
+print "not " if "@ARGV" ne 'file';
+print "ok 1\n";
+
+print "not " unless $opt_x && $opt_o && opt_y;
+print "ok 2\n";
+
+print "not " unless $opt_f eq 'foo';
+print "ok 3\n";
+
+
+# Then we try the getopts
+$opt_o = $opt_i = $opt_f = undef;
+@ARGV = qw(-foi -i file);
+getopts('oif:') or print "not ";
+print "ok 4\n";
+
+print "not " unless "@ARGV" eq 'file';
+print "ok 5\n";
+
+print "not " unless $opt_i and $opt_f eq 'oi';
+print "ok 6\n";
+
+print "not " if $opt_o;
+print "ok 7\n";
+
+# Try illegal options, but avoid printing of the error message
+
+open(STDERR, ">stderr") || die;
+unlink "stderr";
+
+@ARGV = qw(-h help);
+
+!getopts("xf:y") or print "not ";
+print "ok 8\n";
+
+
+# Then try the Getopt::Long module
+
+use Getopt::Long;
+
+@ARGV = qw(--help --file foo --foo --nobar --num=5 -- file);
+
+GetOptions(
+   'help'   => \$HELP,
+   'file:s' => \$FILE,
+   'foo!'   => \$FOO,
+   'bar!'   => \$BAR,
+   'num:i'  => \$NO,
+) || print "not ";
+print "ok 9\n";
+
+print "not " unless $HELP && $FOO && !$BAR && $FILE eq 'foo' && $NO == 5;
+print "ok 10\n";
+
+print "not " unless "@ARGV" eq "file";
+print "ok 11\n";

diff --git a/t/lib/hostname.t b/t/lib/hostname.t
new file mode 100644 (file)
index 0000000..e4ac365
--- /dev/null
+++ b/t/lib/hostname.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Sys::Hostname;
+
+eval {
+    $host = hostname;
+};
+
+if ($@) {
+    print "1..0\n" if $@ =~ /Cannot get host name/;
+} else {
+    print "1..1\n";
+    print "ok 1\n";
+}

diff --git a/t/lib/parsewords.t b/t/lib/parsewords.t
new file mode 100644 (file)
index 0000000..47a7588
--- /dev/null
+++ b/t/lib/parsewords.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..4\n";
+
+use Text::ParseWords;
+
+@words = shellwords(qq(foo "bar quiz" zoo));
+#print join(";", @words), "\n";
+
+print "not " if $words[0] ne 'foo';
+print "ok 1\n";
+
+print "not " if $words[1] ne 'bar quiz';
+print "ok 2\n";
+
+print "not " if $words[2] ne 'zoo';
+print "ok 3\n";
+
+# Test quotewords() with other parameters
+@words = quotewords(":+", 1, qq(foo:::"bar:foo":zoo zoo:));
+#print join(";", @words), "\n";
+print "not " unless join(";", @words) eq qq(foo;"bar:foo";zoo zoo);
+print "ok 4\n";

diff --git a/t/lib/searchdict.t b/t/lib/searchdict.t
new file mode 100644 (file)
index 0000000..69329d6
--- /dev/null
+++ b/t/lib/searchdict.t
@@ -0,0 +1,62 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\n";
+
+$DICT = <<EOT;
+Aarhus
+Aaron
+Ababa
+aback
+abaft
+abandon
+abandoned
+abandoning
+abandonment
+abandons
+abase
+abased
+abasement
+abasements
+abases
+abash
+abashed
+abashes
+abashing
+abasing
+abate
+abated
+abatement
+abatements
+abater
+abates
+abating
+Abba
+EOT
+
+use Search::Dict;
+
+open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!";
+unlink "dict-$$";
+print DICT $DICT;
+
+my $pos = look *DICT, "abash";
+chomp($word = <DICT>);
+print "not " if $pos < 0 || $word ne "abash";
+print "ok 1\n";
+
+$pos = look *DICT, "foo";
+chomp($word = <DICT>);
+
+print "not " if $pos != length($DICT);  # will search to end of file
+print "ok 2\n";
+
+$pos = look *DICT, "aarhus", 1, 1;
+chomp($word = <DICT>);
+
+print "not " if $pos < 0 || $word ne "Aarhus";
+print "ok 3\n";

diff --git a/t/lib/selectsaver.t b/t/lib/selectsaver.t
new file mode 100644 (file)
index 0000000..3b58d70
--- /dev/null
+++ b/t/lib/selectsaver.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\n";
+
+use SelectSaver;
+
+open(FOO, ">foo-$$") || die;
+
+print "ok 1\n";
+{
+    my $saver = new SelectSaver(FOO);
+    print "foo\n";
+}
+
+# Get data written to file
+open(FOO, "foo-$$") || die;
+chomp($foo = <FOO>);
+close FOO;
+unlink "foo-$$";
+
+print "ok 2\n" if $foo eq "foo";
+
+print "ok 3\n";

diff --git a/t/lib/texttabs.t b/t/lib/texttabs.t
new file mode 100644 (file)
index 0000000..ea9012c
--- /dev/null
+++ b/t/lib/texttabs.t
@@ -0,0 +1,28 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..3\n";
+
+use Text::Tabs;
+
+$tabstop = 4;
+
+$s1 = "foo\tbar\tb\tb";
+$s2 = expand $s1;
+$s3 = unexpand $s2;
+
+print "not " unless $s2 eq "foo bar b   b";
+print "ok 1\n";
+
+print "not " unless $s3 eq "foo bar b\tb";
+print "ok 2\n";
+
+
+$tabstop = 8;
+
+print "not " unless unexpand("                    foo") eq "\t\t    foo";
+print "ok 3\n";

diff --git a/t/lib/textwrap.t b/t/lib/textwrap.t
new file mode 100644 (file)
index 0000000..9c8d1b4
--- /dev/null
+++ b/t/lib/textwrap.t
@@ -0,0 +1,40 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..5\n";
+
+use Text::Wrap qw(wrap $columns);
+
+$columns = 30;
+
+$text = <<'EOT';
+Text::Wrap is a very simple paragraph formatter.  It formats a
+single paragraph at a time by breaking lines at word boundries.
+Indentation is controlled for the first line ($initial_tab) and
+all subsquent lines ($subsequent_tab) independently.  $Text::Wrap::columns
+should be set to the full width of your output device.
+EOT
+
+$text =~ s/\n/ /g;
+$_ = wrap "|  ", "|", $text;
+
+#print "$_\n";
+
+print "not " unless /^\|  Text::Wrap is/;  # start is ok
+print "ok 1\n";
+
+print "not " if /^.{31,}$/m;  # no line longer than 30 chars
+print "ok 2\n";
+
+print "not " unless /^\|\w/m;  # other lines start with 
+print "ok 3\n";
+
+print "not " unless /\bsubsquent\b/; # look for a random word
+print "ok 4\n";
+
+print "not " unless /\bdevice\./;  # look for last word
+print "ok 5\n";

diff --git a/t/lib/timelocal.t b/t/lib/timelocal.t
new file mode 100644 (file)
index 0000000..adc1b1b
--- /dev/null
+++ b/t/lib/timelocal.t
@@ -0,0 +1,87 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+use Time::Local;
+
+# Set up time values to test
+@time =
+  (
+   #year,mon,day,hour,min,sec 
+   [1970,  1,  1, 00, 00, 00],
+   [1980,  2, 28, 12, 00, 00],
+   [1980,  2, 29, 12, 00, 00],
+   [1999, 12, 31, 23, 59, 59],
+   [2000,  1,  1, 00, 00, 00],
+   [2010, 10, 12, 14, 13, 12],
+  );
+
+print "1..", @time * 2 + 5, "\n";
+
+$count = 1;
+for (@time) {
+    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
+    $year -= 1900;
+    $mon --;
+    my $time = timelocal($sec,$min,$hour,$mday,$mon,$year);
+    # print scalar(localtime($time)), "\n";
+    my($s,$m,$h,$D,$M,$Y) = localtime($time);
+
+    if ($s == $sec &&
+       $m == $min &&
+       $h == $hour &&
+       $D == $mday &&
+       $M == $mon &&
+       $Y == $year
+       ) {
+       print "ok $count\n";
+    } else {
+       print "not ok $count\n";
+    }
+    $count++;
+
+    # Test gmtime function
+    $time = timegm($sec,$min,$hour,$mday,$mon,$year);
+    ($s,$m,$h,$D,$M,$Y) = gmtime($time);
+
+    if ($s == $sec &&
+       $m == $min &&
+       $h == $hour &&
+       $D == $mday &&
+       $M == $mon &&
+       $Y == $year
+       ) {
+       print "ok $count\n";
+    } else {
+       print "not ok $count\n";
+    }
+    $count++;
+}
+
+#print "Testing that the differences between a few dates makes sence...\n";
+
+timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90) == 3600
+  or print "not ";
+print "ok ", $count++, "\n";
+
+timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99) == 24 * 3600 
+  or print "not ";
+print "ok ", $count++, "\n";
+
+# Diff beween Jan 1, 1970 and Mar 1, 1970 = (31 + 28 = 59 days)
+timegm(0,0,0, 1, 2, 70) - timegm(0,0,0, 1, 0, 70) == 59 * 24 * 3600
+  or print "not ";
+print "ok ", $count++, "\n";
+
+
+#print "Testing timelocal.pl module too...\n";
+package test;
+require 'timelocal.pl';
+timegm(0,0,0,1,0,70) == main::timegm(0,0,0,1,0,70) or print "not ";
+print "ok ", $main::count++, "\n";
+
+timelocal(1,2,3,4,5,78) == main::timelocal(1,2,3,4,5,78) or print "not ";
+print "ok ", $main::count++, "\n";