[svn] Backing out incomplete changes for bug 20323, until the full fix is

[wget] / tests / Test.pm

diff --git a/tests/Test.pm b/tests/Test.pm
old mode 100755 (executable)
new mode 100644 (file)
index 930c54e..c5449d5
--- a/tests/Test.pm
+++ b/tests/Test.pm
@@ -13,23 +13,24 @@ my @unexpected_downloads = ();
 {
     my %_attr_data = ( # DEFAULT
         _cmdline      => "",
-        _cwd          => Cwd::getcwd(),
+        _workdir      => Cwd::getcwd(),
         _errcode      => 0,
+        _existing     => {},
         _input        => {},
         _name         => "",
         _output       => {},
     );
     
-       sub _default_for
-       {
-               my ($self, $attr) = @_;
-               $_attr_data{$attr};
-       }
-
-       sub _standard_keys 
-       {
-               keys %_attr_data;
-       }
+    sub _default_for
+    {
+        my ($self, $attr) = @_;
+        $_attr_data{$attr};
+    }
+
+    sub _standard_keys 
+    {
+        keys %_attr_data;
+    }
 }
 
 
@@ -38,7 +39,7 @@ sub new {
     my $caller_is_obj = ref($caller);
     my $class = $caller_is_obj || $caller;
     #print STDERR "class = ", $class, "\n";
-    #print STDERR "_attr_data {cwd} = ", $Test::_attr_data{_cwd}, "\n";
+    #print STDERR "_attr_data {workdir} = ", $Test::_attr_data{_workdir}, "\n";
     my $self = bless {}, $class;
     foreach my $attrname ($self->_standard_keys()) {
         #print STDERR "attrname = ", $attrname, " value = ";
@@ -55,7 +56,7 @@ sub new {
         }
         #print STDERR $attrname, '=', $self->{$attrname}, "\n";
     }
-    #printf STDERR "_cwd default = ", $self->_default_for("_cwd");
+    #printf STDERR "_workdir default = ", $self->_default_for("_workdir");
     return $self;
 }
 
@@ -68,23 +69,24 @@ sub run {
     
     # Setup 
     $self->_setup();
-    chdir ("$self->{_cwd}/$self->{_name}/input");
+    chdir ("$self->{_workdir}/$self->{_name}/input");
     
     # Launch server
-    my $pid = fork();
-    if($pid == 0) {
-        $self->_launch_server();
-    }
-    # print STDERR "Spawned server with pid: $pid\n"; 
+    my $pid = $self->_fork_and_launch_server();
     
     # Call wget
-    chdir ("$self->{_cwd}/$self->{_name}/output");
+    chdir ("$self->{_workdir}/$self->{_name}/output");
     # print "Calling $self->{_cmdline}\n";
-    my $errcode = system ("$self->{_cwd}/../src/$self->{_cmdline}");
+    my $errcode = 
+        ($self->{_cmdline} =~ m{^/.*}) 
+            ? system ($self->{_cmdline})
+            : system ("$self->{_workdir}/../src/$self->{_cmdline}");
 
     # 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);
-    # print "Killed server\n";
 
     # Verify download
     unless ($errcode == $self->{_errcode}) {
@@ -105,25 +107,37 @@ sub _setup {
     my $self = shift;
 
     #print $self->{_name}, "\n";
-    chdir ($self->{_cwd});
+    chdir ($self->{_workdir});
 
     # Create temporary directory
     mkdir ($self->{_name});
     chdir ($self->{_name});
     mkdir ("input");
     mkdir ("output");
-    chdir ("input");
-
+    
+    # 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";
+        
+        print FILE $self->{_existing}->{$filename}->{content}
+            or return "Test failed: cannot write pre-existing file $filename\n";
+        
+        close (FILE);
+    } 
+    
+    chdir ("../input");
     $self->_setup_server();
 
-    chdir ($self->{_cwd});
+    chdir ($self->{_workdir});
 }
 
 
 sub _cleanup {
     my $self = shift;
 
-    chdir ($self->{_cwd});
+    chdir ($self->{_workdir});
     File::Path::rmtree ($self->{_name});
 }
 
@@ -131,7 +145,7 @@ sub _cleanup {
 sub _verify_download {
     my $self = shift;
 
-    chdir ("$self->{_cwd}/$self->{_name}/output");
+    chdir ("$self->{_workdir}/$self->{_name}/output");
     
     # use slurp mode to read file content
     my $old_input_record_separator = $/;
@@ -159,7 +173,7 @@ sub _verify_download {
     $/ = $old_input_record_separator;    
 
     # make sure no unexpected files were downloaded
-    chdir ("$self->{_cwd}/$self->{_name}/output");
+    chdir ("$self->{_workdir}/$self->{_name}/output");
 
     __dir_walk('.', sub { push @unexpected_downloads, $_[0] unless (exists $self->{_output}{$_[0]}) }, sub { shift; return @_ } );
     if (@unexpected_downloads) { 
@@ -195,6 +209,31 @@ sub __dir_walk {
     }
 }
 
+
+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 = <FROM_CHILD>);
+        close FROM_CHILD;
+    }
+
+    return $pid;
+}
+
 1;
 
 # vim: et ts=4 sw=4