From d29d2ed2d9226a3a66b2c52f7c426116ce5fa990 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tim Rühsen?= Date: Wed, 24 Sep 2014 16:40:03 +0200 Subject: [PATCH] Switched to parallel test harness --- .gitignore | 3 +- ChangeLog | 7 +- configure.ac | 2 +- tests/ChangeLog | 8 + tests/FTPTest.pm | 2 +- tests/HTTPTest.pm | 2 +- tests/Makefile.am | 32 ++-- tests/Test-proxied-https-auth.px | 18 ++- tests/WgetFeature.pm | 2 +- tests/WgetTest.pm.in | 323 --------------------------------------- tests/WgetTests.pm | 323 +++++++++++++++++++++++++++++++++++++++ tests/run-px | 174 --------------------- 12 files changed, 370 insertions(+), 526 deletions(-) delete mode 100644 tests/WgetTest.pm.in create mode 100644 tests/WgetTests.pm delete mode 100755 tests/run-px diff --git a/.gitignore b/.gitignore index 2b3c596..b4e2b94 100644 --- a/.gitignore +++ b/.gitignore @@ -19,6 +19,8 @@ po/*.gmo* po/*.po* src/*.o +tests/*.log +tests/*.trs testenv/*.log testenv/*.trs # build-aux/ @@ -81,7 +83,6 @@ testenv/Makefile.in # tests/ tests/Makefile tests/Makefile.in -tests/WgetTest.pm tests/unit-tests # util/ util/Makefile diff --git a/ChangeLog b/ChangeLog index c4e7809..ecfd8c6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,11 @@ +2014-09-25 Tim Ruehsen + + * configure.ac: removed WgetTest.pm.in + * .gitignore: removed WgetTest.pm + 2014-09-12 Darshit Shah - * bootstrap.conf: Add GNULib module mbiter + * bootstrap.conf: Add GNULib module mbiter 2014-07-25 Darshit Shah diff --git a/configure.ac b/configure.ac index 273fc64..3cbe618 100644 --- a/configure.ac +++ b/configure.ac @@ -578,7 +578,7 @@ dnl dnl Create output dnl AC_CONFIG_FILES([Makefile src/Makefile doc/Makefile util/Makefile - po/Makefile.in tests/Makefile tests/WgetTest.pm + po/Makefile.in tests/Makefile lib/Makefile testenv/Makefile]) AC_CONFIG_HEADERS([src/config.h]) AC_OUTPUT diff --git a/tests/ChangeLog b/tests/ChangeLog index d957b57..8b3b2e5 100644 --- a/tests/ChangeLog +++ b/tests/ChangeLog @@ -1,3 +1,11 @@ +2014-09-25 Tim Ruehsen + + * Makefile.am: Modified to use parallel test harness + * Test-proxied-https-auth.px: get $top_srcdir from ENV + * run-px: removed + * WgetTest.pm.in: removed + * WgetTest.pm: get $top_srcdir from ENV + 2014-06-11 Giuseppe Scrivano * Makefile.am: Remove @VAR@ with $FOO. diff --git a/tests/FTPTest.pm b/tests/FTPTest.pm index f1412fa..98fc061 100644 --- a/tests/FTPTest.pm +++ b/tests/FTPTest.pm @@ -4,7 +4,7 @@ use strict; use warnings; use FTPServer; -use WgetTest; +use WgetTests; our @ISA = qw(WgetTest); my $VERSION = 0.01; diff --git a/tests/HTTPTest.pm b/tests/HTTPTest.pm index 04213b2..e0e436f 100644 --- a/tests/HTTPTest.pm +++ b/tests/HTTPTest.pm @@ -4,7 +4,7 @@ use strict; use warnings; use HTTPServer; -use WgetTest; +use WgetTests; our @ISA = qw(WgetTest); my $VERSION = 0.01; diff --git a/tests/Makefile.am b/tests/Makefile.am index 4bd3ebf..76f6f44 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -27,20 +27,12 @@ # shall include the source code for the parts of OpenSSL used as well # as that of the covered work. +# see http://www.gnu.org/software/automake/manual/html_node/Parallel-Test-Harness.html#Parallel-Test-Harness + # # Version: $(VERSION) # -PERL = perl -PERLRUN = $(PERL) -I$(srcdir) - -LIBS += $(LIBICONV) $(LIBINTL) $(LIB_CLOCK_GETTIME) - -.PHONY: test run-unit-tests run-px-tests - -check-local: test - -test: ../src/wget$(EXEEXT) run-unit-tests run-px-tests ../src/wget$(EXEEXT): cd ../src && $(MAKE) $(AM_MAKEFLAGS) @@ -53,14 +45,7 @@ test: ../src/wget$(EXEEXT) run-unit-tests run-px-tests ../lib/libgnu.a: cd ../lib && $(MAKE) $(AM_MAKEFLAGS) -run-unit-tests: unit-tests$(EXEEXT) ../src/libunittest.a - ./unit-tests$(EXEEXT) - -run-px-tests: WgetTest.pm ../src/wget$(EXEEXT) - $(srcdir)/run-px $(top_srcdir) - -EXTRA_DIST = FTPServer.pm FTPTest.pm HTTPServer.pm HTTPTest.pm \ - WgetFeature.pm WgetFeature.cfg \ +PX_TESTS = \ Test-auth-basic.px \ Test-auth-no-challenge.px \ Test-auth-no-challenge-url.px \ @@ -142,7 +127,10 @@ EXTRA_DIST = FTPServer.pm FTPTest.pm HTTPServer.pm HTTPTest.pm \ Test--start-pos.px \ Test--start-pos--continue.px \ Test--httpsonly-r.px \ - Test-204.px \ + Test-204.px + +EXTRA_DIST = FTPServer.pm FTPTest.pm HTTPServer.pm HTTPTest.pm \ + WgetTests.pm WgetFeature.pm WgetFeature.cfg $(PX_TESTS) \ run-px certs check_PROGRAMS = unit-tests @@ -150,3 +138,9 @@ unit_tests_SOURCES LDADD = ../src/libunittest.a ../lib/libgnu.a $(LIBS) CLEANFILES = *~ *.bak core core.[0-9]* + +TESTS = ./unit-tests$(EXEEXT) $(PX_TESTS) +TEST_EXTENSIONS = .px +AM_TESTS_ENVIRONMENT = export WGETRC=/dev/null; export SYSTEM_WGETRC=/dev/null; +PX_LOG_COMPILER = $(PERL) +AM_PX_LOG_FLAGS = -I$(srcdir) diff --git a/tests/Test-proxied-https-auth.px b/tests/Test-proxied-https-auth.px index 1de5357..28f147a 100755 --- a/tests/Test-proxied-https-auth.px +++ b/tests/Test-proxied-https-auth.px @@ -4,16 +4,26 @@ use strict; use warnings; use WgetFeature qw(https); -use WgetTest; # For $WGETPATH. +use WgetTests; # For $WGETPATH. my $cert_path; my $key_path; +my $srcdir; if (@ARGV) { - my $top_srcdir = shift @ARGV; - $key_path = "$top_srcdir/tests/certs/server-key.pem"; - $cert_path = "$top_srcdir/tests/certs/server-cert.pem"; + $srcdir = shift @ARGV; +} elsif (defined $ENV{srcdir}) { + $srcdir = $ENV{srcdir}; } +print "srcdir=",$ENV{srcdir},"\n"; +if (defined $srcdir) { + $key_path = "$srcdir/certs/server-key.pem"; + $cert_path = "$srcdir/certs/server-cert.pem"; +} else { + $key_path = "certs/server-key.pem"; + $cert_path = "certs/server-cert.pem"; +} + use HTTP::Daemon; use HTTP::Request; diff --git a/tests/WgetFeature.pm b/tests/WgetFeature.pm index f58b998..0762314 100644 --- a/tests/WgetFeature.pm +++ b/tests/WgetFeature.pm @@ -3,7 +3,7 @@ package WgetFeature; use strict; use warnings; -use WgetTest; +use WgetTests; our %skip_messages; require 'WgetFeature.cfg'; diff --git a/tests/WgetTest.pm.in b/tests/WgetTest.pm.in deleted file mode 100644 index 4151445..0000000 --- a/tests/WgetTest.pm.in +++ /dev/null @@ -1,323 +0,0 @@ -# WARNING! -# WgetTest.pm is a generated file! Do not edit! Edit WgetTest.pm.in -# instead. - -package WgetTest; -$VERSION = 0.01; - -use strict; -use warnings; - -use Cwd; -use File::Path; - -our $WGETPATH = "@abs_top_builddir@/src/wget"; - -my @unexpected_downloads = (); - -{ - my %_attr_data = ( # DEFAULT - _cmdline => "", - _workdir => Cwd::getcwd(), - _errcode => 0, - _existing => {}, - _input => {}, - _name => "", - _output => {}, - _server_behavior => {}, - ); - - sub _default_for - { - my ($self, $attr) = @_; - $_attr_data{$attr}; - } - - sub _standard_keys - { - keys %_attr_data; - } -} - - -sub new { - my ($caller, %args) = @_; - my $caller_is_obj = ref($caller); - my $class = $caller_is_obj || $caller; - #print STDERR "class = ", $class, "\n"; - #print STDERR "_attr_data {workdir} = ", $WgetTest::_attr_data{_workdir}, "\n"; - my $self = bless {}, $class; - foreach my $attrname ($self->_standard_keys()) { - #print STDERR "attrname = ", $attrname, " value = "; - my ($argname) = ($attrname =~ /^_(.*)/); - if (exists $args{$argname}) { - #printf STDERR "Setting up $attrname\n"; - $self->{$attrname} = $args{$argname}; - } elsif ($caller_is_obj) { - #printf STDERR "Copying $attrname\n"; - $self->{$attrname} = $caller->{$attrname}; - } else { - #printf STDERR "Using default for $attrname\n"; - $self->{$attrname} = $self->_default_for($attrname); - } - #print STDERR $attrname, '=', $self->{$attrname}, "\n"; - } - #printf STDERR "_workdir default = ", $self->_default_for("_workdir"); - return $self; -} - - -sub run { - my $self = shift; - my $result_message = "Test successful.\n"; - my $errcode; - - printf "Running test $self->{_name}\n"; - - # Setup - my $new_result = $self->_setup(); - chdir ("$self->{_workdir}/$self->{_name}/input"); - if (defined $new_result) { - $result_message = $new_result; - $errcode = 1; - goto cleanup; - } - - # Launch server - my $pid = $self->_fork_and_launch_server(); - - # Call wget - chdir ("$self->{_workdir}/$self->{_name}/output"); - my $cmdline = $self->{_cmdline}; - $cmdline = $self->_substitute_port($cmdline); - print "Calling $cmdline\n"; - $errcode - ($cmdline =~ m{^/.*}) - ? system ($cmdline) - : system ("$self->{_workdir}/../src/$cmdline"); - $errcode >>= 8; # XXX: should handle abnormal error codes. - - # Shutdown server - # if we didn't explicitely kill the server, we would have to call - # waitpid ($pid, 0) here in order to wait for the child process to - # terminate - kill ('TERM', $pid); - - # Verify download - unless ($errcode == $self->{_errcode}) { - $result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n"; - goto cleanup; - } - my $error_str; - if ($error_str = $self->_verify_download()) { - $result_message = $error_str; - } - - cleanup: - $self->_cleanup(); - - print $result_message; - return $errcode != $self->{_errcode} || ($error_str ? 1 : 0); -} - - -sub _setup { - my $self = shift; - - #print $self->{_name}, "\n"; - chdir ($self->{_workdir}); - - # Create temporary directory - mkdir ($self->{_name}); - chdir ($self->{_name}); - mkdir ("input"); - mkdir ("output"); - - # Setup existing files - chdir ("output"); - foreach my $filename (keys %{$self->{_existing}}) { - open (FILE, ">$filename") - or return "Test failed: cannot open pre-existing file $filename\n"; - - my $file = $self->{_existing}->{$filename}; - print FILE $file->{content} - or return "Test failed: cannot write pre-existing file $filename\n"; - - close (FILE); - - if (exists($file->{timestamp})) { - utime $file->{timestamp}, $file->{timestamp}, $filename - or return "Test failed: cannot set timestamp on pre-existing file $filename\n"; - } - } - - chdir ("../input"); - $self->_setup_server(); - - chdir ($self->{_workdir}); - return; -} - - -sub _cleanup { - my $self = shift; - - chdir ($self->{_workdir}); - File::Path::rmtree ($self->{_name}) unless $ENV{WGET_TEST_NO_CLEANUP}; -} - -# not a method -sub quotechar { - my $c = ord( shift ); - if ($c >= 0x7 && $c <= 0xD) { - return '\\' . qw(a b t n v f r)[$c - 0x7]; - } else { - return sprintf('\\x%02x', $c); - } -} - -# not a method -sub _show_diff { - my $SNIPPET_SIZE = 10; - - my ($expected, $actual) = @_; - - my $str = ''; - my $explen = length $expected; - my $actlen = length $actual; - - if ($explen != $actlen) { - $str .= "Sizes don't match: expected = $explen, actual = $actlen\n"; - } - - my $min = $explen <= $actlen? $explen : $actlen; - my $line = 1; - my $col = 1; - my $i; - for ($i=0; $i != $min; ++$i) { - last if substr($expected, $i, 1) ne substr($actual, $i, 1); - if (substr($expected, $i, 1) eq '\n') { - $line++; - $col = 0; - } else { - $col++; - } - } - my $snip_start = $i - ($SNIPPET_SIZE / 2); - if ($snip_start < 0) { - $SNIPPET_SIZE += $snip_start; # Take it from the end. - $snip_start = 0; - } - my $exp_snip = substr($expected, $snip_start, $SNIPPET_SIZE); - my $act_snip = substr($actual, $snip_start, $SNIPPET_SIZE); - $exp_snip =~s/[^[:print:]]/ quotechar($&) /ge; - $act_snip =~s/[^[:print:]]/ quotechar($&) /ge; - $str .= "Mismatch at line $line, col $col:\n"; - $str .= " $exp_snip\n"; - $str .= " $act_snip\n"; - - return $str; -} - -sub _verify_download { - my $self = shift; - - chdir ("$self->{_workdir}/$self->{_name}/output"); - - # use slurp mode to read file content - my $old_input_record_separator = $/; - undef $/; - - while (my ($filename, $filedata) = each %{$self->{_output}}) { - open (FILE, $filename) - or return "Test failed: file $filename not downloaded\n"; - - my $content = ; - my $expected_content = $filedata->{'content'}; - $expected_content = $self->_substitute_port($expected_content); - unless ($content eq $expected_content) { - return "Test failed: wrong content for file $filename\n" - . _show_diff($expected_content, $content); - } - - if (exists($filedata->{'timestamp'})) { - my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, - $atime, $mtime, $ctime, $blksize, $blocks) = stat FILE; - - $mtime == $filedata->{'timestamp'} - or return "Test failed: wrong timestamp for file $filename\n"; - } - - close (FILE); - } - - $/ = $old_input_record_separator; - - # make sure no unexpected files were downloaded - chdir ("$self->{_workdir}/$self->{_name}/output"); - - __dir_walk('.', - sub { push @unexpected_downloads, - $_[0] unless (exists $self->{_output}{$_[0]} || $self->{_existing}{$_[0]}) }, - sub { shift; return @_ } ); - if (@unexpected_downloads) { - return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n"; - } - - return ""; -} - - -sub __dir_walk { - my ($top, $filefunc, $dirfunc) = @_; - - my $DIR; - - if (-d $top) { - my $file; - unless (opendir $DIR, $top) { - warn "Couldn't open directory $DIR: $!; skipping.\n"; - return; - } - - my @results; - while ($file = readdir $DIR) { - next if $file eq '.' || $file eq '..'; - my $nextdir = $top eq '.' ? $file : "$top/$file"; - push @results, __dir_walk($nextdir, $filefunc, $dirfunc); - } - - return $dirfunc ? $dirfunc->($top, @results) : () ; - } else { - return $filefunc ? $filefunc->($top) : () ; - } -} - - -sub _fork_and_launch_server -{ - my $self = shift; - - pipe(FROM_CHILD, TO_PARENT) or die "Cannot create pipe!"; - select((select(TO_PARENT), $| = 1)[0]); - - my $pid = fork(); - if ($pid < 0) { - die "Cannot fork"; - } elsif ($pid == 0) { - # child - close FROM_CHILD; - $self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT }); - } else { - # father - close TO_PARENT; - chomp(my $line = ); - close FROM_CHILD; - } - - return $pid; -} - -1; - -# vim: et ts=4 sw=4 diff --git a/tests/WgetTests.pm b/tests/WgetTests.pm new file mode 100644 index 0000000..02413ec --- /dev/null +++ b/tests/WgetTests.pm @@ -0,0 +1,323 @@ +package WgetTest; +$VERSION = 0.01; + +use strict; +use warnings; + +use Cwd; +use File::Path; +use POSIX qw(locale_h); +use locale; + +our $WGETPATH = "../src/wget"; + +my @unexpected_downloads = (); + +{ + my %_attr_data = ( # DEFAULT + _cmdline => "", + _workdir => Cwd::getcwd(), + _errcode => 0, + _existing => {}, + _input => {}, + _name => "", + _output => {}, + _server_behavior => {}, + ); + + sub _default_for + { + my ($self, $attr) = @_; + $_attr_data{$attr}; + } + + sub _standard_keys + { + keys %_attr_data; + } +} + + +sub new { + my ($caller, %args) = @_; + my $caller_is_obj = ref($caller); + my $class = $caller_is_obj || $caller; + #print STDERR "class = ", $class, "\n"; + #print STDERR "_attr_data {workdir} = ", $WgetTest::_attr_data{_workdir}, "\n"; + my $self = bless {}, $class; + foreach my $attrname ($self->_standard_keys()) { + #print STDERR "attrname = ", $attrname, " value = "; + my ($argname) = ($attrname =~ /^_(.*)/); + if (exists $args{$argname}) { + #printf STDERR "Setting up $attrname\n"; + $self->{$attrname} = $args{$argname}; + } elsif ($caller_is_obj) { + #printf STDERR "Copying $attrname\n"; + $self->{$attrname} = $caller->{$attrname}; + } else { + #printf STDERR "Using default for $attrname\n"; + $self->{$attrname} = $self->_default_for($attrname); + } + #print STDERR $attrname, '=', $self->{$attrname}, "\n"; + } + #printf STDERR "_workdir default = ", $self->_default_for("_workdir"); + return $self; +} + + +sub run { + my $self = shift; + my $result_message = "Test successful.\n"; + my $errcode; + + printf "Running test $self->{_name}\n"; + + # Setup + my $new_result = $self->_setup(); + chdir ("$self->{_workdir}/$self->{_name}/input"); + if (defined $new_result) { + $result_message = $new_result; + $errcode = 1; + goto cleanup; + } + + # Launch server + my $pid = $self->_fork_and_launch_server(); + + # Call wget + chdir ("$self->{_workdir}/$self->{_name}/output"); + my $cmdline = $self->{_cmdline}; + $cmdline = $self->_substitute_port($cmdline); + print "Calling $cmdline\n"; + $errcode + ($cmdline =~ m{^/.*}) + ? system ($cmdline) + : system ("$self->{_workdir}/$cmdline"); + $errcode >>= 8; # XXX: should handle abnormal error codes. + + # Shutdown server + # if we didn't explicitely kill the server, we would have to call + # waitpid ($pid, 0) here in order to wait for the child process to + # terminate + kill ('TERM', $pid); + + # Verify download + unless ($errcode == $self->{_errcode}) { + $result_message = "Test failed: wrong code returned (was: $errcode, expected: $self->{_errcode})\n"; + goto cleanup; + } + my $error_str; + if ($error_str = $self->_verify_download()) { + $result_message = $error_str; + } + + cleanup: + $self->_cleanup(); + + print $result_message; + return $errcode != $self->{_errcode} || ($error_str ? 1 : 0); +} + + +sub _setup { + my $self = shift; + + #print $self->{_name}, "\n"; + chdir ($self->{_workdir}); + + # Create temporary directory + mkdir ($self->{_name}); + chdir ($self->{_name}); + mkdir ("input"); + mkdir ("output"); + + # Setup existing files + chdir ("output"); + foreach my $filename (keys %{$self->{_existing}}) { + open (FILE, ">$filename") + or return "Test failed: cannot open pre-existing file $filename\n"; + + my $file = $self->{_existing}->{$filename}; + print FILE $file->{content} + or return "Test failed: cannot write pre-existing file $filename\n"; + + close (FILE); + + if (exists($file->{timestamp})) { + utime $file->{timestamp}, $file->{timestamp}, $filename + or return "Test failed: cannot set timestamp on pre-existing file $filename\n"; + } + } + + chdir ("../input"); + $self->_setup_server(); + + chdir ($self->{_workdir}); + return; +} + + +sub _cleanup { + my $self = shift; + + chdir ($self->{_workdir}); + File::Path::rmtree ($self->{_name}) unless $ENV{WGET_TEST_NO_CLEANUP}; +} + +# not a method +sub quotechar { + my $c = ord( shift ); + if ($c >= 0x7 && $c <= 0xD) { + return '\\' . qw(a b t n v f r)[$c - 0x7]; + } else { + return sprintf('\\x%02x', $c); + } +} + +# not a method +sub _show_diff { + my $SNIPPET_SIZE = 10; + + my ($expected, $actual) = @_; + + my $str = ''; + my $explen = length $expected; + my $actlen = length $actual; + + if ($explen != $actlen) { + $str .= "Sizes don't match: expected = $explen, actual = $actlen\n"; + } + + my $min = $explen <= $actlen? $explen : $actlen; + my $line = 1; + my $col = 1; + my $i; + for ($i=0; $i != $min; ++$i) { + last if substr($expected, $i, 1) ne substr($actual, $i, 1); + if (substr($expected, $i, 1) eq '\n') { + $line++; + $col = 0; + } else { + $col++; + } + } + my $snip_start = $i - ($SNIPPET_SIZE / 2); + if ($snip_start < 0) { + $SNIPPET_SIZE += $snip_start; # Take it from the end. + $snip_start = 0; + } + my $exp_snip = substr($expected, $snip_start, $SNIPPET_SIZE); + my $act_snip = substr($actual, $snip_start, $SNIPPET_SIZE); + $exp_snip =~s/[^[:print:]]/ quotechar($&) /ge; + $act_snip =~s/[^[:print:]]/ quotechar($&) /ge; + $str .= "Mismatch at line $line, col $col:\n"; + $str .= " $exp_snip\n"; + $str .= " $act_snip\n"; + + return $str; +} + +sub _verify_download { + my $self = shift; + + chdir ("$self->{_workdir}/$self->{_name}/output"); + + # use slurp mode to read file content + my $old_input_record_separator = $/; + undef $/; + + while (my ($filename, $filedata) = each %{$self->{_output}}) { + open (FILE, $filename) + or return "Test failed: file $filename not downloaded\n"; + + my $content = ; + my $expected_content = $filedata->{'content'}; + $expected_content = $self->_substitute_port($expected_content); + unless ($content eq $expected_content) { + return "Test failed: wrong content for file $filename\n" + . _show_diff($expected_content, $content); + } + + if (exists($filedata->{'timestamp'})) { + my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, + $atime, $mtime, $ctime, $blksize, $blocks) = stat FILE; + + $mtime == $filedata->{'timestamp'} + or return "Test failed: wrong timestamp for file $filename\n"; + } + + close (FILE); + } + + $/ = $old_input_record_separator; + + # make sure no unexpected files were downloaded + chdir ("$self->{_workdir}/$self->{_name}/output"); + + __dir_walk('.', + sub { push @unexpected_downloads, + $_[0] unless (exists $self->{_output}{$_[0]} || $self->{_existing}{$_[0]}) }, + sub { shift; return @_ } ); + if (@unexpected_downloads) { + return "Test failed: unexpected downloaded files [" . join(', ', @unexpected_downloads) . "]\n"; + } + + return ""; +} + + +sub __dir_walk { + my ($top, $filefunc, $dirfunc) = @_; + + my $DIR; + + if (-d $top) { + my $file; + unless (opendir $DIR, $top) { + warn "Couldn't open directory $DIR: $!; skipping.\n"; + return; + } + + my @results; + while ($file = readdir $DIR) { + next if $file eq '.' || $file eq '..'; + my $nextdir = $top eq '.' ? $file : "$top/$file"; + push @results, __dir_walk($nextdir, $filefunc, $dirfunc); + } + + return $dirfunc ? $dirfunc->($top, @results) : () ; + } else { + return $filefunc ? $filefunc->($top) : () ; + } +} + + +sub _fork_and_launch_server +{ + my $self = shift; + + pipe(FROM_CHILD, TO_PARENT) or die "Cannot create pipe!"; + select((select(TO_PARENT), $| = 1)[0]); + + my $pid = fork(); + if ($pid < 0) { + die "Cannot fork"; + } elsif ($pid == 0) { + # child + close FROM_CHILD; + # FTP Server has to start with english locale due to use of strftime month names in LIST command + setlocale(LC_ALL,"C"); + $self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT }); + } else { + # father + close TO_PARENT; + chomp(my $line = ); + close FROM_CHILD; + } + + return $pid; +} + +1; + +# vim: et ts=4 sw=4 diff --git a/tests/run-px b/tests/run-px deleted file mode 100755 index 49dcb74..0000000 --- a/tests/run-px +++ /dev/null @@ -1,174 +0,0 @@ -#!/usr/bin/env perl - -use 5.006; -use strict; -use warnings; - -use Term::ANSIColor; - -die "Please specify the top source directory.\n" if (address@hidden); -my $top_srcdir = shift @ARGV; - -my @tests = ( - 'Test-auth-basic.px', - 'Test-auth-no-challenge.px', - 'Test-auth-no-challenge-url.px', - 'Test-auth-with-content-disposition.px', - 'Test-auth-retcode.px', - 'Test-cookies.px', - 'Test-cookies-401.px', - 'Test-proxy-auth-basic.px', - 'Test-proxied-https-auth.px', - 'Test-N-HTTP-Content-Disposition.px', - 'Test--spider.px', - 'Test-c-full.px', - 'Test-c-partial.px', - 'Test-c-shorter.px', - 'Test-c.px', - 'Test-E-k-K.px', - 'Test-E-k.px', - 'Test-ftp.px', - 'Test-ftp-pasv-fail.px', - 'Test-ftp-bad-list.px', - 'Test-ftp-recursive.px', - 'Test-ftp-iri.px', - 'Test-ftp-iri-fallback.px', - 'Test-ftp-iri-recursive.px', - 'Test-ftp-iri-disabled.px', - 'Test-ftp-list-Multinet.px', - 'Test-ftp-list-Unknown.px', - 'Test-ftp-list-Unknown-a.px', - 'Test-ftp-list-Unknown-hidden.px', - 'Test-ftp-list-Unknown-list-a-fails.px', - 'Test-ftp-list-UNIX-hidden.px', - 'Test-HTTP-Content-Disposition-1.px', - 'Test-HTTP-Content-Disposition-2.px', - 'Test-HTTP-Content-Disposition.px', - 'Test-i-ftp.px', - 'Test-i-http.px', - 'Test-idn-headers.px', - 'Test-idn-meta.px', - 'Test-idn-cmd.px', - 'Test-idn-cmd-utf8.px', - 'Test-idn-robots.px', - 'Test-idn-robots-utf8.px', - 'Test-iri.px', - 'Test-iri-percent.px', - 'Test-iri-disabled.px', - 'Test-iri-forced-remote.px', - 'Test-iri-list.px', - 'Test-k.px', - 'Test-meta-robots.px', - 'Test-N-current.px', - 'Test-N-smaller.px', - 'Test-N-no-info.px', - 'Test-N--no-content-disposition.px', - 'Test-N--no-content-disposition-trivial.px', - 'Test--no-content-disposition.px', - 'Test--no-content-disposition-trivial.px', - 'Test-N-old.px', - 'Test-nonexisting-quiet.px', - 'Test-noop.px', - 'Test-np.px', - 'Test-N.px', - 'Test-O-HTTP-Content-Disposition.px', - 'Test-O--no-content-disposition.px', - 'Test-O--no-content-disposition-trivial.px', - 'Test-O-nonexisting.px', - 'Test-O.px', - 'Test--post-file.px', - 'Test-O-nc.px', - 'Test-restrict-ascii.px', - 'Test-Restrict-Lowercase.px', - 'Test-Restrict-Uppercase.px', - 'Test-stdouterr.px', - 'Test--spider-fail.px', - 'Test--spider-r-HTTP-Content-Disposition.px', - 'Test--spider-r--no-content-disposition.px', - 'Test--spider-r--no-content-disposition-trivial.px', - 'Test--spider-r.px', - 'Test--httpsonly-r.px', - 'Test--start-pos.px', - 'Test-ftp--start-pos.px', - 'Test--start-pos--continue.px', - 'Test-204.px', -); - -foreach my $var (qw(SYSTEM_WGETRC WGETRC)) { - $ENV{$var} = '/dev/null'; -} - -my @tested; - -foreach my $test (@tests) { - print "Running $test\n\n"; - system("$^X -I$top_srcdir/tests $top_srcdir/tests/$test $top_srcdir"); - push @tested, { name => $test, result => $? >> 8 }; -} - -foreach my $var (qw(SYSTEM_WGETRC WGETRC)) { - delete $ENV{$var}; -} - -my %exit = ( - pass => 0, - fail => 1, - skip => 2, - unknown => 3, # or greater -); - -my %colors = ( - $exit{pass} => colored('pass:', 'green' ), - $exit{fail} => colored('FAIL:', 'red' ), - $exit{skip} => colored('Skip:', 'yellow' ), - $exit{unknown} => colored('Unknown:', 'magenta'), -); - -print "\n"; -foreach my $test (@tested) { - my $colored = exists $colors{$test->{result}} - ? $colors{$test->{result}} - : $colors{$exit{unknown}}; - print "$colored $test->{name}\n"; -} - -my $count = sub -{ - return { - pass => sub { scalar grep $_->{result} == $exit{pass}, @tested }, - fail => sub { scalar grep $_->{result} == $exit{fail}, @tested }, - skip => sub { scalar grep $_->{result} == $exit{skip}, @tested }, - unknown => sub { scalar grep $_->{result} >= $exit{unknown}, @tested }, - }->{$_[0]}->(); -}; - -my $summary = sub -{ - my @lines = ( - "${\scalar @tested} tests were run", - "${\$count->('pass')} PASS, ${\$count->('fail')} FAIL", - "${\$count->('skip')} SKIP, ${\$count->('unknown')} UNKNOWN", - ); - my $len_longest = sub - { - local $_ = 0; - foreach my $line (@lines) { - if (length $line > $_) { - $_ = length $line; - } - } - return $_; - }->(); - return join "\n", - '=' x $len_longest, - @lines, - '=' x $len_longest; -}->(); - -print "\n"; -print $count->('fail') || $count->('unknown') - ? colored($summary, 'red') - : colored($summary, 'green'); -print "\n"; - -exit $count->('fail') + $count->('unknown'); -- 2.1.1