X-Git-Url: http://sjero.net/git/?p=wget;a=blobdiff_plain;f=tests%2FWgetTest.pm.in;h=092777eaf2aca8dbe1f385159dfa40d9d4e879f4;hp=910ac80d8149f534121b9dd1fd69c4d5b2e1b08e;hb=HEAD;hpb=2e2ac6ad2fc90eaf46ae5fee0bc4f61dd97b4284 diff --git a/tests/WgetTest.pm.in b/tests/WgetTest.pm.in index 910ac80d..092777ea 100644 --- a/tests/WgetTest.pm.in +++ b/tests/WgetTest.pm.in @@ -1,5 +1,3 @@ -#!/usr/bin/perl -w - # WARNING! # WgetTest.pm is a generated file! Do not edit! Edit WgetTest.pm.in # instead. @@ -8,6 +6,7 @@ package WgetTest; $VERSION = 0.01; use strict; +use warnings; use Cwd; use File::Path; @@ -25,15 +24,16 @@ my @unexpected_downloads = (); _input => {}, _name => "", _output => {}, + _server_behavior => {}, ); - + sub _default_for { my ($self, $attr) = @_; $_attr_data{$attr}; } - sub _standard_keys + sub _standard_keys { keys %_attr_data; } @@ -70,42 +70,50 @@ sub new { sub run { my $self = shift; my $result_message = "Test successful.\n"; - + my $errcode; + printf "Running test $self->{_name}\n"; - - # Setup - $self->_setup(); + + # 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"; - my $errcode = - ($cmdline =~ m{^/.*}) + $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 + # 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 + cleanup: $self->_cleanup(); print $result_message; @@ -124,11 +132,11 @@ sub _setup { chdir ($self->{_name}); mkdir ("input"); mkdir ("output"); - + # Setup existing files chdir ("output"); foreach my $filename (keys %{$self->{_existing}}) { - open (FILE, ">$filename") + open (FILE, ">$filename") or return "Test failed: cannot open pre-existing file $filename\n"; my $file = $self->{_existing}->{$filename}; @@ -141,12 +149,13 @@ sub _setup { 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; } @@ -154,47 +163,104 @@ sub _cleanup { my $self = shift; chdir ($self->{_workdir}); - File::Path::rmtree ($self->{_name}); + 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) + 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); - $content eq $expected_content - or return "Test failed: wrong content for file $filename\n"; + 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'} + $mtime == $filedata->{'timestamp'} or return "Test failed: wrong timestamp for file $filename\n"; } - + close (FILE); - } - - $/ = $old_input_record_separator; + } + + $/ = $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]}) }, sub { shift; return @_ } ); - if (@unexpected_downloads) { + __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"; } @@ -228,7 +294,7 @@ sub __dir_walk { } -sub _fork_and_launch_server +sub _fork_and_launch_server { my $self = shift; @@ -239,7 +305,7 @@ sub _fork_and_launch_server if ($pid < 0) { die "Cannot fork"; } elsif ($pid == 0) { - # child + # child close FROM_CHILD; $self->_launch_server(sub { print TO_PARENT "SYNC\n"; close TO_PARENT }); } else {