From 1a3850a59b9c97ab76cb84b312a9b18e9a2cb3d6 Mon Sep 17 00:00:00 2001 From: Gisle Aas Date: Sun, 22 Sep 1996 00:59:56 +0200 Subject: [PATCH] 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. --- t/lib/checktree.t | 19 ++++++++++++ t/lib/env.t | 18 +++++++++++ t/lib/fatal.t | 23 ++++++++++++++ t/lib/filecache.t | 25 +++++++++++++++ t/lib/filecopy.t | 34 +++++++++++++++++++++ t/lib/filefind.t | 13 ++++++++ t/lib/filepath.t | 20 ++++++++++++ t/lib/findbin.t | 13 ++++++++ t/lib/getopt.t | 71 +++++++++++++++++++++++++++++++++++++++++++ t/lib/hostname.t | 19 ++++++++++++ t/lib/parsewords.t | 28 +++++++++++++++++ t/lib/searchdict.t | 62 ++++++++++++++++++++++++++++++++++++++ t/lib/selectsaver.t | 28 +++++++++++++++++ t/lib/texttabs.t | 28 +++++++++++++++++ t/lib/textwrap.t | 40 ++++++++++++++++++++++++ t/lib/timelocal.t | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 16 files changed, 528 insertions(+) create mode 100644 t/lib/checktree.t create mode 100644 t/lib/env.t create mode 100644 t/lib/fatal.t create mode 100644 t/lib/filecache.t create mode 100644 t/lib/filecopy.t create mode 100644 t/lib/filefind.t create mode 100644 t/lib/filepath.t create mode 100644 t/lib/findbin.t create mode 100644 t/lib/getopt.t create mode 100644 t/lib/hostname.t create mode 100644 t/lib/parsewords.t create mode 100644 t/lib/searchdict.t create mode 100644 t/lib/selectsaver.t create mode 100644 t/lib/texttabs.t create mode 100644 t/lib/textwrap.t create mode 100644 t/lib/timelocal.t diff --git a/t/lib/checktree.t b/t/lib/checktree.t new file mode 100644 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 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 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 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 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 = ; +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 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 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 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 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 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 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 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 = <dict-$$") or die "Can't create dict-$$: $!"; +unlink "dict-$$"; +print DICT $DICT; + +my $pos = look *DICT, "abash"; +chomp($word = ); +print "not " if $pos < 0 || $word ne "abash"; +print "ok 1\n"; + +$pos = look *DICT, "foo"; +chomp($word = ); + +print "not " if $pos != length($DICT); # will search to end of file +print "ok 2\n"; + +$pos = look *DICT, "aarhus", 1, 1; +chomp($word = ); + +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 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 = ); +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 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 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 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"; -- 1.8.3.1