libtest-cmd-perl-1.05.orig/0040755000175000017500000000000007415353162014557 5ustar shellshelllibtest-cmd-perl-1.05.orig/t/0040755000175000017500000000000007415353162015022 5ustar shellshelllibtest-cmd-perl-1.05.orig/t/Common/0040755000175000017500000000000007415353162016252 5ustar shellshelllibtest-cmd-perl-1.05.orig/t/Common/run.t0100444000175000017500000001127207415353162017241 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 31, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $pass = $test->workpath('pass'); $fail = $test->workpath('fail'); $stdout = $test->workpath('stdout'); $stderr = $test->workpath('stderr'); $test->write($pass, <<'_EOF_'); open(OUT, '>output'); print OUT "pass: @ARGV\n"; close(OUT); exit(0); _EOF_ $test->write($fail, <<'_EOF_'); open(OUT, '>output'); print OUT "fail: @ARGV\n"; close(OUT); exit(1); _EOF_ $test->write($stdout, <<'_EOF_'); print STDOUT "stdout: @ARGV\n"; exit(0); _EOF_ $test->write($stderr, <<'_EOF_'); print STDERR "stderr: @ARGV\n"; exit(0); _EOF_ $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$pass', interpreter => '$perl', workdir => ''); \$t->run(); \$t->file_matches('output', "pass: \n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$pass', interpreter => '$perl', workdir => ''); \$t->run(args => 'one two three'); \$t->file_matches('output', "pass: one two three\n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$fail', interpreter => '$perl', workdir => ''); \$t->run(); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /FAILED test of fail/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$pass', interpreter => '$perl', workdir => ''); \$t->run(fail => '$? != 1'); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /FAILED test of pass/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stdout', interpreter => '$perl', workdir => ''); \$t->run(stdout => "stdout: \n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stdout', interpreter => '$perl', workdir => ''); \$t->run(args => 'foo', stdout => "stdout: \n"); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of STDOUT.*FAILED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of STDERR.*FAILED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(stderr => undef); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(stderr => "stderr: \n"); \$t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <new(prog => '$stderr', interpreter => '$perl', workdir => ''); \$t->run(args => 'foo', stderr => "stderr: \n"); \$t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of STDERR.*FAILED/ms); libtest-cmd-perl-1.05.orig/t/Common/f_matches.t0100444000175000017500000000377007415353162020372 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->file_matches('file1', "file1\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->file_matches('file1', "file1\n"); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not read contents of file1:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1 does not match\n"); $t->file_matches('file1', "file1\n"); $t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /diff expected vs. actual contents of file1.*FAILED/ms); libtest-cmd-perl-1.05.orig/t/Common/subdir.t0100444000175000017500000000420107415353162017717 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 13, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => '', subdir => ['no', 'such', 'subdir']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not create subdirectories:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->subdir(['no', 'such', 'subdir']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not create subdirectories:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => '', subdir => 'foo'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->subdir(subdir => 'foo'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); libtest-cmd-perl-1.05.orig/t/Common/chmod.t0100444000175000017500000000330407415353162017524 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->write('file2', "file2\n"); $t->chmod(0777, 'file1', 'file2'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->chmod(0777, 'file1', 'file2'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not chmod files.*NO RESULT/ms); libtest-cmd-perl-1.05.orig/t/Common/m_exist.t0100444000175000017500000000316207415353162020104 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->must_exist('file1'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->must_exist('file1'); $t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /files are missing: file1\nFAILED/ms); libtest-cmd-perl-1.05.orig/t/Common/read.t0100444000175000017500000000442507415353162017352 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 13, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file', "the\nfile\n"); $t->read(\$contents, 'file'); $t->fail($contents ne "the\nfile\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file', "the\nfile\n"); $t->read(\@contents, 'file'); $t->fail(join('', @contents) ne "the\nfile\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->read(\$contents, 'file'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not read file contents:.*NO RESULT/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->read(\@contents, 'file'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not read file contents:.*NO RESULT/ms); libtest-cmd-perl-1.05.orig/t/Common/m_n_exist.t0100444000175000017500000000317707415353162020427 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->must_not_exist('file1'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->must_not_exist('file1'); $t->pass; EOF ok(($ret >> 8) == 1); ok($test->stdout eq ""); ok($test->stderr =~ /unexpected files exist: file1\nFAILED/ms); libtest-cmd-perl-1.05.orig/t/Common/sleep.t0100444000175000017500000000256107415353162017546 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $before = time; $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->sleep(1); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $after = time; ok($before <= $after - 1) libtest-cmd-perl-1.05.orig/t/Common/copy.t0100444000175000017500000000324707415353162017412 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->copy('file1', 'file2'); $t->file_matches('file2', "file1\n"); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->copy('file1', 'file2'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not copy file1 to file2:.*NO RESULT/ms); libtest-cmd-perl-1.05.orig/t/Common/touch.t0100444000175000017500000000331407415353162017555 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->write('file2', "file2\n"); $t->touch(time + 1, 'file1', 'file2'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file1', "file1\n"); $t->touch(time + 1, 'file1', 'file2'); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not touch files.*NO RESULT/ms); libtest-cmd-perl-1.05.orig/t/Common/unlink.t0100444000175000017500000000317507415353162017740 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file', "the\nfile\n"); $t->unlink('file'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->unlink('file', ['foo', 'file']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not unlink files.*NO RESULT/ms); libtest-cmd-perl-1.05.orig/t/Common/write.t0100444000175000017500000000354007415353162017566 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => ''); $perl = $^X; @path_dirs = split(/$Config{path_sep}/, $ENV{PATH}); while (! -x $perl) { $dir = shift @path_dirs; if (! $dir) { print "# Can not find executable $^X on PATH\n"; print "# ($ENV{PATH}\n"; exit (1); } $perl = Test::Cmd->catfile($dir, $^X); } if (! Test::Cmd->file_name_is_absolute($perl)) { use Cwd; $perl = Test::Cmd->catfile(Cwd::cwd(), $perl); } $flags = "-I " . join(" -I ", @INC); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write('file'); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => '', subdir => 'foo'); $t->write(['foo', 'file']); $t->pass; EOF ok($ret == 0); ok($test->stdout eq ""); ok($test->stderr =~ /PASSED/ms); $ret = $test->run(prog => "$perl $flags", stdin => <<'EOF'); use Test::Cmd::Common; $t = Test::Cmd::Common->new(workdir => ''); $t->write(['no_such_subdir', 'file']); $t->pass; EOF ok(($ret >> 8) == 2); ok($test->stdout eq ""); ok($test->stderr =~ /could not write \S+:.*NO RESULT/ms); libtest-cmd-perl-1.05.orig/t/TMPDIR.t0100444000175000017500000000726107415353162016207 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 43, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); my($run_env, $wdir, $ret, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $tdir1 = $run_env->workdir; ok($tdir1); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $tdir2 = $run_env->workdir; ok($tdir2); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $tdir3 = $run_env->workdir; ok($tdir3); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ENV{PRESERVE} = '1'; $ENV{TMPDIR} = $tdir1; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.1 2>perl.stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file1', <fail(! $ret); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.1"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.1"); ok(defined $string); ok($string eq "PASSED\n"); $path = Test::Cmd->catfile($tdir1, '*testcmd*', 'file1'); ok(defined $path); $path =~ s#\\#/#g; $string = contents(eval "<$path>"); ok(defined $string); ok($string eq "Test file #1.\n"); # $ENV{TMPDIR} = $tdir2; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.2 2>perl.stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file2', <fail(! $ret); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.2"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.2"); ok(defined $string); ok($string eq "PASSED\n"); $path = Test::Cmd->catfile($tdir2, '*testcmd*', 'file2'); ok(defined $path); $path =~ s#\\#/#g; $string = contents(eval "<$path>"); ok(defined $string); ok($string eq "Test file #2.\n"); # $ENV{TMPDIR} = Test::Cmd->catfile($tdir3, ''); $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.3 2>perl.stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file3', <fail(! $ret); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.3"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.3"); ok(defined $string); ok($string eq "PASSED\n"); $path = Test::Cmd->catfile($tdir3, '*testcmd*', 'file3'); ok(defined $path); $path =~ s#\\#/#g; $string = contents(eval "<$path>"); ok(defined $string); ok($string eq "Test file #3.\n"); libtest-cmd-perl-1.05.orig/t/subdir.t0100444000175000017500000000350407415353162016474 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 21, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => '', subdir => ['no', 'such', 'subdir']); ok(! $test); $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $ret = $test->subdir('bar'); ok($ret == 1); $wdir = $test->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); $ret = $test->subdir([qw(foo succeed)]); ok($ret == 1); # I don't understand why, but setting read-only on a Windows NT # directory on Windows NT still allows you to create a file. # That doesn't make sense to my UNIX-centric brain, but it does # mean we need to skip the related tests on Win32 platforms. $ret = chmod(0500, 'foo'); skip($iswin32, $ret == 1); $ret = $test->subdir([qw(foo fail)]); skip($iswin32 || $> == 0, ! $ret); $ret = $test->subdir([qw(sub dir ectory)], 'sub'); ok($ret == 1); $ret = $test->subdir('one', ['one', 'two'], [qw(one two three)]); ok($ret == 3); $ret = $test->subdir([$wdir, 'a'], [$wdir, 'a', 'b']); ok($ret == 2); ok(-d 'foo'); ok(-d 'bar'); ok(-d $test->workpath('foo', 'succeed')); skip($iswin32 || $> == 0, ! -d $test->workpath('foo', 'fail')); ok( -d 'sub'); ok(! -d $test->workpath(qw(sub dir))); ok(! -d $test->workpath(qw(sub dir ectory))); ok(-d $test->workpath(qw(one two three))); ok(-d $test->workpath(qw(a b))); libtest-cmd-perl-1.05.orig/t/read.t0100444000175000017500000000535207415353162016122 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 44, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir, $wdir_file2, $wdir_foo_file1); my @lines; $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $wdir = $test->workdir; ok($wdir); $wdir_file1 = $test->catfile($wdir, 'file1'); ok($wdir_file1); $wdir_file2 = $test->catfile($wdir, 'file2'); ok($wdir_file2); $wdir_foo_file3 = $test->catfile($wdir, 'foo', 'file3'); ok($wdir_foo_file3); $wdir_foo_file4 = $test->catfile($wdir, 'foo', 'file4'); ok($wdir_foo_file4); $wdir_foo_file5 = $test->catfile($wdir, 'foo', 'file5'); ok($wdir_foo_file5); $ret = open(OUT, ">$wdir_file1"); ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_file2"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #2. _EOF_ ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_foo_file3"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #3. _EOF_ ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_foo_file4"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #4. _EOF_ ok($ret); $ret = close(OUT); ok($ret); $ret = open(OUT, ">$wdir_foo_file5"); ok($ret); $ret = print OUT <<'_EOF_'; Test file #5. _EOF_ ok($ret); $ret = close(OUT); ok($ret); # $ret = $test->read(\@lines, 'no_file'); ok(! $ret); $ret = $test->read(\$contents, 'no_file'); ok(! $ret); $ret = $test->read(\@lines, 'file1'); ok($ret); ok(! $lines[0]); $ret = $test->read(\$contents, 'file1'); ok($ret); ok(! $contents); $ret = $test->read(\@lines, 'file2'); ok($ret); ok(join('', @lines) eq "Test\nfile\n#2.\n"); $ret = $test->read(\$contents, 'file2'); ok($ret); ok($contents eq "Test\nfile\n#2.\n"); $ret = $test->read(\@lines, ['foo', 'file3']); ok($ret); ok(join('', @lines) eq "Test\nfile\n#3.\n"); $ret = $test->read(\$contents, ['foo', 'file3']); ok($ret); ok($contents eq "Test\nfile\n#3.\n"); $ret = $test->read(\@lines, $wdir_foo_file4); ok($ret); ok(join('', @lines) eq "Test\nfile\n#4.\n"); $ret = $test->read(\$contents, $wdir_foo_file4); ok($ret); ok($contents eq "Test\nfile\n#4.\n"); $ret = $test->read(\@lines, [$wdir, 'foo', 'file5']); ok($ret); ok(join('', @lines) eq "Test\nfile\n#5.\n"); $ret = $test->read(\$contents, [$wdir, 'foo', 'file5']); ok($ret); ok($contents eq "Test\nfile\n#5.\n"); libtest-cmd-perl-1.05.orig/t/match_regex.t0100444000175000017500000000157207415353162017475 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 6, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $ret = Test::Cmd->match_regex("abcde\n", "a.*e\n"); ok($ret); $test = Test::Cmd->new; ok($test); $ret = $test->match_regex("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match_regex(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match_regex(\@lines, \@regexes); ok($ret); libtest-cmd-perl-1.05.orig/t/exit.t0100444000175000017500000000762407415353162016164 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 19, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); my($run_env, $wdir, $ret, $test, $wd, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source directory." my @cleanup; END { foreach my $dir (@cleanup) { rmdir $dir if -d $dir; } } sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } sub test_it { my($condition, $preserved) = @_; my %close_true = ( 'pass' => 1, 'fail' => 0, 'no_result' => 0, ); my %exit_status = ( 'pass' => 0, 'fail' => 1, 'no_result' => 2, ); my %result_string = ( 'pass' => "PASSED\n", 'fail' => "FAILED test at line 5 of -.\n", 'no_result' => "NO RESULT for test at line 5 of -.\n", ); if (! open(PERL, "|$^X @I_FLAGS >perl.stdout 2>perl.stderr")) { print STDOUT "# Could not open $^X: $!\n"; return undef; } my $ret = print PERL <new(workdir => ''); Test::Cmd->fail(! \$test); print STDOUT \$test->workdir; \$test->$condition; EOF if (! $ret) { print STDOUT "# Could not write to $^X: $!\n"; return undef; } $ret = close(PERL); if ($close_true{$condition} ? ! $ret : $ret) { print STDOUT "# Unexpected return from close(): $!\n"; $wd = contents("perl.stdout"); push @cleanup, $wd if defined $wd; return undef; } if (($?>>8) != $exit_status{$condition}) { print STDOUT "# Expected exit status ", $exit_status{$condition}, " got ", $?>>8, "\n"; $wd = contents("perl.stdout"); push @cleanup, $wd if defined $wd; return undef; } $wd = contents("perl.stdout"); if (! defined $wd) { print STDOUT "# no working directory path name on standard output\n"; return undef; } push @cleanup, $wd; $string = contents("perl.stderr"); if ($string ne $result_string{$condition}) { print STDOUT "# Expected error output:\n"; print STDOUT "# ", $result_string{$condition}; print STDOUT "# Got error output:\n"; print STDOUT "# ", $string; return undef; } return ($preserved ? -d $wd : ! -d $wd); } delete $ENV{PRESERVE}; delete $ENV{PRESERVE_PASS}; delete $ENV{PRESERVE_FAIL}; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 0); ok($ret); $ret = test_it('fail', 0); ok($ret); $ret = test_it('no_result', 0); ok($ret); $ENV{PRESERVE} = '1'; delete $ENV{PRESERVE_PASS}; delete $ENV{PRESERVE_FAIL}; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 1); ok($ret); $ret = test_it('fail', 1); ok($ret); $ret = test_it('no_result', 1); ok($ret); delete $ENV{PRESERVE}; $ENV{PRESERVE_PASS} = '1'; delete $ENV{PRESERVE_FAIL}; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 1); ok($ret); $ret = test_it('fail', 0); ok($ret); $ret = test_it('no_result', 0); ok($ret); delete $ENV{PRESERVE}; delete $ENV{PRESERVE_PASS}; $ENV{PRESERVE_FAIL} = '1'; delete $ENV{PRESERVE_NO_RESULT}; $ret = test_it('pass', 0); ok($ret); $ret = test_it('fail', 1); ok($ret); $ret = test_it('no_result', 0); ok($ret); delete $ENV{PRESERVE}; delete $ENV{PRESERVE_PASS}; delete $ENV{PRESERVE_FAIL}; $ENV{PRESERVE_NO_RESULT} = '1'; $ret = test_it('pass', 0); ok($ret); $ret = test_it('fail', 0); ok($ret); $ret = test_it('no_result', 1); ok($ret); libtest-cmd-perl-1.05.orig/t/stderr.t0100444000175000017500000000302707415353162016507 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 12, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run1', <write('run2', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(interpreter => "$^X", workdir => ''); ok($test); ok(! defined $test->stderr); $test->prog('run1'); $test->run('args' => 'foo bar'); ok($? == 0); $test->prog('run2'); $test->run('args' => 'snafu'); ok($? == 0); ok($test->stderr eq "run2 STDERR snafu\nrun2 STDERR second line\n"); ok($test->stderr(1) eq "run1 STDERR foo bar\nrun1 STDERR second line\n"); libtest-cmd-perl-1.05.orig/t/cleanup.t0100444000175000017500000000171007415353162016630 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 12, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file1', <cleanup; ok(! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file2', <cleanup; ok(! -d $wdir); libtest-cmd-perl-1.05.orig/t/diff_exact.t0100444000175000017500000000553107415353162017302 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; eval "use Algorithm::DiffOld"; $diffold = ! $@; plan tests => 24, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes, @diff); $ret = Test::Cmd->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 2 3 _EOF_ ok($ret); ok(@diff == 0); $ret = Test::Cmd->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 222 3 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2c2 < 222 --- > 2 _EOF_ Expected ===== 1 2 3 Actual ===== 1 222 3 _EOF_ $test = Test::Cmd->new; ok($test); $ret = $test->diff_exact("abcde\n", "a.*e\n", \@diff); ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1c1 < a.*e --- > abcde _EOF_ Expected ===== abcde Actual ===== a.*e _EOF_ $ret = $test->diff_exact("abcde\n", "abcde\n", \@diff); ok($ret); ok(! @diff); $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1,2c1,2 < 1\d+5 < a.*e --- > 12345 > abcde _EOF_ Expected ===== 1\d+5 a.*e Actual ===== 12345 abcde _EOF_ $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); ok(! @diff); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->diff_exact(\@lines, \@regexes, \@diff); ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1,2c1,2 < v[^a-u]*z < 6\S+0 --- > vwxyz > 67890 _EOF_ Expected ===== v[^a-u]*z 6\S+0 Actual ===== vwxyz 67890 _EOF_ $ret = $test->diff_exact(\@lines, \@lines, \@diff); ok($ret); ok(! @diff); $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 a b 2 3 c 4 5 _EOF_ 1 2 x 3 4 y z 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1a2,3 > a > b 3d4 < x 4a6 > c 6,7d7 < y < z _EOF_ Expected ===== 1 2 x 3 4 y z 5 Actual ===== 1 a b 2 3 c 4 5 _EOF_ $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); 1 2 a 3 4 b c 5 _EOF_ 1 x y 2 3 z 4 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2,3d1 < x < y 4a3 > a 6d4 < z 7a6,7 > b > c _EOF_ Expected ===== 1 x y 2 3 z 4 5 Actual ===== 1 2 a 3 4 b c 5 _EOF_ $ret = $test->diff_exact(<<'_EOF_', <<'_EOF_', \@diff); a b c e h j l m n p _EOF_ b c d e f j k l m r s t _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 0a1 > a 3d3 < d 5c5 < f --- > h 7d6 < k 10,12c9,10 < r < s < t --- > n > p _EOF_ Expected ===== b c d e f j k l m r s t Actual ===== a b c e h j l m n p _EOF_ libtest-cmd-perl-1.05.orig/t/writable.t0100444000175000017500000000441507415353162017017 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 30, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $ret = $test->write('file1', <write(['foo', 'file2'], <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); ok(-w $test->curdir); ok(-w 'file1'); ok(-w 'foo'); ok(-w $test->workpath('foo', 'file2')); $ret = $test->writable($wdir, 0); ok($ret == 0); # If we're running as root, then non-writability tests fail because root # can write to anything. Let them know why we're skipping those tests. print "# Skipping tests because you're running with EUID of 0\n" if $> == 0; skip($> == 0, ! -w $test->curdir); skip($> == 0, ! -w 'file1'); skip($> == 0, ! -w 'foo'); skip($> == 0, ! -w $test->workpath('foo', 'file2')); $ret = $test->writable($wdir, 1); ok($ret == 0); ok(-w $test->curdir); ok(-w 'file1'); ok(-w 'foo'); ok(-w $test->workpath('foo', 'file2')); # Make sure we can call with the optional error-collecting hash. # It would be good to check that this does, in fact, collect errors, # but the only two ways I can think of to get chmod() to generate an # error are a non-existent file (which won't happen because # finddepth() only calls its routine for existing files) or a file # owned by someone else. We can't rely on being able to chown() # a file unless we're root, though, and if we're root, the file will # be writable because root can write to anything. So just punt on # this for now. my %errs; $ret = $test->writable($wdir, 0, \%errs); ok($ret == 0); skip($> == 0, ! -w $test->curdir); skip($> == 0, ! -w 'file1'); skip($> == 0, ! -w 'foo'); skip($> == 0, ! -w $test->workpath('foo', 'file2')); $ret = $test->writable($wdir); ok($ret == 0); ok(-w $test->curdir); ok(-w 'file1'); ok(-w 'foo'); ok(-w $test->workpath('foo', 'file2')); libtest-cmd-perl-1.05.orig/t/interpreter.t0100444000175000017500000000173207415353162017550 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 8, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); ok(! -x 'run'); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(prog => 'run', workdir => ''); ok($test); $test->interpreter($^X); $test->run(); ok($? == 0); libtest-cmd-perl-1.05.orig/t/stdout.t0100444000175000017500000000302707415353162016526 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 12, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run1', <write('run2', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(interpreter => "$^X", workdir => ''); ok($test); ok(! defined $test->stdout); $test->prog('run1'); $test->run('args' => 'foo bar'); ok($? == 0); $test->prog('run2'); $test->run('args' => 'snafu'); ok($? == 0); ok($test->stdout eq "run2 STDOUT snafu\nrun2 STDOUT second line\n"); ok($test->stdout(1) eq "run1 STDOUT foo bar\nrun1 STDOUT second line\n"); libtest-cmd-perl-1.05.orig/t/stdin.t0100444000175000017500000000270307415353162016325 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 16, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test, @lines); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <) { s/X/Y/g; print; } exit 0; EOF ok($ret); $ret = $run_env->write('input', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); ok($test); ok(! defined $test->stdout); $test->run('args' => 'input'); ok($? == 0); ok($test->stdout eq "Y on Y this Y line Y\n"); $test->run('stdin' => "X is X here X tooX\n"); ok($? == 0); ok($test->stdout eq "Y is Y here Y tooY\n"); $test->run('stdin' => <<_EOF_); X here X X there X _EOF_ ok($? == 0); ok($test->stdout eq "Y here Y\nY there Y\n"); @lines = qq( X line X X another X ); $test->run('stdin' => \@lines); ok($? == 0); ok($test->stdout eq "\nY line Y\nY another Y\n"); libtest-cmd-perl-1.05.orig/t/prog.t0100444000175000017500000000217407415353162016155 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 9, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $wdir, $test); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run1', <write('run2', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $test = Test::Cmd->new(interpreter => "$^X", workdir => ''); ok($test); $test->prog('run1'); $test->run(); ok($? == 0); $test->prog('run2'); $test->run(); ok($? == 0); libtest-cmd-perl-1.05.orig/t/match_sub.t0100444000175000017500000000275607415353162017161 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 13, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $test = Test::Cmd->new; ok($test); $test->match_sub(\&Test::Cmd::match_exact); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok(! $ret); $ret = $test->match(\@lines, \@lines); ok($ret); $test->match_sub(\&Test::Cmd::match_regex); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok($ret); $test->match_sub(sub { $_[1] eq $_[2] }); $ret = $test->match("foo\n", "foo\n"); ok($ret); $ret = $test->match("foo\n", "bar\n"); ok(! $ret); libtest-cmd-perl-1.05.orig/t/ENV_PRESERVE.t0100444000175000017500000000603107415353162017145 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 28, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); my($run_env, $wdir, $ret, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.1 2>perl.stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file1', <fail(! $ret); $test->cleanup; $test->fail(-d $wdir); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.1"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.1"); ok(defined $string); ok($string eq "PASSED\n"); $ENV{PRESERVE_PASS} = '1'; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.2 2>perl.stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file2', <fail(! $ret); $test->cleanup('pass'); $test->fail(! -d $wdir); $test->cleanup('fail'); $test->fail(-d $wdir); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.2"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.2"); ok(defined $string); ok($string eq "PASSED\n"); delete $ENV{PRESERVE_PASS}; $ENV{PRESERVE_FAIL} = '1'; $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.3 2>perl.stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); Test::Cmd->fail(! $test); $wdir = $test->workdir; $test->fail(! $wdir); $ret = $test->write('file3', <fail(! $ret); $test->cleanup('fail'); $test->fail(! -d $wdir); $test->cleanup('pass'); $test->fail(-d $wdir); $test->pass; EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.3"); ok(defined $string); ok(! $string); $string = contents("perl.stderr.3"); ok(defined $string); ok($string eq "PASSED\n"); libtest-cmd-perl-1.05.orig/t/workpath.t0100444000175000017500000000126307415353162017043 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $wpath); $test = Test::Cmd->new; ok($test); ok(! $test->workpath); $test->workdir(''); ok($test->workdir); $wpath = $test->workpath('foo', 'bar'); ok($wpath eq Test::Cmd->catfile($test->workdir, 'foo', 'bar')); libtest-cmd-perl-1.05.orig/t/fail.t0100444000175000017500000000676407415353162016132 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 35, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } my($run_env, $ret, $wdir, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.1 2>stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); Test::Cmd->fail($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.1"); ok($string eq ""); $string = contents("stderr.1"); ok($string eq "FAILED test at line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.2 2>stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->fail($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.2"); ok($string eq ""); $string = contents("stderr.2"); ok($string eq "FAILED test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.3 2>stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", string => 'xyzzy', workdir => ''); $test->run(); $test->fail($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.3"); ok($string eq ""); $string = contents("stderr.3"); ok($string eq "FAILED test of run [xyzzy]\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.4 2>stderr.4"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->fail($? == 0 => sub {print STDERR "Printed on failure.\n"}); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.4"); ok($string eq ""); $string = contents("stderr.4"); ok($string eq "Printed on failure.\nFAILED test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.5 2>stderr.5"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; sub test_it { my $self = shift; $self->run(); $self->fail($? == 0 => undef, 1); } $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); &test_it($test); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 1); $string = contents("stdout.5"); ok($string eq ""); $string = contents("stderr.5"); ok($string eq "FAILED test of run\n\tat line 5 of - (main::test_it)\n\tfrom line 8 of -.\n"); libtest-cmd-perl-1.05.orig/t/run.t0100444000175000017500000001531607415353162016014 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Config; use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 53, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($run_env, $ret, $testx, $test, $subdir); # # The following complicated dance attempts to ensure we can create # an executable Perl script named "scriptx" on both UNIX and Win32 # systems. We want it to be Perl since it's about the only thing # that we can rely on in common between the systems. # # The UNIX side is easy; we just put our desired Perl script in # the file name with $Config{startperl} at the top, chmod it # executable, and away we go. # # For Win32, we go the route of creating a "scriptx.bat" file with # the magic header that reads as both an NT and a Perl script. # The hassle is that we want this .bat file to be executable # regardless of where we are at the moment, and the only way I # could figure out how to do this was to put the absolute path # name to the file in the .bat file as the first argument to # the perl.exe invocation. This means that we have to create our # initial running environments up front, so we know where the # "scriptx.bat" file will end up and can put its path name in # itself. # # If anyone cares to suggest an easier way to do this, I'd be # thrilled to hear about it. # $My_Config{_bat} = $iswin32 ? '.bat' : ''; $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $wdir = $run_env->workdir; ok($wdir); $ret = chdir($wdir); ok($ret); my $script = "script"; my $scriptx = "scriptx$My_Config{_bat}"; if ($iswin32) { my $workpath_scriptx = $run_env->workpath($scriptx); $My_Config{startperl} = <write($script, <write('xxx.pm', <write('yyy.pm', <write($scriptx, <new(prog => 'script', interpreter => "$^X -I$wdir -Mxxx", workdir => '', subdir => 'script_subdir'); ok($test); $ret = $test->run(); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: $wdir: ''\n"); ok($test->stderr eq "script: xxx: STDERR: $wdir: ''\n"); $ret = $test->run(args => 'arg1 arg2 arg3'); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: $wdir: 'arg1 arg2 arg3'\n"); # Execute "scriptx" in the middle of the run here, # so we know it doesn't affect the $test->prog value. # Note that it should not pick up the test environment's # interpreter value with "-Mxxx" in it. $ret = $test->run(prog => 'scriptx', args => 'foo'); ok($ret == 0); ok($test->stdout eq "$scriptx: : STDOUT: $wdir: 'foo'\n"); ok($test->stderr eq "$scriptx: : STDERR: $wdir: 'foo'\n"); $ret = $test->run(chdir => $test->curdir, args => 'x y z'); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: ${\$test->workdir}: 'x y z'\n"); ok($test->stderr eq "script: xxx: STDERR: ${\$test->workdir}: 'x y z'\n"); $subdir = $test->workpath('script_subdir'); $ret = $test->run(chdir => 'script_subdir'); ok($ret == 0); ok($test->stdout eq "script: xxx: STDOUT: $subdir: ''\n"); ok($test->stderr eq "script: xxx: STDERR: $subdir: ''\n"); $ret = $test->run(chdir => 'no_subdir'); ok(! defined $ret); $ret = $test->run(prog => 'no_script', interpreter => $^X); ok($ret != 0); $ret = $test->run(prog => 'script'); ok($ret != 0); $ret = $test->run(prog => 'script', interpreter => 'no_interpreter'); ok($ret != 0); $ret = $test->run(prog => 'no_script', interpreter => 'no_interpreter'); ok($ret != 0); $ret = $test->run(interpreter => 'no_interpreter'); ok($ret != 0); $ret = $test->run(interpreter => "$^X -I$wdir -Myyy", args => 'zzz'); ok($ret == 0); ok($test->stdout eq "script: yyy: STDOUT: $wdir: 'zzz'\n"); ok($test->stderr eq "script: yyy: STDERR: $wdir: 'zzz'\n"); # $testx = Test::Cmd->new(prog => 'scriptx', workdir => '', subdir => 'scriptx_subdir'); ok($testx); $ret = $testx->run(); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: $wdir: ''\n"); ok($testx->stderr eq "$scriptx: : STDERR: $wdir: ''\n"); $ret = $testx->run(args => 'foo bar'); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: $wdir: 'foo bar'\n"); ok($testx->stderr eq "$scriptx: : STDERR: $wdir: 'foo bar'\n"); # Execute "script" in the middle of the run here, # so we know it doesn't affect the $test->prog value. $ret = $testx->run(prog => 'script', interpreter => "$^X -I$wdir -Mxxx", args => 'bar'); ok($ret == 0); ok($testx->stdout eq "script: xxx: STDOUT: $wdir: 'bar'\n"); ok($testx->stderr eq "script: xxx: STDERR: $wdir: 'bar'\n"); $ret = $testx->run(chdir => $testx->curdir, args => 'baz'); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: ${\$testx->workdir}: 'baz'\n"); ok($testx->stderr eq "$scriptx: : STDERR: ${\$testx->workdir}: 'baz'\n"); $subdir = $testx->workpath('scriptx_subdir'); $ret = $testx->run(chdir => 'scriptx_subdir'); ok($ret == 0); ok($testx->stdout eq "$scriptx: : STDOUT: $subdir: ''\n"); ok($testx->stderr eq "$scriptx: : STDERR: $subdir: ''\n"); $ret = $testx->run(chdir => 'no_subdir'); ok(! defined $ret); $ret = $testx->run(prog => 'no_prog'); ok($ret != 0); libtest-cmd-perl-1.05.orig/t/EXPORT_OK.t0100444000175000017500000000143507415353162016617 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd qw(match_exact match_regex); $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $test = Test::Cmd->new; ok($test); $test->match_sub(\&match_exact); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $test->match_sub(\&match_regex); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); libtest-cmd-perl-1.05.orig/t/string.t0100444000175000017500000000122007415353162016503 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 5, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test); $test = Test::Cmd->new; ok($test); ok(! $test->string); $test->string('foo'); ok($test->string eq 'foo'); $test = Test::Cmd->new(string => 'bar'); ok($test->string eq 'bar'); libtest-cmd-perl-1.05.orig/t/match_exact.t0100444000175000017500000000222707415353162017465 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $ret = Test::Cmd->match_exact("abcde\n", "a.*e\n"); ok(! $ret); $ret = Test::Cmd->match_exact("abcde\n", "abcde\n"); ok($ret); $test = Test::Cmd->new; ok($test); $ret = $test->match_exact("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match_exact("abcde\n", "abcde\n"); ok($ret); $ret = $test->match_exact(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match_exact(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match_exact(\@lines, \@regexes); ok(! $ret); $ret = $test->match_exact(\@lines, \@lines); ok($ret); libtest-cmd-perl-1.05.orig/t/diff_regex.t0100444000175000017500000000422607415353162017310 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; eval "use Algorithm::DiffOld"; $diffold = ! $@; plan tests => 18, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes, @diff); $ret = Test::Cmd->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 2 3 _EOF_ ok($ret); ok(@diff == 0); $ret = Test::Cmd->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 2 3 _EOF_ 1 222 3 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2c2 < 222 --- > 2 _EOF_ Expected ===== 1 2 3 Actual ===== 1 222 3 _EOF_ $test = Test::Cmd->new; ok($test); $ret = $test->diff_regex("abcde\n", "a.*e\n", \@diff); ok($ret); ok(! @diff); $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); ok(! @diff); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->diff_regex(\@lines, \@regexes, \@diff); ok($ret); ok(! @diff); $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 a b 2 3 c 4 5 _EOF_ 1 2 x 3 4 y z 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 1a2,3 > a > b 3d4 < x 4a6 > c 6,7d7 < y < z _EOF_ Expected ===== 1 2 x 3 4 y z 5 Actual ===== 1 a b 2 3 c 4 5 _EOF_ $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); 1 2 a 3 4 b c 5 _EOF_ 1 x y 2 3 z 4 5 _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 2,3d1 < x < y 4a3 > a 6d4 < z 7a6,7 > b > c _EOF_ Expeced ===== 1 x y 2 3 z 4 5 Actual ===== 1 2 a 3 4 b c 5 _EOF_ $ret = $test->diff_regex(<<'_EOF_', <<'_EOF_', \@diff); a b c e h j l m n p _EOF_ b c d e f j k l m r s t _EOF_ ok(! $ret); ok(join('', @diff) eq $diffold ? <<'_EOF_' : <<'_EOF_'); 0a1 > a 3d3 < d 5c5 < f --- > h 7d6 < k 10,12c9,10 < r < s < t --- > n > p _EOF_ Expected ===== b c d e f j k l m r s t Actual ===== a b c e h j l m n p _EOF_ libtest-cmd-perl-1.05.orig/t/write.t0100444000175000017500000000433507415353162016341 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 25, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, $wdir); $test = Test::Cmd->new(workdir => '', subdir => 'foo'); ok($test); $ret = $test->write('file1', <write(['foo', 'file2'], <write(['bar', 'file3'], <write($test->workpath('file4'), <write($test->workpath('foo', 'file5'), <write($test->workpath('bar', 'file6'), <write([$test->workpath('foo'), 'file7'], <write([$test->workpath('bar'), 'file8'], <workdir; ok($wdir); # I don't understand why, but setting read-only on a Windows NT # directory on Windows NT still allows you to create a file. # That doesn't make sense to my UNIX-centric brain, but it does # mean we need to skip the related tests on Win32 platforms. $ret = chmod(0500, $wdir); skip($iswin32, $ret == 1); $ret = $test->write('file9', < == 0, ! $ret); $ret = chdir($wdir); ok($ret); ok(-d 'foo'); ok(! -d 'bar'); ok(-f 'file1'); ok(-f $test->workpath('foo', 'file2')); ok(! -f $test->workpath('bar', 'file3')); ok(-f 'file4'); ok(-f $test->workpath('foo', 'file5')); ok(! -f $test->workpath('bar', 'file6')); ok(-f $test->workpath('foo', 'file7')); ok(! -f $test->workpath('bar', 'file8')); skip($iswin32 || $> == 0, ! -f 'file9'); libtest-cmd-perl-1.05.orig/t/no_result.t0100444000175000017500000000705507415353162017223 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 35, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } my($run_env, $ret, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.1 2>stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); Test::Cmd->no_result($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.1"); ok($string eq ""); $string = contents("stderr.1"); ok($string eq "NO RESULT for test at line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.2 2>stderr.2"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->no_result($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.2"); ok($string eq ""); $string = contents("stderr.2"); ok($string eq "NO RESULT for test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.3 2>stderr.3"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", string => 'xyzzy', workdir => ''); $test->run(); $test->no_result($? == 0); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.3"); ok($string eq ""); $string = contents("stderr.3"); ok($string eq "NO RESULT for test of run [xyzzy]\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.4 2>stderr.4"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->no_result($? == 0 => sub {print STDERR "Printed on no result.\n"}); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.4"); ok($string eq ""); $string = contents("stderr.4"); ok($string eq "Printed on no result.\nNO RESULT for test of run\n\tat line 4 of -.\n"); # $ret = open(PERL, "|$^X -w @I_FLAGS >stdout.5 2>stderr.5"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; sub test_it { my $self = shift; $self->run(); $self->no_result($? == 0 => undef, 1); } $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); &test_it($test); EOF ok($ret); $ret = close(PERL); ok(! $ret); ok(($? >> 8) == 2); $string = contents("stdout.5"); ok($string eq ""); $string = contents("stderr.5"); ok($string eq "NO RESULT for test of run\n\tat line 5 of - (main::test_it)\n\tfrom line 8 of -.\n"); libtest-cmd-perl-1.05.orig/t/preserve.t0100444000175000017500000000273707415353162017046 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 21, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $wdir, $ret); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file1', <cleanup; ok(! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file2', <preserve('pass'); $test->cleanup('pass'); ok (-d $wdir); $test->cleanup('fail'); ok (! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file3', <preserve('fail'); $test->cleanup('fail'); ok (-d $wdir); $test->cleanup('pass'); ok (! -d $wdir); $test = Test::Cmd->new(workdir => ''); ok($test); $wdir = $test->workdir; ok($wdir); $ret = $test->write('file3', <preserve('fail', 'no_result'); $test->cleanup('fail'); ok (-d $wdir); $test->cleanup('no_result'); ok (-d $wdir); $test->cleanup('pass'); ok (! -d $wdir); libtest-cmd-perl-1.05.orig/t/workdir.t0100444000175000017500000000341007415353162016661 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; my $iswin32; BEGIN { $| = 1; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } plan tests => 22, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. use File::Spec; my($ret, $workdir_foo, $workdir_bar, $no_such_subdir); my $test = Test::Cmd->new; ok($test); ok(! $test->workdir); $test = Test::Cmd->new(workdir => undef); ok($test); ok(! $test->workdir); $test = Test::Cmd->new(workdir => ''); ok($test); ok(File::Spec->file_name_is_absolute($test->workdir)); ok(-d $test->workdir); $test = Test::Cmd->new(workdir => 'dir'); ok($test); ok(File::Spec->file_name_is_absolute($test->workdir)); ok(-d $test->workdir); $no_such_subdir = $test->catfile('no', 'such', 'subdir'); $test = Test::Cmd->new(workdir => $no_such_subdir); ok(! $test); $test = Test::Cmd->new(workdir => 'foo'); ok($test); $workdir_foo = $test->workdir; ok(File::Spec->file_name_is_absolute($workdir_foo)); $ret = $test->workdir('bar'); ok($ret); $workdir_bar = $test->workdir; ok(File::Spec->file_name_is_absolute($workdir_bar)); $ret = $test->workdir($no_such_subdir); ok(! $ret); ok($workdir_bar eq $test->workdir); ok(-d $workdir_foo); ok(-d $workdir_bar); if ($iswin32) { eval("use Win32"); $cwd_ref = \&Win32::GetCwd; } else { eval("use Cwd"); $cwd_ref = \&Cwd::cwd; } $ret = chdir($test->workdir); ok($ret); ok($test->workdir eq &$cwd_ref()); libtest-cmd-perl-1.05.orig/t/workdirs.t0100444000175000017500000000131507415353162017046 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 10, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my $test = Test::Cmd->new; ok($test); ok(! $test->workdir); $wdir_1 = $test->workdir(''); ok($wdir_1); ok(-d $wdir_1); $wdir_2 = $test->workdir(''); ok($wdir_2); ok(-d $wdir_2); ok(-d $wdir_1); $test->cleanup; ok(! -d $wdir_2); ok(! -d $wdir_1); libtest-cmd-perl-1.05.orig/t/pass.t0100444000175000017500000000311607415353162016151 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 11, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. $here = Test::Cmd->here(); my @I_FLAGS = map(Test::Cmd->file_name_is_absolute($_) ? "-I$_" : "-I".Test::Cmd->catfile($here, $_), @INC); sub contents { my $file = shift; if (! open(FILE, $file)) { return undef; } my $string = join('', ); if (! close(FILE)) { return undef; } return $string; } my($run_env, $ret, $wdir, $test, $string); $run_env = Test::Cmd->new(workdir => ''); ok($run_env); $ret = $run_env->write('run', <workdir; ok($wdir); $ret = chdir($wdir); ok($ret); # Everything before this was merely preparation of our "source # directory." Now we do some real tests. $ret = open(PERL, "|$^X -w @I_FLAGS >perl.stdout.1 2>perl.stderr.1"); ok($ret); $ret = print PERL <<'EOF'; use Test::Cmd; $test = Test::Cmd->new(prog => 'run', interpreter => "$^X", workdir => ''); $test->run(); $test->pass($? == 0); EOF ok($ret); $ret = close(PERL); ok($ret); ok($? == 0); $string = contents("perl.stdout.1"); ok($string eq ""); $string = contents("perl.stderr.1"); ok($string eq "PASSED\n"); libtest-cmd-perl-1.05.orig/t/basename.t0100444000175000017500000000134207415353162016755 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 7, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test); $test = Test::Cmd->new; ok($test); ok(! $test->basename); $test->prog('foo'); ok($test->basename eq 'foo'); $test->prog('foo.pl'); ok($test->basename eq 'foo.pl'); ok($test->basename('.pl') eq 'foo'); ok($test->basename('.xyzzy', '.pl', '.zark') eq 'foo'); libtest-cmd-perl-1.05.orig/t/match.t0100444000175000017500000000531507415353162016302 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. ######################### We start with some black magic to print on failure. use Test; BEGIN { $| = 1; plan tests => 31, onfail => sub { $? = 1 if $ENV{AEGIS_TEST} } } END {print "not ok 1\n" unless $loaded;} use Test::Cmd; $loaded = 1; ok(1); ######################### End of black magic. my($test, $ret, @lines, @regexes); $test = Test::Cmd->new; ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok($ret); $test = Test::Cmd->new(match_sub => \&Test::Cmd::match_exact); ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @orig_lines = ( "vwxyz\n", "67890\n" ); @orig_regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); @lines = @orig_lines; @regexes = @orig_regexes; $ret = $test->match(\@lines, \@regexes); ok(! $ret); ok($lines[0] eq $orig_lines[0]); ok($lines[1] eq $orig_lines[1]); ok($regexes[0] eq $orig_regexes[0]); ok($regexes[1] eq $orig_regexes[1]); @lines = @orig_lines; @regexes = @orig_regexes; $ret = $test->match(\@lines, \@lines); ok($ret); ok($lines[0] eq $orig_lines[0]); ok($lines[1] eq $orig_lines[1]); ok($regexes[0] eq $orig_regexes[0]); ok($regexes[1] eq $orig_regexes[1]); eval "use Algorithm::DiffOld"; if ($@) { for ($i = 0; $i < 11; $i++) { skip(1, 0); } } else { $test = Test::Cmd->new(match_sub => \&Test::Cmd::diff_regex); ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok($ret); $test = Test::Cmd->new(match_sub => \&Test::Cmd::diff_exact); ok($test); $ret = $test->match("abcde\n", "a.*e\n"); ok(! $ret); $ret = $test->match("abcde\n", "abcde\n"); ok($ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 1\d+5 a.*e _EOF_ ok(! $ret); $ret = $test->match(<<'_EOF_', <<'_EOF_'); 12345 abcde _EOF_ 12345 abcde _EOF_ ok($ret); @lines = ( "vwxyz\n", "67890\n" ); @regexes = ( "v[^a-u]*z\n", "6\\S+0\n"); $ret = $test->match(\@lines, \@regexes); ok(! $ret); $ret = $test->match(\@lines, \@lines); ok($ret); } libtest-cmd-perl-1.05.orig/MANIFEST0100444000175000017500000000116507415353162015706 0ustar shellshellChanges Cmd.pm Common.pm MANIFEST Makefile.PL README t/ENV_PRESERVE.t t/EXPORT_OK.t t/TMPDIR.t t/basename.t t/cleanup.t t/diff_exact.t t/diff_regex.t t/exit.t t/fail.t t/interpreter.t t/match.t t/match_exact.t t/match_regex.t t/match_sub.t t/no_result.t t/pass.t t/preserve.t t/prog.t t/read.t t/run.t t/stderr.t t/stdin.t t/stdout.t t/string.t t/subdir.t t/workdir.t t/workdirs.t t/workpath.t t/writable.t t/write.t t/Common/chmod.t t/Common/copy.t t/Common/f_matches.t t/Common/m_exist.t t/Common/m_n_exist.t t/Common/read.t t/Common/run.t t/Common/sleep.t t/Common/subdir.t t/Common/touch.t t/Common/unlink.t t/Common/write.t libtest-cmd-perl-1.05.orig/Changes0100444000175000017500000001141007415353162016042 0ustar shellshellRevision history for Perl extension Test::Cmd. 1.05 - Fix the subdir(), read(), and write() methods to handle the case when the first element in an array-reference file name is an absolute path name. - Fix writable() so that it only records errors from chmod() on files, not exit with no_result(). - Doc changes to make some of the variables in the SYNOPSIS look like Perl variables. - Add a Test::Cmd::Common module that sub-classes Test::Cmd to provide common exception-handling, eliminating the need for everyone to roll their own fail()/no_result() logic for common errors. - Update Test::Cmd documentation to add explicit examples of using Test::Cmd in conjunction with Test::Harness, Test::Unit, and Aegis. Mention that Test::Cmd::Common is available. 1.04 Sat Jun 16 13:28:17 CDT 2001 - If the run() method is given an explicit 'prog' argument, don't use the test environment's 'interpreter' attribute to run it. This loses if you're trying to run some other executable that isn't in the same scripting language as the program under test. 1.03 Sat Jun 9 16:57:16 CDT 2001 - Make specification of an 'interpreter' to the run() method independent of whether a 'prog' has been specified. - Actually store the absolute path to a workdir specified as a relative path, as advertised. (Thanks to Jonathan Ross for finding this bug and contributing a patch.) 1.02 - Small fix to make match() backwards compatible to Perl 5.003. - Add diff_exact() and diff_regex() methods for returning UNIX diff(1)-like output from file comparisons. - Accomodate $TMPDIR specifications that vary from Cwd::cwd() due to symbolic links or omission of NT drive letters. 1.01 Sun Aug 27 05:40:35 CDT 2000 - Add a match_exact() method for non-regex matches. - Change the name of the match() method to match_regex(). - Add a new match() method that calls a registered line-matching subroutine to do the match. By default, this is match_regex(), so the external interface stays backwards-compatible. - Add a match_sub() method that allows an arbitrary line-matching subroutine to be registered. - EXPORT_OK the match_exact() and match_regex() methods to make it easier to register them. 1.00 - The early versions have been out there long enough, so promote the version number to 1.00. 0.05 - White space cleanup. - Small fixes for Perl 5.003: put quotes around hash index strings; don't use "my" on the same line as "foreach". - Add copyright statements to appropriate files. 0.04 Tue Feb 1 05:20:19 CST 2000 - Removed unnecessary t0001a.pl file (internal testing glue for the change management system). - In the run() method, add the ability to pipe input into a command. - Add a match() method that matches input lines one-for-one against an equal number of of regular expressions. - Have the run() method support 'prog' and 'interpreter' arguments, for one-shot execution of a program. - Remove direct exception throws (calls to $self->no_result) by the run() and workdir() methods. Exceptions should be handled by the test itself or a subclass specific to the program under test. 0.03 Wed Jan 12 18:02:38 CST 2000 - Minor white space cleanup. - Allow the write() method to take an absolute path name. - Documentation cleanup. - Add a read() method as a companion to write(). - Directories were still removed on fail/no result if PRESERVE_FAIL and PRESERVE_NO_RESULT were set. Fixed. - Where possible, use array assignment, not shift, for method arguments. 0.02 Mon Jan 3 23:59:53 2000 - Add a string() method to arrange for printing info about specific functionality under test upon failure or no result. - Add a basename() method to return the basename of the program under test (the prog() method returns the full path). - Add a workpath() method to catfile its arguments to the end of the temporary working directory; this pushes more of the OS-dependent gunk into the module. - Allow the write() method to take an array reference as a file name argument, in which case the arguments are concatenated using File::Spec->catfile(). - Allow the subdir() method to take a array references as arguments, in which case the elements are concatenated using File::Spec->catfile(). - Change the run() method to take named-keyword arguments like $test->run(args => '1 2 3', chdir => 'sub/dir') instead of the old positional arguments. - Add $caller arguments to the fail() and no_result() methods which specify how many levels back to print a trace of the exiting line. This allows nested packages to get back to the original caller. 0.01 Thu Nov 11 15:50:32 1999 - original version; created by h2xs 1.19 libtest-cmd-perl-1.05.orig/Cmd.pm0100444000175000017500000013465707415353162015633 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. # # This package tests an executable program or script, # managing one or more temporary working directories, # keeping track of standard and error output, # and cleaning up after everything is done. package Test::Cmd; use strict; use vars qw($VERSION @ISA @EXPORT_OK); use Exporter; use File::Basename (); # don't import the basename() method, we redefine it use File::Find; use File::Spec; $VERSION = '1.05'; @ISA = qw(Exporter File::Spec); @EXPORT_OK = qw(match_exact match_regex diff_exact diff_regex); =head1 NAME Test::Cmd - Perl module for portable testing of commands and scripts =head1 SYNOPSIS use Test::Cmd; $test = Test::Cmd->new(prog => 'program_or_script_to_test', interpreter => 'script_interpreter', string => 'identifier_string', workdir => '', subdir => 'dir', match_sub => $code_ref, verbose => 1); $test->verbose(1); $test->prog('program_or_script_to_test'); $test->basename(@suffixlist); $test->interpreter('script_interpreter'); $test->string('identifier string'); $test->workdir('prefix'); $test->workpath('subdir', 'file'); $test->subdir('subdir', ...); $test->subdir(['sub', 'dir'], ...); $test->write('file', <<'EOF'); contents of file EOF $test->write(['subdir', 'file'], <<'EOF'); contents of file EOF $test->read(\$contents, 'file'); $test->read(\@lines, 'file'); $test->read(\$contents, ['subdir', 'file']); $test->read(\@lines, ['subdir', 'file']); $test->writable('dir'); $test->writable('dir', $rwflag); $test->writable('dir', $rwflag, \%errors); $test->preserve(condition, ...); $test->cleanup(condition); $test->run(prog => 'program_or_script_to_test', interpreter => 'script_interpreter', chdir => 'dir', args => 'arguments', stdin => <<'EOF'); input to program EOF $test->pass(condition); $test->pass(condition, \&func); $test->fail(condition); $test->fail(condition, \&func); $test->fail(condition, \&func, $caller); $test->no_result(condition); $test->no_result(condition, \&func); $test->no_result(condition, \&func, $caller); $test->stdout; $test->stdout($run_number); $test->stderr; $test->stderr($run_number); $test->match(\@lines, \@matches); $test->match($lines, $matches); $test->match_exact(\@lines, \@matches); $test->match_exact($lines, $matches); $test->match_regex(\@lines, \@regexes); $test->match_regex($lines, $regexes); $test->diff_exact(\@lines, \@matches, \@output); $test->diff_exact($lines, $matches, \@output); $test->diff_regex(\@lines, \@regexes, \@output); $test->diff_regex($lines, $regexes, \@output); sub func { my ($self, $lines, $matches) = @_; # code to match $lines and $matches } $test->match_sub(\&func); $test->match_sub(sub { code to match $_[1] and $_[2] }); $test->here; =head1 DESCRIPTION The C module provides a low-level framework for portable automated testing of executable commands and scripts (in any language, not just Perl), especially commands and scripts that interact with the file system. The C module makes no assumptions about what constitutes a successful or failed test. Attempting to read a file that doesn't exist, for example, may or may not be an error, depending on the software being tested. Consequently, no C methods (including the C method) exit, die or throw any other sorts of exceptions (but they all do return useful error indications). Exceptions or other error status should be handled by a higher layer: a subclass of C, or another testing framework such as the C or C Perl modules, or by the test itself. (That said, see the C module if you want a similar module that provides exception handling, either to use directly in your own tests, or as an example of how to use C.) In addition to running tests and evaluating conditions, the C module manages and cleans up one or more temporary workspace directories, and provides methods for creating files and directories in those workspace directories from in-line data (that is, here-documents), allowing tests to be completely self-contained. When used in conjunction with another testing framework, the C module can function as a I (common startup code for multiple tests) for simple management of command execution and temporary workspaces. The C module inherits C methods (C, C, etc.) to support writing tests portably across a variety of operating and file systems. A C environment object is created via the usual invocation: $test = Test::Cmd->new(); Arguments to the C method are keyword-value pairs that may be used to initialize the object, typically by invoking the same-named method as the keyword. =head1 TESTING FRAMEWORKS As mentioned, because the C module makes no assumptions about what constitutes success or failure of a test, it can be used to provide temporary workspaces, other file system interaction, or command execution for a variety of testing frameworks. This section describes how to use the C with several different higher-layer testing frameworks. Note that you should I intermix multiple testing frameworks in a single testing script. =head2 C The C module may be used in tests that print results in a format suitable for the standard Perl C module: use Test::Cmd; print "1..5\n"; $test = Test::Cmd->new(prog => 'test_program', workdir => ''); if ($test) { print "ok 1\n"; } else { print "not ok 1\n"; } $input = <<_EOF; test_program should process this input and exit successfully (status 0). _EOF_ $wrote_file = $test->write('input_file', $input); if ($wrote_file) { print "ok 2\n"; } else { print "not ok 2\n"; } $test->run(args => '-x input_file'); if ($? == 0) { print "ok 3\n"; } else { print "not ok 3\n"; } $wrote_file = $test->write('input_file', $input); if ($wrote_file) { print "ok 4\n"; } else { print "not ok 4\n"; } $test->run(args => '-y input_file'); if ($? == 0) { print "ok 5\n"; } else { print "not ok 5\n"; } Several other Perl modules simplify the use of C by eliminating the need to hand-code the C statements and test numbers. The C module, the C module, and the C module all export an C subroutine to test conditions. Here is how the above example would look rewritten to use C: use Test::Simple tests => 5; use Test::Cmd; $test = Test::Cmd->new(prog => 'test_program', workdir => ''); ok($test, "creating Test::Cmd object"); $input = <<_EOF; test_program should process this input and exit successfully (status 0). _EOF_ $wrote_file = $test->write('input_file', $input); ok($wrote_file, "writing input_file"); $test->run(args => '-x input_file'); ok($? == 0, "executing test_program -x input_file"); $wrote_file = $test->write('input_file', $input); ok($wrote_file, "writing input_file"); $test->run(args => '-y input_file'); ok($? == 0, "executing test_program -y input_file"); =head2 C The Perl C package provides a procedural testing interface modeled after a testing framework widely used in the eXtreme Programming development methodology. The C module can function as part of a C fixture that can set up workspaces as needed for a set of tests. This avoids having to repeat code to re-initialize an input file multiple times: use Test::Unit; use Test::Cmd; my $test; $input = <<'EOF'; test_program should process this input and exit successfully (status 0). EOF sub set_up { $test = Test::Cmd->new(prog => 'test_program', workdir => ''); $test->write('input_file', $input); } sub test_x { my $result = $test->run(args => '-x input_file'); assert($result == 0, "failed test_x\n"); } sub test_y { my $result = $test->run(args => '-y input_file'); assert($result == 0, "failed test_y\n"); } create_suite(); run_suite; Note that, because the C module takes care of cleaning up temporary workspaces on exit, there is no need to remove explicitly the workspace in a C subroutine. (There may, of course, be other things in the test that need a C subroutine.) =head2 Aegis Alternatively, the C module provides C, C, and C methods that can be used to provide an appropriate exit status and simple printed indication for a test. These methods terminate the test immediately, reporting C, C, or C respectively, and exiting with status 0 (success), 1 or 2 respectively. The separate C and C methods allow for a distinction between an actual failed test and a test that could not be properly evaluated because of an external condition (such as a full file system or incorrect permissions). The exit status values happen to match the requirements of the Aegis change management system, and the printed strings are based on existing Aegis conventions. They are not really Aegis-specific, however, and provide a simple, useful starting point if you don't already have another testing framework: use Test::Cmd; $test = Test::Cmd->new(prog => 'test_program', workdir => ''); Test::Cmd->no_result(! $test); $input = <write('input_file', $input); $test->no_result(! $wrote_file); $test->run(args => '-x input_file'); $test->fail($? != 0); $wrote_file = $test->write('input_file', $input); $test->no_result(! $wrote_file); $test->run(args => '-y input_file'); $test->fail($? != 0); $test->pass; Note that the separate C wrapper module can simplify the above example even further by taking care of common exception handling cases within the testing object itself. use Test::Cmd::Common; $test = Test::Cmd::Common->new(prog => 'test_program', workdir => ''); $input = <write('input_file', $input); $test->run(args => '-x input_file'); $wrote_file = $test->write('input_file', $input); $test->run(args => '-y input_file'); $test->pass; See the C module for details. =head1 METHODS Methods supported by the C module include: =over 4 =cut my @Cleanup; my $Run_Count; my $Default; # Map exit values to conditions. my @Cond = ( 'pass', 'fail', 'no_result' ); BEGIN { $Run_Count = 0; # The File::Spec->tmpdir method was only added recently, # so we can't assume it's there. $Test::Cmd::TMPDIR = eval("File::Spec->tmpdir"); # now we do win32 detection. what a mess :-( # if the version is 5.003, we can check $^O my $iswin32; if ($] < 5.003) { eval("require Win32"); $iswin32 = ! $@; } else { $iswin32 = $^O eq "MSWin32"; } my @tmps = (); if ($iswin32) { eval("use Win32;"); $Test::Cmd::_WIN32 = 1; $Test::Cmd::Temp_Prefix = "~testcmd$$-"; $Test::Cmd::Cwd_Ref = \&Win32::GetCwd; # Test for WIN32 temporary directories. # The following is lifted from the 5.005056 # version of File::Spec::Win32::tmpdir. push @tmps, (@ENV{qw(TMPDIR TEMP TMP)}, qw(/tmp /)); } else { eval("use Cwd"); $Test::Cmd::Temp_Prefix = "testcmd$$."; $Test::Cmd::Cwd_Ref = \&Cwd::cwd; # Test for UNIX temporary directories. # The following is lifted from the 5.005056 # version of File::Spec::Unix::tmpdir. push @tmps, ($ENV{TMPDIR}, "/tmp"); } if (! $Test::Cmd::TMPDIR) { foreach (@tmps) { next unless defined && -d && -w; $Test::Cmd::TMPDIR = $_; last; } } # Get the absolute path to the temporary directory, in case # the TMPDIR specification is affected by symbolic links, # or by lack of a volume name on WIN32. # The following better way isn't available in the Cwd module # until sometime after 5.003: # $Test::Cmd::TMPDIR = Cwd::abs_path($Test::Cmd::TMPDIR); my($save) = &$Test::Cmd::Cwd_Ref(); chdir($Test::Cmd::TMPDIR); $Test::Cmd::TMPDIR = &$Test::Cmd::Cwd_Ref(); chdir($save); $Default = {}; $Default->{'failed'} = 0; $Default->{'verbose'} = $ENV{VERBOSE} || 0; if (defined $ENV{PRESERVE}) { $Default->{'preserve'}->{'fail'} = $ENV{PRESERVE} || 0; $Default->{'preserve'}->{'pass'} = $ENV{PRESERVE} || 0; $Default->{'preserve'}->{'no_result'} = $ENV{PRESERVE} || 0; } else { $Default->{'preserve'}->{'fail'} = $ENV{PRESERVE_FAIL} || 0; $Default->{'preserve'}->{'pass'} = $ENV{PRESERVE_PASS} || 0; $Default->{'preserve'}->{'no_result'} = $ENV{PRESERVE_NO_RESULT} || 0; } sub handler { print STDERR "NO RESULT -- SIG$_ received.\n"; my $test; foreach $test (@Cleanup) { $test->cleanup('no_result'); } exit(2); } $SIG{HUP} = \&handler if $SIG{HUP}; $SIG{INT} = \&handler; $SIG{QUIT} = \&handler; $SIG{TERM} = \&handler; } END { my $cond = @Cond[$?] || 'no_result'; my $test; foreach $test (@Cleanup) { $test->cleanup($cond); } } =item C Create a new C environment. Arguments with which to initialize the environment are passed in as keyword-value pairs. Fails if a specified temporary working directory or subdirectory cannot be created. Does NOT die or exit on failure, but returns FALSE if the test environment object cannot be created. =cut sub new { my $type = shift; my $self = {}; %$self = %$Default; $self->{'cleanup'} = []; $self->{'preserve'} = {}; %{$self->{'preserve'}} = %{$Default->{'preserve'}}; $self->{'cwd'} = &$Test::Cmd::Cwd_Ref(); while (@_) { my $keyword = shift; $self->{$keyword} = shift; } bless $self, $type; if (defined $self->{'workdir'}) { if (! $self->workdir($self->{'workdir'})) { return undef; } } if (defined $self->{'subdir'}) { if (! $self->subdir($self->{'subdir'})) { return undef; } } $self->prog($self->{'prog'}); $self->match_sub($self->{'match_sub'} || \&Test::Cmd::match_regex); push @Cleanup, $self; $self; } =item C Sets the verbose level for the environment object to the specified value. =cut sub verbose { my $self = shift; $self->{'verbose'} = $_; } =item C Specifies the executable program or script to be tested. Returns the absolute path name of the current program or script. =cut sub prog { my ($self, $prog) = @_; if ($prog) { # make sure we're always talking about the same program if (! $self->file_name_is_absolute($prog)) { $prog = $self->catfile($self->{'cwd'}, $prog); } $self->{'prog'} = $prog; } return $self->{'prog'}; } =item C Returns the basename of the current program or script. Any specified arguments are a list of file suffixes that may be stripped from the basename. =cut sub basename { my $self = shift; return undef if ! $self->{'prog'}; File::Basename::basename($self->{'prog'}, @_); } =item C Specifies the program to be used to interpret C as a script. Returns the current value of C. =cut sub interpreter { my ($self, $interpreter) = @_; $self->{'interpreter'} = $interpreter if defined $interpreter; $self->{'interpreter'}; } =item C Specifies an identifier string for the functionality being tested to be printed on failure or no result. =cut sub string { my ($self, $string) = @_; $self->{'string'} = $string if defined $string; $self->{'string'}; } my $counter = 0; sub _workdir_name { my $self = shift; while (1) { $counter++; my $name = $self->catfile($Test::Cmd::TMPDIR, $Test::Cmd::Temp_Prefix . $counter); return $name if ! -e $name; } } =item C When an argument is specified, creates a temporary working directory with the specified name. If the argument is a NULL string (''), the directory is named C by default, followed by the unique ID of the executing process. Returns the absolute pathname to the temporary working directory, or FALSE if the directory could not be created. =cut sub workdir { my ($self, $workdir) = @_; if (defined($workdir)) { # return if $workdir && $self->{'workdir'} eq $workdir; # no change my $wdir = $workdir || $self->_workdir_name; if (!mkdir($wdir, 0755)) { return undef; } # The following better way to fetch the absolute path of the # workdir isn't available in the Cwd module until sometime # after 5.003: # $self->{'workdir'} = Cwd::abs_path($wdir); my($save) = &$Test::Cmd::Cwd_Ref(); chdir($wdir); $self->{'workdir'} = &$Test::Cmd::Cwd_Ref(); chdir($save); push(@{$self->{'cleanup'}}, $self->{'workdir'}); } $self->{'workdir'}; } =item C Returns the absolute path name to a subdirectory or file under the current temporary working directory by concatenating the temporary working directory name with the specified arguments. =cut sub workpath { my $self = shift; return undef if ! $self->{'workdir'}; $self->catfile($self->{'workdir'}, @_); } =item C Creates new subdirectories under the temporary working dir, one for each argument. An argument may be an array reference, in which case the array elements are concatenated together using the Ccatfile> method. Subdirectories multiple levels deep must be created via a separate argument for each level: $test->subdir('sub', ['sub', 'dir'], [qw(sub dir ectory)]); Returns the number of subdirectories actually created. =cut sub subdir { my $self = shift; my $count = 0; foreach (@_) { my $newdir = ref $_ ? $self->catfile(@$_) : $_; if (! $self->file_name_is_absolute($newdir)) { $newdir = $self->catfile($self->{'workdir'}, $newdir); } if (mkdir($newdir, 0755)) { $count++; } } return $count; } =item C Writes the specified text (second argument) to the specified file name (first argument). The file name may be an array reference, in which case all the array elements except the last are subdirectory names to be concatenated together. The file is created under the temporary working directory. Any subdirectories in the path must already exist. =cut sub write { my $self = shift; my $file = shift; # the file to write to $file = $self->catfile(@$file) if ref $file; if (! $self->file_name_is_absolute($file)) { $file = $self->catfile($self->{'workdir'}, $file); } if (! open(OUT, ">$file")) { return undef; } if (! print OUT @_) { return undef; } return close(OUT); } =item C Reads the contents of the specified file name (second argument) into the scalar or array referred to by the first argument. The file name may be an array reference, in which case all the array elements except the last are subdirectory names to be concatenated together. The file is assumed to be under the temporary working directory unless it is an absolute path name. Returns TRUE on successfully opening and reading the file, FALSE otherwise. =cut sub read { my ($self, $destref, $file) = @_; return undef if ref $destref ne 'SCALAR' && ref $destref ne 'ARRAY'; $file = $self->catfile(@$file) if ref $file; if (! $self->file_name_is_absolute($file)) { $file = $self->catfile($self->{'workdir'}, $file); } if (! open(IN, "<$file")) { return undef; } my @lines = ; if (! close(IN)) { return undef; } if (ref $destref eq 'SCALAR') { $$destref = join('', @lines); } else { @$destref = @lines; } return (1); } =item C Makes every file and directory within the specified directory tree writable (C == TRUE) or not writable (C == FALSE). The default is to make the directory tree writable. Optionally fills in the supplied hash reference with a hash of path names that could not have their permissions set appropriately, with the reason why each could not be set. =cut my $_errors; sub writable { my ($self, $dir, $flag, $err) = @_; $flag = 1 if ! defined $flag; $Test::Cmd::_errors = $err || {}; if ($flag) { sub _writable { if (!chmod 0755, $_) { $Test::Cmd::_errors->{$_} = $!; } } finddepth(\&_writable, $dir); } else { sub _writeprotect { if (!chmod 0555, $_) { $Test::Cmd::_errors->{$_} = $!; } } finddepth(\&_writeprotect, $dir); } return 0 + keys %$Test::Cmd::_errors; } =item C Arranges for the temporary working directories for the specified C environment to be preserved for one or more conditions. If no conditions are specified, arranges for the temporary working directories to be preserved for all conditions. =cut sub preserve { my $self = shift; my @cond = (@_) ? @_ : qw(pass fail no_result); my $cond; foreach $cond (@cond) { $self->{'preserve'}->{$cond} = 1; } } sub _nuke { # print STDERR "unlink($_)\n" if (!-d $_); # print STDERR "rmdir($_)\n" if (-d $_ && $_ ne "."); unlink($_) if (!-d $_); rmdir($_) if (-d $_ && $_ ne "."); 1; } =item C Removes any temporary working directories for the specified C environment. If the environment variable C was set when the C module was loaded, temporary working directories are not removed. If any of the environment variables C, C, or C were set when the C module was loaded, then temporary working directories are not removed if the test passed, failed, or had no result, respectively. Temporary working directories are also preserved for conditions specified via the C method. Typically, this method is not called directly, but is used when the script exits to clean up temporary working directories as appropriate for the exit status. =cut sub cleanup { my ($self, $cond) = @_; $cond = (($self->{'failed'} == 0) ? 'pass' : 'fail') if !$cond; if ($self->{'preserve'}->{$cond}) { print STDERR "Preserving work directory ".$self->{'workdir'}."\n" if $self->{'verbose'}; return; } chdir $self->{'cwd'}; # cd out of whatever work dir we're in my $dir; foreach $dir (@{$self->{'cleanup'}}) { $self->writable($dir, "true"); finddepth(\&_nuke, $dir); rmdir($dir); } $self->{'cleanup'} = []; } =item C Runs a test of the program or script for the test environment. Standard output and error output are saved for future retrieval via the C and C methods. Arguments are supplied as keyword-value pairs: =over 4 =item C Specifies the command-line arguments to be supplied to the program or script under test for this run: $test->run(args => 'arg1 arg2'); =item C Changes directory to the path specified as the value argument: $test->run(chdir => 'xyzzy'); If the specified path is not an absolute path name (begins with '/' on Unix systems), then the subdirectory is relative to the temporary working directory for the environment (C<$test-&>workdir>). Note that, by default, the C module does NOT chdir to the temporary working directory, so to execute the test under the temporary working directory, you must specify an explicit C to the current directory: $test->run(chdir => '.'); # Unix-specific $test->run(chdir => $test->curdir); # portable =item C Specifies the program to be used to interpret C as a script, for this run only. This does not change the C<$test-&>interpreter> value of the test environment. =item C Specifies the executable program or script to be run, for this run only. This does not change the C<$test-&>prog> value of the test environment. =item C Pipes the specified value (string or array ref) to the program or script under test for this run: $test->run(stdin => <<_EOF_); input to the program under test _EOF_ =back Returns the exit status of the program or script. =cut sub run { my $self = shift; my %args = @_; my $oldcwd; if ($args{'chdir'}) { $oldcwd = &$Test::Cmd::Cwd_Ref(); if (! $self->file_name_is_absolute($args{'chdir'})) { $args{'chdir'} = $self->catfile($self->{'workdir'}, $args{'chdir'}); } print STDERR "Changing to $args{'chdir'}\n" if $self->{'verbose'}; if (!chdir $args{'chdir'}) { return undef; } } $Run_Count++; my $stdout_file = $self->_stdout_file($Run_Count); my $stderr_file = $self->_stderr_file($Run_Count); my $cmd; if ($args{'prog'}) { if (! $self->file_name_is_absolute($args{'prog'})) { $args{'prog'} = $self->catfile($self->{'cwd'}, $args{'prog'}); } $cmd = $args{'prog'}; $cmd = $args{'interpreter'}." ".$cmd if $args{'interpreter'}; } else { $cmd = $self->{'prog'}; if ($args{'interpreter'}) { $cmd = $args{'interpreter'}." ".$cmd; } elsif ($self->{'interpreter'}) { $cmd = $self->{'interpreter'}." ".$cmd; } } $cmd = $cmd." ".$args{'args'} if $args{'args'}; $cmd =~ s/\$work/$self->{'workdir'}/g; $cmd = "|$cmd 1>$stdout_file 2>$stderr_file"; print STDERR "Invoking $cmd\n" if $self->{'verbose'}; if (! open(RUN, $cmd)) { $? = 2; print STDERR "Could not invoke $cmd: $!\n"; return undef; } if ($args{'stdin'}) { print RUN ref $args{'stdin'} ? @{$args{'stdin'}} : $args{'stdin'}; } close(RUN); my $return = $?; chdir $oldcwd if $oldcwd; return $return; } sub _to_value { my $v = shift; (ref $v or '') eq 'CODE' ? &$v() : $v; } =item C Exits the test successfully. Reports "PASSED" on the error output and exits with a status of 0. If a condition is supplied, only exits the test if the condition evaluates TRUE. If a function reference is supplied, executes the function before reporting and exiting. =cut sub pass { my $self = shift; @_ = (1) if @_ == 0; # provide default arg my ($cond, $funcref) = @_; return if ! _to_value($cond); &$funcref() if $funcref; print STDERR "PASSED\n"; # Let END take care of cleanup. exit (0); } =item C Exits the test unsuccessfully. Reports "FAILED test of {string} at line {line} of {file}." on the error output and exits with a status of 1. If a condition is supplied, only exits the test if the condition evaluates TRUE. If a function reference is supplied, executes the function before reporting and exiting. If a caller level is supplied, prints a simple calling trace N levels deep as part of reporting the failure. =cut sub fail { my $self = shift; @_ = (1) if @_ == 0; # provide default arg my ($cond, $funcref, $caller) = @_; return if ! _to_value($cond); &$funcref() if $funcref; $caller = 0 if ! defined($caller); my $of_str = " "; if (ref $self) { my $basename = $self->basename; if ($basename) { $of_str = " of ".$self->basename; if ($self->{'string'}) { $of_str .= " [".$self->{'string'}."]"; } $of_str .= "\n\t"; } } my $c = 0; my ($pkg,$file,$line,$sub) = caller($c++); print STDERR "FAILED test${of_str}at line $line of $file"; while ($c <= $caller) { ($pkg,$file,$line,$sub) = caller($c++); print STDERR " ($sub)\n\tfrom line $line of $file"; } print STDERR ".\n"; # Let END take care of cleanup. exit (1); } =item C Exits the test with an indeterminate result (the test could not be performed due to external conditions such as, for example, a full file system). Reports "NO RESULT for test of {string} at line {line} of {file}." on the error output and exits with a status of 2. If a condition is supplied, only exits the test if the condition evaluates TRUE. If a function reference is supplied, executes the function before reporting and exiting. If a caller level is supplied, prints a simple calling trace N levels deep as part of reporting the failure. =cut sub no_result { my $self = shift; @_ = (1) if @_ == 0; # provide default arg my ($cond, $funcref, $caller) = @_; return if ! _to_value($cond); &$funcref() if $funcref; $caller = 0 if ! defined($caller); my $of_str = " "; if (ref $self) { my $basename = $self->basename; if ($basename) { $of_str = " of ".$self->basename; if ($self->{'string'}) { $of_str .= " [".$self->{'string'}."]"; } $of_str .= "\n\t"; } } my $c = 0; my ($pkg,$file,$line,$sub) = caller($c++); print STDERR "NO RESULT for test${of_str}at line $line of $file"; while ($c <= $caller) { ($pkg,$file,$line,$sub) = caller($c++); print STDERR " ($sub)\n\tfrom line $line of $file"; } print STDERR ".\n"; # Let END take care of cleanup. exit (2); } sub _stdout_file { my ($self, $count) = @_; $self->catfile($self->{'workdir'}, "stdout.$count"); } sub _stderr_file { my ($self, $count) = @_; $self->catfile($self->{'workdir'}, "stderr.$count"); } =item C Returns the standard output from the specified run number. If there is no specified run number, then returns the standard output of the last run. Returns the standard output as either a scalar or an array of output lines, as appropriate for the calling context. Returns C if there has been no test run. =cut sub stdout { my $self = shift; my $count = @_ ? shift : $Run_Count; return undef if ! $Run_Count; my @lines; if (! $self->read(\@lines, $self->_stdout_file($count))) { return undef; } return (wantarray ? @lines : join('', @lines)); } =item C Returns the error output from the specified run number. If there is no specified run number, then returns the error output of the last run. Returns the error output as either a scalar or an array of output lines, as apporpriate for the calling context. Returns C if there has been no test run. =cut sub stderr { my $self = shift; my $count = @_ ? shift : $Run_Count; return undef if ! $Run_Count; my @lines; if (! $self->read(\@lines, $self->_stderr_file($count))) { return undef; } return (wantarray ? @lines : join('', @lines)); } sub _make_arrays { my ($lines, $matches) = @_; my @line_array; my @match_array; if (ref $lines) { chomp(@line_array = @$lines); } else { @line_array = split(/\n/, $lines, -1); pop(@line_array); } if (ref $matches) { chomp(@match_array = @$matches); } else { @match_array = split(/\n/, $matches, -1); pop(@match_array); } return (\@line_array, \@match_array); } =item C Matches one or more input lines against an equal number of expected lines using the currently-registered line-matching function. The default line-matching function is the C method, which means that the default is to match lines against regular expressions. =cut sub match { my $self = shift; # We can write this more clearly when we drop support for Perl 5.003: # $self->{'match_sub'}->($self, @_); &{$self->{'match_sub'}}($self, @_); } sub _matcher { my ($lines, $matches, $sub) = @_; ($lines, $matches) = _make_arrays($lines, $matches); return undef if @$lines != @$matches; my ($i, $l, $m); for ($i = 0; $i <= $#{ $matches }; $i++) { # More clearly, but doesn't work in Perl 5.003: # if (! $sub->($lines->[$i], $matches->[$i])) if (! &{$sub}($lines->[$i], $matches->[$i])) { #print STDERR "Line ", $i+1, " does not match:\n"; #print STDERR "Expect: ${\$matches->[\$i]}\n"; #print STDERR "Got: ${\$lines->[\$i]}\n"; return undef; } } return 1; } =item C Compares two arrays of lines for exact matches. The arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. An unequal number of lines in the two arrays fails immediately and returns FALSE before any comparisons are performed. Returns TRUE if each line matched its corresponding line in the other array, FALSE otherwise. =cut sub match_exact { my ($self, $lines, $matches) = @_; _matcher($lines, $matches, sub {$_[0] eq $_[1]}); } =item C Matches one or more input lines against an equal number of regular expressions. The arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. Trailing newlines are stripped from each line and regular expression. An unequal number of lines and regular expressions fails immediately and returns FALSE before any comparisons are performed. Comparison is performed for each entire line, that is, with each regular expression anchored at both the start of line (^) and end of line ($). Returns TRUE if each line matched each regular expression, FALSE otherwise. =cut sub match_regex { my ($self, $lines, $regexes) = @_; _matcher($lines, $regexes, sub {$_[0] =~ m/^$_[1]$/}); } sub _range { ($_[0]->[1] + 1) . ((@_ == 1) ? '' : (',' . ($_[-1]->[1] + 1))) } my $_differ; eval("use Algorithm::DiffOld;"); if ($@) { $_differ = \&_differ_no_lcs; } else { $_differ = \&_differ_lcs; } sub _differ_lcs { my ($matches, $lines, $output, $sub) = @_; ($lines, $matches) = _make_arrays($lines, $matches); @$output = () if defined $output; my @diffs = Algorithm::DiffOld::diff($matches, $lines, $sub); return 1 if @diffs == 0; if (defined $output) { my $added = 0; my $hunk; foreach $hunk (@diffs) { my @deletions = grep($_->[0] eq '-', @$hunk); my @additions = grep($_->[0] eq '+', @$hunk); if (! @deletions) { push @$output, ($additions[0]->[1] - $added) . 'a' . _range(@additions) . "\n"; push @$output, "> " . join("\n> ", map($_->[2], @additions)) . "\n"; } elsif (! @additions) { push @$output, _range(@deletions) . 'd' . ($deletions[0]->[1] + $added) . "\n"; push @$output, "< " . join("\n< ", map($_->[2], @deletions)) . "\n"; } else { push @$output, _range(@deletions) . 'c' . _range(@additions) . "\n"; push @$output, "< " . join("\n< ", map($_->[2], @deletions)) . "\n"; push @$output, "---\n"; push @$output, "> " . join("\n> ", map($_->[2], @additions)) . "\n"; } $added += @additions - @deletions; } } return undef; } sub _differ_no_lcs { my ($matches, $lines, $output, $sub) = @_; ($lines, $matches) = _make_arrays($lines, $matches); @$output = () if defined $output; return 1 if _matcher($matches, $lines, $sub); if (defined $output) { push @$output, "Expected =====\n"; push @$output, map { $_ . "\n" } @$matches; push @$output, "Actual =====\n"; push @$output, map { $_ . "\n" } @$lines; } return undef; } =item C Diffs two arrays of lines in a manner similar to the UNIX C utility. If the C package is installed on the local system, output describing the differences between the input lines and the matching lines, in C format, is saved to the C<$output> array reference. In the diff output, the expected output lines are considered the "old" (left-hand) file, and the actual output is considered the "new" (right-hand) file. If the C package is I installed on the local system, the Expected and Actual contents are saved as-is to the C<$output> array reference. The C and C arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. Trailing newlines are stripped from each line and regular expression. Returns TRUE if each line matched its corresponding line in the expected matches, FALSE otherwise, in order to conform to the conventions of the C method. Typical invocation: if (! $test->diff_exact($test->stdout, \@expected_lines, \@diff)) { print @diff; } =cut sub diff_exact { my ($self, $lines, $matches, $output) = @_; return &{$_differ}($matches, $lines, $output, sub {$_[0] eq $_[1]}); } =item C Diffs one or more input lines against one or more regular expressions in a manner similar to the UNIX C utility. If the C package is installed on the local system, output describing the differences between the input lines and the matching lines, in C format, is saved to the C<$output> array reference. In the diff output, the expected output lines are considered the "old" (left-hand) file, and the actual output is considered the "new" (right-hand) file. If the C package is I installed on the local system, the Expected and Actual contents are saved as-is to the C<$output> array reference. The C and C arguments are passed in as either scalars, in which case each is split on newline boundaries, or as array references. Trailing newlines are stripped from each line and regular expression. Comparison is performed for each entire line, that is, with each regular expression anchored at both the start of line (^) and end of line ($). Returns TRUE if each line matched each regular expression, FALSE otherwise, in order to conform to the conventions of the C method. Typical invocation: if (! $test->diff_regex($test->stdout, \@expected_lines, \@diff)) { print @diff; } =cut sub diff_regex { my ($self, $lines, $regexes, $output) = @_; return &{$_differ}($regexes, $lines, $output, sub {$_[1] =~ /^$_[0]$/}); } =item C Registers the specified code reference as the line-matching function to be called by the C method. This can be a user-supplied subroutine, or the C, C, C, or C methods supplied by the C module: $test->match_sub(\&Test::Cmd::match_exact); $test->match_sub(\&Test::Cmd::match_regex); $test->match_sub(\&Test::Cmd::diff_exact); $test->match_sub(\&Test::Cmd::diff_regex); The C, C, C and C subroutine names are exportable from the C module, and may be specified at object initialization: use Test::Cmd qw(match_exact match_regex diff_exact diff_regex); $test_exact = Test::Cmd->new(match_sub => \&match_exact); $test_regex = Test::Cmd->new(match_sub => \&match_regex); $test_exact = Test::Cmd->new(match_sub => \&diff_exact); $test_regex = Test::Cmd->new(match_sub => \&diff_regex); =cut sub match_sub { my ($self, $funcref) = @_; $self->{'match_sub'} = $funcref if defined $funcref; $self->{'match_sub'}; } =item C Returns the absolute path name of the current working directory. (This is essentially the same as the C method, except that the C method preserves the directory separators exactly as returned by the underlying operating-system-dependent method. The C method canonicalizes all directory separators to '/', which makes for consistent path name representations within Perl, but may mess up another program or script to which you try to pass the path name.) =cut sub here { &$Test::Cmd::Cwd_Ref(); } 1; __END__ =back =head1 ENVIRONMENT Several environment variables affect the default values in a newly created C environment object. These environment variables must be set when the module is loaded, not when the object is created. =over 4 =item C If set to a true value, all temporary working directories will be preserved on exit, regardless of success or failure of the test. The full path names of all temporary working directories will be reported on error output. =item C If set to a true value, all temporary working directories will be preserved on exit from a failed test. The full path names of all temporary working directories will be reported on error output. =item C If set to a true value, all temporary working directories will be preserved on exit from a test for which there is no result. The full path names of all temporary working directories will be reported on error output. =item C If set to a true value, all temporary working directories will be preserved on exit from a successful test. The full path names of all temporary working directories will be reported on error output. =item C When set to a true value, enables verbose reporting of various internal things (path names, exact command line being executed, etc.). =back =head1 PORTABLE TESTS Although the C module is intended to make it easier to write portable tests for portable utilities that interact with file systems, it is still very easy to write non-portable tests if you're not careful. The best and most comprehensive set of portability guidelines is the standard "Writing portable Perl" document at: http://www.perl.com/pub/doc/manual/html/pod/perlport.html To reiterate one important point from the "WpP" document: Not all Perl programs have to be portable. If the program or script you're testing is UNIX-specific, you can (and should) use the C module to write UNIX-specific tests. That having been said, here are some hints that may help keep your tests portable, if that's a requirement. =over 4 =item Use the Chere> method for current directory path. The normal Perl way to fetch the current working directory is to use the C method. Unfortunately, the C method canonicalizes the path name it returns, changing the native directory separators into the forward slashes favored by Perl and UNIX. For most Perl scripts, this makes a great deal of sense and keeps code uncluttered. Passing in a file name that has had its directory separators altered, however, may confuse the command or script under test, or make it difficult to compare output from the command or script with an expected result. The C method returns the absolute path name of the current working directory, like C, but does not manipulate the returned path in any way. =item Use C methods for manipulating path names. The C module provides a system-independent interface for manipulating path names. Because the C class is a sub-class of the C class, you can use these methods directly as follows: if (! Test::Cmd->file_name_is_absolute($prog)) { my $prog = Test::Cmd->catfile(Test::Cmd->here, $prog); } For details about the available methods and their use, see the documentation for the C module and its sub-modules, especially the C modules. =item Use C for file-name suffixes, where possible. The standard C module provides values that reflect the file-name suffixes on the system for which the Perl executable was built. This provides convenient portability for situations where a file name may have different extensions on different systems: $foo_exe = "foo$Config{_exe}"; ok(-f $foo_exe); (Unfortunately, there is no existing C<$Config> value that specifies the suffix for a directly-executable Perl script.) =item Avoid generating executable programs or scripts. How to make a file or script executable varies widely from system to system, some systems using file name extensions to indicate executability, others using a file permission bit. The differences are complicated to accomodate in a portable test script. The easiest way to deal with this complexity is to avoid it if you can. If your test somehow requires executing a script that you generate from the test itself, the best way is to generate the script in Perl and then explicitly feed it to the Perl executable on the local system. To be maximally portable, use the C<$^X> variable instead of hard-coding "perl" into the string you execute: $line = "This is output from the generated perl script."; $test->write('script', < file itself executable. (Since you're writing your test in Perl, it's safe to assume that Perl itself is executable.) If you must generate a directly-executable script, then use the C<$Config{'startperl'}> variable at the start of the script to generate the appropriate magic that will execute it as a Perl script: use Config; $line = "This is output from the generated perl script."; $test->write('script', <workdir); chmod(0755, 'script'); # POSIX-SPECIFIC $output = `script`; ok($output eq "$line\n"); =back 4 Addtional hints on writing portable tests are welcome. =head1 SEE ALSO perl(1), Algorithm::DiffOld(3), File::Find(3), File::Spec(3), Test(3), Test::Cmd::Common(3), Test::Harness(3), Test::More(3), Test::Simple(3), Test::Unit(3). A rudimentary page for the C module is available at: http://www.baldmt.com/Test-Cmd/ The most involved example of using the C package to test a real-world application is the C testing suite for the Cons software construction utility. The suite uses a sub-class of C (which in turn is a sub-class of C) to provide common, application-specific infrastructure across a large number of end-to-end application tests. The suite, and other information about Cons, is available at: http://www.dsmit.com/cons =head1 AUTHORS Steven Knight, knight@baldmt.com =head1 COPYRIGHT Copyright 1999-2001 Steven Knight. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 ACKNOWLEDGEMENTS Thanks to Greg Spencer for the inspiration to create this package and the initial draft of its implementation as a specific testing package for the Cons software construction utility. Information about Cons is available at: http://www.dsmit.com/cons/ The general idea of managing temporary working directories in this way, as well as the test reporting of the C, C and C methods, come from the testing framework invented by Peter Miller for his Aegis project change supervisor. Aegis is an excellent bit of work which integrates creation and execution of regression tests into the software development process. Information about Aegis is available at: http://www.tip.net.au/~millerp/aegis.html Thanks to Michael Schwern for all of the thoughtful work he's put into Perl's standard testing methodology, including the C and C modules, and enhancement and maintenance of the C and C modules. Thanks also to Christian Lemburg for the impressively complete C framework of modules. Ideas from both have helped keep C flexible enough to be useful in multiple testing frameworks. =cut libtest-cmd-perl-1.05.orig/README0100444000175000017500000000615107415353162015435 0ustar shellshellTHE Test::Cmd MODULE The Test::Cmd module provides a framework for portable automated testing of executable commands and scripts (in any language, not just Perl), especially commands and scripts that interace with the file system. In addition to running tests and evaluating conditions, the Test::Cmd module manages and cleans up one or more temporary workspace directories, and provides methods for creating files and directories in those workspace directories from in-line data (that is, here-documents), allowing tests to be completely self-contained. The Test::Cmd module inherits File::Spec methods (file_name_is_absolute(), catfile(), etc.) to support writing tests portably across a variety of operating and file systems. The Test::Cmd module may be used with the Test module to report test results for use with the Test::Harness module. Alternatively, the Test::Cmd module provides pass(), fail(), and no_result() methods that report test results for use with the Aegis change management system. It is not a good idea to intermix these two reporting models. INSTALLATION Installation is via the usual incantation: # perl Makefile.PL # make # make test # make install Let me know if you have any problems. RESOURCES A rudimentary page for the Test::Cmd module is available at: http://www.baldmt.com/Test-Cmd/ The most involved example of using the Test::Cmd package to test a real-world application is the "cons-test" testing suite for the Cons software construction utility. The suite sub-classes Test::Cmd to provide common, application-specific infrastructure across a large number of end-to-end application tests. The suite, and other information about Cons, is available at: http://www.dsmit.com/cons TO DO The t/run.t test jumps through some complicated (but reasonably documented) hoops to generate an executable Perl script on Windows NT systems. I have no doubt that someone with a better knowledge of NT than mine could do this more simply, and would love to hear of a better solution than what I came up with. Adding a timeout() method would provide better test automation for applications that run the risk of hanging. A feature to time tests would be good. COPYRIGHT Copyright 1999-2001 Steven Knight. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. ACKNOWLEDGEMENTS Thanks to Greg Spencer for the inspiration to create this package and the initial draft of its implementation as a specific testing package for the Cons software construction utility. Information about Cons is available at: http://www.dsmit.com/cons/ The general idea of managing temporary working directories in this way, as well as the test reporting of the pass(), fail() and no_result() methods, come from the testing framework invented by Peter Miller for his Aegis project change supervisor. Aegis is an excellent bit of work which integrates creation and execution of regression tests into the software development process. Information about Aegis is available at: http://www.tip.net.au/~millerp/aegis.html AUTHOR Steven Knight, knight@baldmt.com libtest-cmd-perl-1.05.orig/Makefile.PL0100444000175000017500000000231107415353162016521 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. sub MY::postamble { ' # A couple of development targets to generate a text version of # the POD documentation, for easier inclusion on the web page. .podhtml: $(DISTVNAME).html $(DISTNAME)-Common-$(VERSION).html @rm -f $@ && touch $@ .podtxt: $(DISTVNAME).txt $(DISTNAME)-Common-$(VERSION).txt @rm -f $@ && touch $@ $(DISTVNAME).html: Cmd.pm @rm -f $@ pod2html Cmd.pm > $@ $(DISTVNAME).txt: Cmd.pm @rm -f $@ pod2text Cmd.pm > $@ $(DISTNAME)-Common-$(VERSION).html: Common.pm @rm -f $@ pod2html Common.pm > $@ $(DISTNAME)-Common-$(VERSION).txt: Common.pm @rm -f $@ pod2text Common.pm > $@ '; } @tests = (glob('t/*.t'), glob('t/Common/*.t')); WriteMakefile( 'NAME' => 'Test::Cmd', 'VERSION_FROM' => 'Cmd.pm', # finds $VERSION 'PM' => { 'Cmd.pm' => '$(INST_LIBDIR)/Cmd.pm', 'Common.pm' => '$(INST_LIBDIR)/Cmd/Common.pm', }, 'test' => { 'TESTS' => "@tests", }, ); libtest-cmd-perl-1.05.orig/Common.pm0100444000175000017500000004041007415353162016337 0ustar shellshell# Copyright 1999-2001 Steven Knight. All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. # # This package tests an executable program or script, # managing one or more temporary working directories, # keeping track of standard and error output, # and cleaning up after everything is done. package Test::Cmd::Common; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $_exe $_o $_so $_a $_is_win32); use Exporter (); $VERSION = '1.05'; @ISA = qw(Test::Cmd Exporter); @EXPORT_OK = qw($_exe $_o $_a $_so $_is_win32); use Config; use Cwd; use File::Copy (); use Test::Cmd; =head1 NAME Test::Cmd::Common - module for common Test::Cmd error handling =head1 SYNOPSIS use Test::Cmd::Common; $test = Test::Cmd::Common->new(string => 'functionality being tested', prog => 'program_under_test', ); $test->run(chdir => 'subdir', fail => '$? != 0', flags => '-x', targets => '.', stdout => <<_EOF_, stderr => <<_EOF_); expected standard output _EOF_ expected error output _EOF_ $test->subdir('subdir', ...); $test->read(\$contents, 'file'); $test->read(\@lines, 'file'); $test->write('file', <<_EOF_); contents of the file _EOF_ $test->file_matches(); $test->must_exist('file', ['subdir', 'file'], ...); $test->must_not_exist('file', ['subdir', 'file'], ...); $test->copy('src_file', 'dst_file'); $test->chmod($mode, 'file', ...); $test->sleep; $test->sleep($seconds); $test->touch('file', ...); $test->unlink('file', ...); =head1 DESCRIPTION The C module provides a simple, high-level interface for writing tests of executable commands and scripts, especially commands and scripts that interact with the file system. All methods throw exceptions and exit on failure. This makes it unnecessary to add explicit checks for return values, making the test scripts themselves simpler to write and easier to read. The C class is a subclass of C. In essence, C is a wrapper that treats common C error conditions as exceptions that terminate the test. You can use C directly, or subclass it for your program and add additional (or override) methods to tailor it to your program's specific needs. Alternatively, C serves as a useful example of how to define your own C subclass. The C module provides the following importable variables: =over 4 =item C<$_exe> The executable file suffix. This value is normally available as C<$Config{_exe}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_o> The object file suffix. This value is normally available from C<$Config{_o}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_a> The library file suffix. This value is normally available from as C<$Config{_a}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_so> The shared library file suffix. This value is normally available as C<$Config{_so}> in Perl version 5.005 and later. The C module figures it out via other means in earlier versions. =item C<$_is_win32> A Boolean value that reflects whether the current platform is a Win32 system. =back =head1 METHODS =over 4 =cut BEGIN { if ($] < 5.003) { eval("require Win32"); $_is_win32 = ! $@; } else { $_is_win32 = $^O eq "MSWin32"; } $_exe = $Config{_exe}; $_exe = $Config{exe_ext} if ! defined $_exe; $_exe = $_is_win32 ? '.exe' : '' if ! defined $_exe; $_o = $Config{_o}; $_o = $Config{obj_ext} if ! defined $_o; $_o = $_is_win32 ? '.obj' : '.o' if ! defined $_o; $_a = $Config{_a}; $_a = $Config{lib_ext} if ! defined $_a; $_a = $_is_win32 ? '.lib' : '.a'; $_so = ".$Config{so}"; $_so = $_is_win32 ? '.dll' : '.so' if ! defined $_so; } =item C Creates a new test environment object. Any arguments are keyword-value pairs that are passed through to the construct method for the base class from which we inherit our methods (that is, the C class). In the normal case, this should be the program to be tested and a description of the functionality being tested: $test = Test::Cmd::Common->new(prog => 'my_program', string => 'cool new feature'); By default, methods that match actual versus expected output (the C, and C methods) use an exact match. Tests that require regular expression matches can specify this on initialization of the test environment: $test = Test::Cmd::Common->new(prog => 'my_program', string => 'cool new feature', match_sub => \&Test::Cmd::diff_regex); or by executing the following after initialization of the test environment: $test->match_sub(\&Test::Cmd::diff_regex); Creates a temporary working directory for the test environment and changes directory to it. Exits NO RESULT if the object can not be created, the temporary working directory can not be created, or the current directory cannot be changed to the temporary working directory. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $test = $class->SUPER::new(@_); $class->SUPER::no_result(! $test, undef, 1); # We're going to chdir to the temporary working directory. # So that things work properly relative to the current directory, # turn any relative path names in @INC to absolute paths. my $cwd = Cwd::cwd(); map { $_ = $test->catdir($cwd, $_) if ! $test->file_name_is_absolute($_) } @INC; my $ret = chdir $test->workdir; $test->no_result(! $ret, undef, 1); if (! grep {$_ eq 'match_sub'} @_) { $test->match_sub(\&Test::Cmd::diff_exact); } bless($test, $class); } sub _fail_match_show { my($self, $stream, $expected, $actual, $level) = @_; my @diffs; $self->fail(! $self->match($actual, $expected, \@diffs) => sub {print STDERR "diff expected vs. actual contents of $stream =====\n", @diffs}, $level + 1); } =item C Runs the program under test, checking that the test succeeded. Arguments are keyword-value pairs that affect the manner in which the program is executed or the results are evaluated. chdir => 'subdir' fail => 'failure condition' # default is '$? != 0' flags => 'Cons flags' stderr => 'expected error output' stdout => 'expected standard output' targets => 'targets to build' The test fails if: -- The specified failure condition is met. The default failure condition is '$? != 0', i.e. the program exits unsuccesfully. A not-uncommon alternative is: $test->run(fail => '$? == 0'); # expect failure when testing how the program handles errors. -- Actual standard output does not match expected standard output (if any). The expected standard output is an array of lines or a scalar which will be split on newlines. -- Actual error output does not match expected error output (if any). The expected error output is an array of lines or a scalar which will be split on newlines. This method will test for NO error output by default if no expected error output is specified (unlike standard output). The error output test may be explicitly suppressed by specifying undef as the "expected" error output: $test->run(stderr => undef); By default, this method performs an exact match of actual vs. expected standard output or error output: $test->run(stdout => <<_EOF_, stderr => _EOF_); An expected STDOUT line, which must be matched exactly. _EOF_ One or more expected STDERR lines, which must be matched exactly. _EOF_ Tests that require regular expression matches should be executed using a test environment that calls the C method as follows: $test->match_sub(\&Test::Cmd::diff_regex); $test->run(stdout => <<_EOF_, stderr => _EOF_); An expected (STDOUT|standard output) line\. _EOF_ One or more expected (STDERR|error output) lines, which may contain (regexes|regular expressions)\. _EOF_ =cut sub run { my $self = shift; my %args = @_; my $cmd = $args{'args'}; if (! $cmd) { $cmd = $args{'targets'}; $cmd = "$args{'flags'} $cmd" if $args{'flags'}; } my $lev = $args{'level'} || 0; $self->SUPER::run(@_, args => $cmd); my $cond = $args{'fail'} || '$? != 0'; $self->fail(eval $cond => sub {print STDERR $self->stdout, $self->stderr}, $lev + 1); if (defined $args{'stdout'}) { my @stdout = $self->stdout; $self->_fail_match_show('STDOUT', $args{'stdout'}, \@stdout, $lev + 1); } $args{'stderr'} = '' if ! grep($_ eq 'stderr', keys %args); if (defined $args{'stderr'}) { my @stderr = $self->stderr; $self->_fail_match_show('STDERR', $args{'stderr'}, \@stderr, $lev + 1); } } =item C Creates one or more subdirectories in the temporary working directory. Exits NO RESULT if the number of subdirectories actually created does not match the number expected. For compatibility with its superclass method, returns the number of subdirectories actually created. =cut sub subdir { my $self = shift; my $expected = @_; my $ret = $self->SUPER::subdir(@_); $self->no_result($expected != $ret, => sub {print STDERR "could not create subdirectories: $!\n"}, 1); return $ret; } =item C Reads the contents of a file, depositing the contents in the destination referred to by the first argument (a scalar or array reference). If the file name is not an absolute path name, it is relative to the temporary working directory. Exits NO RESULT if the file could not be read for any reason. For compatibility with its superclass method, returns TRUE on success. =cut sub read { my $self = shift; my $destref = shift; my $ret = $self->SUPER::read($destref, @_); $self->no_result(! $ret => sub {print STDERR "could not read file contents: $!\n"}, 1); return 1; } =item C Writes a file with the specified contents. If the file name is not an absolute path name, it is relative to the temporary working directory. Exits NO RESULT if there were any errors writing the file. For compatibility with its superclass method, returns TRUE on success. $test->write('file', <<_EOF_); contents of the file _EOF_ =cut sub write { my $self = shift; my $file = shift; # the file to write to my $ret = $self->SUPER::write($file, @_); $self->no_result(! $ret => sub {$file = $self->catfile(@$file) if ref $file; print STDERR "could not write $file: $!\n"}, 1); return 1; } =item C Matches the contents of the specified file (first argument) against the expected contents. The expected contents are an array of lines or a scalar which will be split on newlines. By default, each expected line must match exactly its corresponding line in the file: $test->file_matches('file', <<_EOF_); Line #1. Line #2. _EOF_ Tests that require regular expression matches should be executed using a test environment that calls the C method as follows: $test->match_sub(\&Test::Cmd::diff_regex); $test->file_matches('file', <<_EOF_); The (1st|first) line\. The (2nd|second) line\. _EOF_ =cut sub file_matches { my($self, $file, $regexes) = @_; my @lines; my $ret = $self->SUPER::read(\@lines, $file); $self->no_result(! $ret => sub {print STDERR "could not read contents of $file: $!\n"}, 1); my @diffs; $self->fail(! $self->match(\@lines, $regexes, \@diffs) => sub {$file = $self->catfile(@$file) if ref $file; print STDERR "diff expected vs. actual contents of $file =====\n", @diffs}, 1); } =item C Ensures that the specified files must exist. Files may be specified as an array reference of directory components, in which case the pathname will be constructed by concatenating them. Exits FAILED if any of the files does not exist. =cut sub must_exist { my $self = shift; map(ref $_ ? $self->catfile(@$_) : $_, @_); my @missing = grep(! -e $_, @_); $self->fail(0 + @missing => sub {print STDERR "files are missing: @missing\n"}, 1); } =item C Ensures that the specified files must not exist. Files may be specified as an array reference of directory components, in which case the pathname will be constructed by concatenating them. Exits FAILED if any of the files exists. =cut sub must_not_exist { my $self = shift; map(ref $_ ? $self->catfile(@$_) : $_, @_); my @exist = grep(-e $_, @_); $self->fail(0 + @exist => sub {print STDERR "unexpected files exist: @exist\n"}, 1); } =item C Copies a file from the source (first argument) to the destination (second argument). Exits NO RESULT if the file could not be copied for any reason. =cut sub copy { my($self, $src, $dest) = @_; my $ret = File::Copy::copy($src, $dest); $self->no_result(! $ret => sub {print STDERR "could not copy $src to $dest: $!\n"}, 1); } =item C Changes the permissions of a list of files to the specified mode (first argument). Exits NO RESULT if any file could not be changed for any reason. =cut sub chmod { my $self = shift; my $mode = shift; my $expected = @_; my $ret = CORE::chmod($mode, @_); $self->no_result($expected != $ret, => sub {print STDERR "could not chmod files: $!\n"}, 1); } =item C Sleeps at least the specified number of seconds. If no number is specified, sleeps at least a minimum number of seconds necessary to advance file time stamps on the current system. Sleeping more seconds is all right. Exits NO RESULT if the time slept was less than specified. =cut sub sleep { my($self, $seconds) = @_; # On Windows systems, DOS and FAT file systems have only a # two-second granularity, so we must sleep two seconds to # ensure that file time stamps will be newer. $seconds = $_is_win32 ? 2 : 1 if ! defined $seconds; my $ret = CORE::sleep($seconds); $self->no_result($ret < $seconds, => sub {print STDERR "only slept $ret seconds\n"}, 1); } =item C Updates the access and modification times of the specified files. Exits NO RESULT if any file could not be modified for any reason. =cut sub touch { my $self = shift; my $time = shift; my $expected = @_; my $ret = CORE::utime($time, $time, @_); $self->no_result($expected != $ret, => sub {print STDERR "could not touch files: $!\n"}, 1); } =item C Removes the specified files. Exits NO RESULT if any file could not be removed for any reason. =cut sub unlink { my $self = shift; my @not_removed; my $file; foreach $file (@_) { $file = $self->catfile(@$file) if ref $file; if (! CORE::unlink($file)) { push @not_removed, $file; } } $self->no_result(@not_removed != 0, => sub {print STDERR "could not unlink files (@not_removed): $!\n"}, 1); } 1; __END__ =back =head1 ENVIRONMENT The C module also uses the C, C, C, and C environment variables from the C module. See the C documentation for details. =head1 SEE ALSO perl(1), Test::Cmd(3). The most involved example of using the C module to test a real-world application is the C testing suite for the Cons software construction utility. The suite sub-classes C to provide common, application-specific infrastructure across a large number of end-to-end application tests. The suite, and other information about Cons, is available at: http://www.dsmit.com/cons =head1 AUTHOR Steven Knight, knight@baldmt.com =head1 ACKNOWLEDGEMENTS Thanks to Johan Holmberg for asking the question that led to the creation of this package. The general idea of testing commands in this way, as well as the test reporting of the C, C and C methods, come from the testing framework invented by Peter Miller for his Aegis project change supervisor. Aegis is an excellent bit of work which integrates creation and execution of regression tests into the software development process. Information about Aegis is available at: http://www.tip.net.au/~millerp/aegis.html =cut