If --verbose is set, log which tests were skipped and why.

[privoxy.git] / tools / privoxy-regression-test.pl

diff --git a/tools/privoxy-regression-test.pl b/tools/privoxy-regression-test.pl
index f550d07..b2cba4e 100755 (executable)
--- 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.155 2008/06/28 16:39:59 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.164 2009/02/23 09:40:24 fk Exp $
 #
 # Wish list:
 #
@@ -19,7 +19,7 @@
 # - Document magic Expect Header values
 # - Internal fuzz support?
 #
-# Copyright (c) 2007-2008 Fabian Keil <fk@fabiankeil.de>
+# Copyright (c) 2007-2009 Fabian Keil <fk@fabiankeil.de>
 #
 # Permission to use, copy, modify, and distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above
@@ -40,16 +40,17 @@ use strict;
 use Getopt::Long;
 
 use constant {
-               PRT_VERSION => 'Privoxy-Regression-Test 0.2',
+               PRT_VERSION => 'Privoxy-Regression-Test 0.3',
  
-              CURL => 'curl',
+               CURL => 'curl',
 
                # CLI option defaults
-              CLI_RETRIES   => 1,
-              CLI_LOOPS     => 1,
-              CLI_MAX_TIME  => 5,
-              CLI_MIN_LEVEL => 0,
-              CLI_MAX_LEVEL => 25,
+               CLI_RETRIES   => 1,
+               CLI_LOOPS     => 1,
+               CLI_MAX_TIME  => 5,
+               CLI_MIN_LEVEL => 0,
+               # XXX: why limit at all.
+               CLI_MAX_LEVEL => 100,
                CLI_FORKS     => 0,
 
                PRIVOXY_CGI_URL => 'http://p.p/',
@@ -155,9 +156,11 @@ sub load_regressions_tests () {
 
     our $privoxy_cgi_url;
     our @privoxy_config;
+    our %privoxy_features;
     my @actionfiles;
     my $curl_url = '';
     my $file_number = 0;
+    my $feature;
 
     $curl_url .= $privoxy_cgi_url;
     $curl_url .= 'show-status';
@@ -176,6 +179,15 @@ sub load_regressions_tests () {
 
             my $directive = $1 . " " . $2;
             push (@privoxy_config, $directive);
+
+        } elsif (m@<td><code>([^<]*)</code></td>@) {
+
+            $feature = $1;
+
+        } elsif (m@<td> (Yes|No) </td>@) {
+
+            $privoxy_features{$feature} = $1 if defined $feature;
+            $feature = undef;
         }
     }
 
@@ -310,7 +322,8 @@ sub load_action_files ($) {
 
     my $ignored = 0;
 
-    l(LL_STATUS, "Loading regression tests from action file(s) delivered by Privoxy.");
+    l(LL_STATUS, "Gathering regression tests from " .
+      @actionfiles . " action file(s) delivered by Privoxy.");
 
     for my $file_number (0 .. @actionfiles - 1) {
 
@@ -481,11 +494,26 @@ 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 {
 
-                if ($regression_tests[$s][$r]{'ignore'}
-                    or level_is_unacceptable($regression_tests[$s][$r]{'level'})
-                    or test_number_is_unacceptable($number)) {
+                    $skip_reason = level_is_unacceptable($regression_tests[$s][$r]{'level'});
+                }
+
+                if (defined $skip_reason) {
 
+                    my $message = "Skipping test " . $number . ": " . $skip_reason . ".";
+                    log_message($message) if cli_option_is_set('verbose');
                     $skipped++;
 
                 } else {
@@ -506,8 +534,8 @@ sub execute_regression_tests () {
             'Skipped ' . $skipped . '. ' . 
             $successes . " successes, " . $failures . " failures.");
 
-        $all_tests    += $tests;
-        $all_failures += $failures;
+        $all_tests     += $tests;
+        $all_failures  += $failures;
         $all_successes += $successes;
 
     }
@@ -520,17 +548,31 @@ sub execute_regression_tests () {
 
 sub level_is_unacceptable ($) {
     my $level = shift;
-    return ((cli_option_is_set('level') and get_cli_option('level') != $level)
-            or ($level < get_cli_option('min-level'))
-            or ($level > get_cli_option('max-level'))
-            or dependency_unsatisfied($level)
-            );
-}
+    my $min_level = get_cli_option('min-level');
+    my $max_level = get_cli_option('max-level');
+    my $required_level = cli_option_is_set('level') ?
+        get_cli_option('level') : $level;
+    my $reason = undef;
+
+    if ($required_level != $level) {
+
+        $reason = "Level doesn't match (" . $level .
+                  " != " . $required_level . ")"
 
-sub test_number_is_unacceptable ($) {
-    my $test_number = shift;
-    return (cli_option_is_set('test-number')
-            and get_cli_option('test-number') != $test_number)
+    } elsif ($level < $min_level) {
+
+        $reason = "Level to low (" . $level . " < " . $min_level . ")";
+
+    } elsif ($level > $max_level) {
+
+        $reason = "Level to high (" . $level . " > " . $max_level . ")";
+
+    } else {
+
+        $reason = dependency_unsatisfied($level);
+    }
+
+    return $reason;
 }
 
 sub dependency_unsatisfied ($) {
@@ -538,16 +580,31 @@ sub dependency_unsatisfied ($) {
     my $level = shift;
     our %dependencies;
     our @privoxy_config;
-    my $dependency_problem = 0;
+    our %privoxy_features;
+
+    my $dependency_problem = undef;
 
     if (defined ($dependencies{$level}{'config line'})) {
 
         my $dependency = $dependencies{$level}{'config line'};
-        $dependency_problem = 1;
+        $dependency_problem = "depends on config line matching: '" . $dependency . "'";
 
         foreach (@privoxy_config) {
 
-             $dependency_problem = 0 if (/$dependency/);
+             $dependency_problem = undef if (/$dependency/);
+             last; # XXX: this looks ... interesting.
+        }
+
+    } elsif (defined ($dependencies{$level}{'feature status'})) {
+
+        my $dependency = $dependencies{$level}{'feature status'};
+        my ($feature, $status) = $dependency =~ /([^\s]*)\s+(Yes|No)/;
+
+        unless (defined($privoxy_features{$feature})
+                and ($privoxy_features{$feature} eq $status))
+        {
+            $dependency_problem = "depends on '" . $feature .
+                "' being set to '" . $status . "'";
         }
     }
 
@@ -562,7 +619,12 @@ sub register_dependency ($$) {
 
     if ($dependency =~ /config line\s+(.*)/) {
 
-       $dependencies{$level}{'config line'} = $1;
+        $dependencies{$level}{'config line'} = $1;
+
+    } elsif ($dependency =~ /feature status\s+(.*)/) {
+
+        $dependencies{$level}{'feature status'} = $1;
+
     }
 }
 
@@ -793,7 +855,6 @@ sub execute_server_header_regression_test ($) {
     return check_header_result($test_ref, $header);
 }
 
-
 sub interpret_result ($) {
     my $success = shift;
     return $success ? "Success" : "Failure";
@@ -1102,7 +1163,6 @@ sub get_show_request_with_curl ($) {
     return get_cgi_page_or_else($curl_parameters);
 }
 
-
 sub get_head_with_curl ($) {
 
     our $fellatio_url = FELLATIO_URL;
@@ -1123,7 +1183,6 @@ sub get_head_with_curl ($) {
     return get_page_with_curl($curl_parameters);
 }
 
-
 sub get_page_with_curl ($) {
 
     our $proxy;
@@ -1193,7 +1252,6 @@ sub array_as_string ($) {
     return $string;
 }
 
-
 sub show_test ($) {
     my $test_ref = shift;
     log_message('Test is:' . test_content_as_string($test_ref));
@@ -1246,9 +1304,7 @@ sub log_message ($) {
         $message = $time_stamp . ": " . $message;
     }
 
-
     printf(STDERR "%s\n", $message);
-
 }
 
 sub log_result ($$) {
@@ -1339,7 +1395,7 @@ sub quote ($) {
 }
 
 sub print_version () {
-    printf PRT_VERSION . "\n" . 'Copyright (C) 2007-2008 Fabian Keil <fk@fabiankeil.de>' . "\n";
+    printf PRT_VERSION . "\n" . 'Copyright (C) 2007-2009 Fabian Keil <fk@fabiankeil.de>' . "\n";
 }
 
 sub help () {
@@ -1364,6 +1420,7 @@ Options and their default values if they have any:
     [--min-level $cli_options{'min-level'}]
     [--privoxy-address]
     [--retries $cli_options{'retries'}]
+    [--test-number]
     [--verbose]
     [--version]
 see "perldoc $0" for more information
@@ -1464,7 +1521,6 @@ sub start_forks($) {
     }
 }
 
-
 sub main () {
 
     init_our_variables();
@@ -1489,7 +1545,8 @@ B<privoxy-regression-test> [B<--debug bitmask>] [B<--forks> forks]
 [B<--fuzzer-feeding>] [B<--fuzzer-feeding>] [B<--help>] [B<--level level>]
 [B<--loops count>] [B<--max-level max-level>] [B<--max-time max-time>]
 [B<--min-level min-level>] B<--privoxy-address proxy-address>
-[B<--retries retries>] [B<--verbose>] [B<--version>]
+[B<--retries retries>] [B<--test-number test-number>] [B<--verbose>]
+[B<--version>]
 
 =head1 DESCRIPTION
 
@@ -1634,6 +1691,9 @@ syntax.
 
 B<--retries retries> Retry B<retries> times.
 
+B<--test-number test-number> Only run the test with the specified
+number.
+
 B<--verbose> Also log succesful test runs.
 
 B<--version> Print version and exit.