X-Git-Url: http://www.privoxy.org/gitweb/?a=blobdiff_plain;f=tools%2Fprivoxy-regression-test.pl;h=955fc8716f337cffda5a35b5ce857732fb30dcb6;hb=2da7c5e4fb2bd663ff7118bbabd2f0f4b3ea98dc;hp=3b02fdaab1166648bba89d8939fe3ed8a4de2450;hpb=f19f65c9d27ffd81cc344320132a311902a85453;p=privoxy.git

diff --git a/tools/privoxy-regression-test.pl b/tools/privoxy-regression-test.pl
index 3b02fdaa..955fc871 100755
--- a/tools/privoxy-regression-test.pl
+++ b/tools/privoxy-regression-test.pl
@@ -7,7 +7,7 @@
 # A regression test "framework" for Privoxy. For documentation see:
 # perldoc privoxy-regression-test.pl
 #
-# $Id: privoxy-regression-test.pl,v 1.180 2009/06/01 10:48:24 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.185 2009/06/10 16:36:42 fk Exp $
 #
 # Wish list:
 #
@@ -139,7 +139,7 @@ sub parse_tag ($) {
 sub check_for_forbidden_characters ($) {
 
     my $string = shift;
-    my $allowed = '[-=\dA-Za-z~{}:./();\s,+@"_%?&*^]';
+    my $allowed = '[-=\dA-Za-z~{}:./();\t ,+@"_%?&*^]';
 
     unless ($string =~ m/^$allowed*$/o) {
         my $forbidden = $string;
@@ -492,21 +492,7 @@ sub execute_regression_tests () {
                 die "Regression test id mismatch" if ($r != $regression_tests[$s][$r]{'regression-test-id'});
 
                 my $number = $regression_tests[$s][$r]{'number'};
-                my $skip_reason = undef;
-
-                if ($regression_tests[$s][$r]{'ignore'}) {
-
-                    $skip_reason = "Ignore flag is set";
-
-                } elsif (cli_option_is_set('test-number')
-                         and get_cli_option('test-number') != $number) {
-
-                    $skip_reason = "Only executing test " . get_cli_option('test-number');
-
-                } else {
-
-                    $skip_reason = level_is_unacceptable($regression_tests[$s][$r]{'level'});
-                }
+                my $skip_reason = get_skip_reason($regression_tests[$s][$r]);
 
                 if (defined $skip_reason) {
 
@@ -543,6 +529,27 @@ sub execute_regression_tests () {
     }
 }
 
+sub get_skip_reason ($) {
+    my $test = shift;
+    my $skip_reason = undef;
+
+    if ($test->{'ignore'}) {
+
+        $skip_reason = "Ignore flag is set";
+
+    } elsif (cli_option_is_set('test-number') and
+             get_cli_option('test-number') != $test->{'number'}) {
+
+        $skip_reason = "Only executing test " . get_cli_option('test-number');
+
+    } else {
+
+        $skip_reason = level_is_unacceptable($test->{'level'});
+    }
+
+    return $skip_reason;
+}
+
 sub level_is_unacceptable ($) {
     my $level = shift;
     my $min_level = get_cli_option('min-level');
@@ -633,38 +640,37 @@ sub register_dependency ($$) {
 # XXX: somewhat misleading name
 sub execute_regression_test ($) {
 
-    my $test_ref = shift;
-    my %test = %{$test_ref};
+    my $test = shift;
     my $result = 0;
 
-    if ($test{'type'} == CLIENT_HEADER_TEST) {
+    if ($test->{'type'} == CLIENT_HEADER_TEST) {
 
-        $result = execute_client_header_regression_test($test_ref);
+        $result = execute_client_header_regression_test($test);
 
-    } elsif ($test{'type'} == SERVER_HEADER_TEST) {
+    } elsif ($test->{'type'} == SERVER_HEADER_TEST) {
 
-        $result = execute_server_header_regression_test($test_ref);
+        $result = execute_server_header_regression_test($test);
 
-    } elsif ($test{'type'} == DUMB_FETCH_TEST
-          or $test{'type'} == TRUSTED_CGI_REQUEST) {
+    } elsif ($test->{'type'} == DUMB_FETCH_TEST
+          or $test->{'type'} == TRUSTED_CGI_REQUEST) {
 
-        $result = execute_dumb_fetch_test($test_ref);
+        $result = execute_dumb_fetch_test($test);
 
-    } elsif ($test{'type'} == METHOD_TEST) {
+    } elsif ($test->{'type'} == METHOD_TEST) {
 
-        $result = execute_method_test($test_ref);
+        $result = execute_method_test($test);
 
-    } elsif ($test{'type'} == BLOCK_TEST) {
+    } elsif ($test->{'type'} == BLOCK_TEST) {
 
-        $result = execute_block_test($test_ref);
+        $result = execute_block_test($test);
 
-    } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
+    } elsif ($test->{'type'} == STICKY_ACTIONS_TEST) {
 
-        $result = execute_sticky_actions_test($test_ref);
+        $result = execute_sticky_actions_test($test);
 
     } else {
 
-        die "Unsupported test type detected: " . $test{'type'};
+        die "Unsupported test type detected: " . $test->{'type'};
     }
 
     return $result;
@@ -672,14 +678,13 @@ sub execute_regression_test ($) {
 
 sub execute_method_test ($) {
 
-    my $test_ref = shift;
-    my %test = %{$test_ref};
+    my $test = shift;
     my $buffer_ref;
     my $status_code;
-    my $method = $test{'data'};
+    my $method = $test->{'data'};
 
     my $curl_parameters = '';
-    my $expected_status_code = $test{'expected-status-code'};
+    my $expected_status_code = $test->{'expected-status-code'};
 
     $curl_parameters .= '--request ' . $method . ' ';
     # Don't complain about the 'missing' body
@@ -695,22 +700,21 @@ sub execute_method_test ($) {
 
 sub execute_dumb_fetch_test ($) {
 
-    my $test_ref = shift;
-    my %test = %{$test_ref};
+    my $test = shift;
     my $buffer_ref;
     my $status_code;
 
     my $curl_parameters = '';
-    my $expected_status_code = $test{'expected-status-code'};
+    my $expected_status_code = $test->{'expected-status-code'};
 
-    if (defined $test{method}) {
-        $curl_parameters .= '--request ' . $test{method} . ' ';
+    if (defined $test->{method}) {
+        $curl_parameters .= '--request ' . $test->{method} . ' ';
     }
-    if ($test{type} == TRUSTED_CGI_REQUEST) {
+    if ($test->{type} == TRUSTED_CGI_REQUEST) {
         $curl_parameters .= '--referer ' . PRIVOXY_CGI_URL . ' ';
     }
 
-    $curl_parameters .= $test{'data'};
+    $curl_parameters .= $test->{'data'};
 
     $buffer_ref = get_page_with_curl($curl_parameters);
     $status_code = get_status_code($buffer_ref);
@@ -834,28 +838,28 @@ sub check_status_code_result ($$) {
 
 sub execute_client_header_regression_test ($) {
 
-    my $test_ref = shift;
+    my $test = shift;
     my $buffer_ref;
     my $header;
 
-    $buffer_ref = get_show_request_with_curl($test_ref);
+    $buffer_ref = get_show_request_with_curl($test);
 
-    $header = get_header($buffer_ref, $test_ref);
+    $header = get_header($buffer_ref, $test);
 
-    return check_header_result($test_ref, $header);
+    return check_header_result($test, $header);
 }
 
 sub execute_server_header_regression_test ($) {
 
-    my $test_ref = shift;
+    my $test = shift;
     my $buffer_ref;
     my $header;
 
-    $buffer_ref = get_head_with_curl($test_ref);
+    $buffer_ref = get_head_with_curl($test);
 
-    $header = get_server_header($buffer_ref, $test_ref);
+    $header = get_server_header($buffer_ref, $test);
 
-    return check_header_result($test_ref, $header);
+    return check_header_result($test, $header);
 }
 
 sub interpret_result ($) {
@@ -865,16 +869,15 @@ sub interpret_result ($) {
 
 sub check_header_result ($$) {
 
-    my $test_ref = shift;
+    my $test = shift;
     my $header = shift;
 
-    my %test = %{$test_ref};
-    my $expect_header = $test{'expect-header'};
+    my $expect_header = $test->{'expect-header'};
     my $success = 0;
 
     if ($expect_header eq 'NO CHANGE') {
 
-        if (defined($header) and $header eq $test{'data'}) {
+        if (defined($header) and $header eq $test->{'data'}) {
 
             $success = 1;
 
@@ -887,7 +890,7 @@ sub check_header_result ($$) {
 
     } elsif ($expect_header eq 'REMOVAL') {
 
-        if (defined($header) and $header eq $test{'data'}) {
+        if (defined($header) and $header eq $test->{'data'}) {
 
             l(LL_VERBOSE_FAILURE,
               "Ooops. Expected removal but: '" . $header . "' is still there.");
@@ -901,7 +904,7 @@ sub check_header_result ($$) {
 
     } elsif ($expect_header eq 'SOME CHANGE') {
 
-        if (defined($header) and not $header eq $test{'data'}) {
+        if (defined($header) and not $header eq $test->{'data'}) {
 
             $success = 1;
 
@@ -942,12 +945,11 @@ sub get_header ($$) {
     our $filtered_request = '';
 
     my $buffer_ref = shift;
-    my $test_ref = shift;
+    my $test = shift;
 
-    my %test = %{$test_ref};
     my @buffer = @{$buffer_ref};
 
-    my $expect_header = $test{'expect-header'};
+    my $expect_header = $test->{'expect-header'};
 
     die "get_header called with no expect header" unless defined $expect_header;
 
@@ -962,7 +964,7 @@ sub get_header ($$) {
      or $expect_header eq 'NO CHANGE'
      or  $expect_header eq 'SOME CHANGE') {
 
-        $expect_header = $test{'data'};
+        $expect_header = $test->{'data'};
     }
 
     $header_to_get = get_header_name($expect_header);
@@ -1001,24 +1003,23 @@ sub get_header ($$) {
 sub get_server_header ($$) {
 
     my $buffer_ref = shift;
-    my $test_ref = shift;
+    my $test = shift;
 
-    my %test = %{$test_ref};
     my @buffer = @{$buffer_ref};
 
-    my $expect_header = $test{'expect-header'};
+    my $expect_header = $test->{'expect-header'};
     my $header;
     my $header_to_get;
 
     # XXX: Should be caught before starting to test.
-    log_and_die("No expect header for test " . $test{'number'})
+    log_and_die("No expect header for test " . $test->{'number'})
         unless defined $expect_header;
 
     if ($expect_header eq 'REMOVAL'
      or $expect_header eq 'NO CHANGE'
      or $expect_header eq 'SOME CHANGE') {
 
-        $expect_header = $test{'data'};
+        $expect_header = $test->{'data'};
     }
 
     $header_to_get = get_header_name($expect_header);
@@ -1064,22 +1065,21 @@ sub get_test_keys () {
 # XXX: incomplete
 sub test_content_as_string ($) {
 
-    my $test_ref = shift;
-    my %test = %{$test_ref};
+    my $test = shift;
 
     my $s = "\n\t";
 
     foreach my $key (get_test_keys()) {
-        $test{$key} = 'Not set' unless (defined $test{$key});
+        $test->{$key} = 'Not set' unless (defined $test->{$key});
     }
 
-    $s .= 'Tag: ' . $test{'tag'};
+    $s .= 'Tag: ' . $test->{'tag'};
     $s .= "\n\t";
-    $s .= 'Set header: ' . $test{'data'}; # XXX: adjust for other test types
+    $s .= 'Set header: ' . $test->{'data'}; # XXX: adjust for other test types
     $s .= "\n\t";
-    $s .= 'Expected header: ' . $test{'expect-header'};
+    $s .= 'Expected header: ' . $test->{'expect-header'};
     $s .= "\n\t";
-    $s .= 'Ignore: ' . $test{'ignore'};
+    $s .= 'Ignore: ' . $test->{'ignore'};
 
     return $s;
 }
@@ -1104,11 +1104,6 @@ sub fuzz_header($) {
 #
 ############################################################################
 
-sub check_for_curl () {
-    my $curl = CURL;
-    log_and_die("No curl found.") unless (`which $curl`);
-}
-
 sub get_cgi_page_or_else ($) {
 
     my $cgi_url = shift;
@@ -1139,18 +1134,17 @@ sub get_cgi_page_or_else ($) {
 sub get_show_request_with_curl ($) {
 
     our $privoxy_cgi_url;
-    my $test_ref = shift;
-    my %test = %{$test_ref};
+    my $test = shift;
 
     my $curl_parameters = ' ';
-    my $header = $test{'data'};
+    my $header = $test->{'data'};
 
     if (cli_option_is_set('header-fuzzing')) {
         $header = fuzz_header($header);
     }
 
     # Enable the action to test
-    $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
+    $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test->{'tag'} . '\' ';
     # The header to filter
     $curl_parameters .= '-H \'' . $header . '\' ';
 
@@ -1164,15 +1158,14 @@ sub get_show_request_with_curl ($) {
 sub get_head_with_curl ($) {
 
     our $fellatio_url = FELLATIO_URL;
-    my $test_ref = shift;
-    my %test = %{$test_ref};
+    my $test = shift;
 
     my $curl_parameters = ' ';
 
     # Enable the action to test
-    $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
+    $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test->{'tag'} . '\' ';
     # The header to filter
-    $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test{'data'} . '\' ';
+    $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test->{'data'} . '\' ';
     $curl_parameters .= '--head ';
 
     $curl_parameters .= ' ';
@@ -1217,6 +1210,7 @@ sub get_page_with_curl ($) {
         @buffer = `$curl_line`;
 
         if ($?) {
+            log_and_die("Executing '$curl_line' failed.") unless @buffer;
             $failure_reason = array_as_string(\@buffer);
             chomp $failure_reason;
             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
@@ -1250,8 +1244,8 @@ sub array_as_string ($) {
 }
 
 sub show_test ($) {
-    my $test_ref = shift;
-    log_message('Test is:' . test_content_as_string($test_ref));
+    my $test = shift;
+    log_message('Test is:' . test_content_as_string($test));
 }
 
 # Conditional log
@@ -1306,76 +1300,75 @@ sub log_result ($$) {
     our $verbose_test_description;
     our $filtered_request;
 
-    my $test_ref = shift;
+    my $test = shift;
     my $result = shift;
     my $number = shift;
 
-    my %test = %{$test_ref};
     my $message = '';
 
     $message .= interpret_result($result);
     $message .= " for test ";
     $message .= $number;
     $message .= '/';
-    $message .= $test{'number'};
+    $message .= $test->{'number'};
     $message .= '/';
-    $message .= $test{'section-id'};
+    $message .= $test->{'section-id'};
     $message .= '/';
-    $message .= $test{'regression-test-id'};
+    $message .= $test->{'regression-test-id'};
     $message .= '.';
 
     if ($verbose_test_description) {
 
-        if ($test{'type'} == CLIENT_HEADER_TEST) {
+        if ($test->{'type'} == CLIENT_HEADER_TEST) {
 
             $message .= ' Header ';
-            $message .= quote($test{'data'});
+            $message .= quote($test->{'data'});
             $message .= ' and tag ';
-            $message .= quote($test{'tag'});
+            $message .= quote($test->{'tag'});
 
-        } elsif ($test{'type'} == SERVER_HEADER_TEST) {
+        } elsif ($test->{'type'} == SERVER_HEADER_TEST) {
 
             $message .= ' Request Header ';
-            $message .= quote($test{'data'});
+            $message .= quote($test->{'data'});
             $message .= ' and tag ';
-            $message .= quote($test{'tag'});
+            $message .= quote($test->{'tag'});
 
-        } elsif ($test{'type'} == DUMB_FETCH_TEST) {
+        } elsif ($test->{'type'} == DUMB_FETCH_TEST) {
 
             $message .= ' URL ';
-            $message .= quote($test{'data'});
+            $message .= quote($test->{'data'});
             $message .= ' and expected status code ';
-            $message .= quote($test{'expected-status-code'});
+            $message .= quote($test->{'expected-status-code'});
 
-        } elsif ($test{'type'} == TRUSTED_CGI_REQUEST) {
+        } elsif ($test->{'type'} == TRUSTED_CGI_REQUEST) {
 
             $message .= ' CGI URL ';
-            $message .= quote($test{'data'});
+            $message .= quote($test->{'data'});
             $message .= ' and expected status code ';
-            $message .= quote($test{'expected-status-code'});
+            $message .= quote($test->{'expected-status-code'});
 
-        } elsif ($test{'type'} == METHOD_TEST) {
+        } elsif ($test->{'type'} == METHOD_TEST) {
 
             $message .= ' HTTP method ';
-            $message .= quote($test{'data'});
+            $message .= quote($test->{'data'});
             $message .= ' and expected status code ';
-            $message .= quote($test{'expected-status-code'});
+            $message .= quote($test->{'expected-status-code'});
 
-        } elsif ($test{'type'} == BLOCK_TEST) {
+        } elsif ($test->{'type'} == BLOCK_TEST) {
 
             $message .= ' Supposedly-blocked URL: ';
-            $message .= quote($test{'data'});
+            $message .= quote($test->{'data'});
 
-        } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
+        } elsif ($test->{'type'} == STICKY_ACTIONS_TEST) {
 
             $message .= ' Sticky Actions: ';
-            $message .= quote($test{'sticky-actions'});
+            $message .= quote($test->{'sticky-actions'});
             $message .= ' and URL: ';
-            $message .= quote($test{'data'});
+            $message .= quote($test->{'data'});
 
         } else {
 
-            die "Incomplete support for test type " . $test{'type'} .  " detected.";
+            die "Incomplete support for test type " . $test->{'type'} .  " detected.";
         }
     }
 
@@ -1519,7 +1512,6 @@ sub main () {
 
     init_our_variables();
     parse_cli_options();
-    check_for_curl();
     init_proxy_settings('vanilla-proxy');
     load_regressions_tests();
     init_proxy_settings('fuzz-proxy');