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