recommend logging crunches
[privoxy.git] / tools / privoxy-regression-test.pl
index f7806ba..fcdf816 100755 (executable)
@@ -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.156 2008/07/03 11:26:35 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.166 2009/02/27 18:33:39 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,50 +40,50 @@ use strict;
 use Getopt::Long;
 
 use constant {
-               PRT_VERSION => 'Privoxy-Regression-Test 0.2',
+    PRT_VERSION => 'Privoxy-Regression-Test 0.3',
  
-               CURL => 'curl',
-
-               # CLI option defaults
-               CLI_RETRIES   => 1,
-               CLI_LOOPS     => 1,
-               CLI_MAX_TIME  => 5,
-               CLI_MIN_LEVEL => 0,
-               CLI_MAX_LEVEL => 25,
-               CLI_FORKS     => 0,
-
-               PRIVOXY_CGI_URL => 'http://p.p/',
-               FELLATIO_URL    => 'http://127.0.0.1:8080/',
-               LEADING_LOG_DATE => 1,
-               LEADING_LOG_TIME => 1,
-
-               DEBUG_LEVEL_FILE_LOADING    => 0,
-               DEBUG_LEVEL_PAGE_FETCHING   => 0,
-
-               VERBOSE_TEST_DESCRIPTION    => 1,
-
-               DEBUG_LEVEL_VERBOSE_FAILURE => 1,
-               # XXX: Only partly implemented and mostly useless.
-               DEBUG_LEVEL_VERBOSE_SUCCESS => 0,
-               DEBUG_LEVEL_STATUS          => 1,
-
-               # Internal use, don't modify
-               # Available debug bits:
-               LL_ERROR                   =>  1,
-               LL_VERBOSE_FAILURE         =>  2,
-               LL_PAGE_FETCHING           =>  4,
-               LL_FILE_LOADING            =>  8,
-               LL_VERBOSE_SUCCESS         => 16,
-               LL_STATUS                  => 32,
-               LL_SOFT_ERROR              => 64,
-
-               CLIENT_HEADER_TEST         =>  1,
-               SERVER_HEADER_TEST         =>  2,
-               DUMB_FETCH_TEST            =>  3,
-               METHOD_TEST                =>  4,
-               STICKY_ACTIONS_TEST        =>  5,
-               TRUSTED_CGI_REQUEST        =>  6,
-               BLOCK_TEST                 =>  7,
+    CURL => 'curl',
+
+    # CLI option defaults
+    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/',
+    FELLATIO_URL     => 'http://127.0.0.1:8080/',
+    LEADING_LOG_DATE => 1,
+    LEADING_LOG_TIME => 1,
+
+    DEBUG_LEVEL_FILE_LOADING    => 0,
+    DEBUG_LEVEL_PAGE_FETCHING   => 0,
+    DEBUG_LEVEL_VERBOSE_FAILURE => 1,
+    # XXX: Only partly implemented and mostly useless.
+    DEBUG_LEVEL_VERBOSE_SUCCESS => 0,
+    DEBUG_LEVEL_STATUS          => 1,
+
+    VERBOSE_TEST_DESCRIPTION    => 1,
+
+    # Internal use, don't modify
+    # Available debug bits:
+    LL_ERROR            =>  1,
+    LL_VERBOSE_FAILURE  =>  2,
+    LL_PAGE_FETCHING    =>  4,
+    LL_FILE_LOADING     =>  8,
+    LL_VERBOSE_SUCCESS  => 16,
+    LL_STATUS           => 32,
+    LL_SOFT_ERROR       => 64,
+
+    CLIENT_HEADER_TEST  =>  1,
+    SERVER_HEADER_TEST  =>  2,
+    DUMB_FETCH_TEST     =>  3,
+    METHOD_TEST         =>  4,
+    STICKY_ACTIONS_TEST =>  5,
+    TRUSTED_CGI_REQUEST =>  6,
+    BLOCK_TEST          =>  7,
 };
 
 sub init_our_variables () {
@@ -155,9 +155,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 +178,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;
         }
     }
 
@@ -194,8 +205,8 @@ sub token_starts_new_test ($) {
     foreach my $new_test_directive (@new_test_directives) {
         return 1 if $new_test_directive eq $token;
     }
-    return 0;
 
+    return 0;
 }
 
 sub tokenize ($) {
@@ -224,7 +235,6 @@ sub tokenize ($) {
 
         $token = 'tag';
         $value = $1;
-
     }
 
     return ($token, $value);
@@ -277,7 +287,6 @@ sub enlist_new_test ($$$$$$) {
     } else {
 
         die "Incomplete '" . $token . "' support detected."; 
-
     }
 
     $$regression_tests[$si][$ri]{'type'} = $type;
@@ -310,7 +319,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 +491,27 @@ 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');
 
-                if ($regression_tests[$s][$r]{'ignore'}
-                    or level_is_unacceptable($regression_tests[$s][$r]{'level'})
-                    or test_number_is_unacceptable($number)) {
+                } else {
+
+                    $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') or
+                                              cli_option_is_set('show-skipped-tests'));
                     $skipped++;
 
                 } else {
@@ -506,8 +532,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 +546,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) {
 
-sub test_number_is_unacceptable ($) {
-    my $test_number = shift;
-    return (cli_option_is_set('test-number')
-            and get_cli_option('test-number') != $test_number)
+        $reason = "Level doesn't match (" . $level .
+                  " != " . $required_level . ")"
+
+    } 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 +578,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 +617,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;
+
     }
 }
 
@@ -601,7 +661,6 @@ sub execute_regression_test ($) {
     } else {
 
         die "Unsupported test type detected: " . $test{'type'};
-
     }
 
     return $result;
@@ -761,7 +820,6 @@ sub check_status_code_result ($$) {
 
         l(LL_VERBOSE_FAILURE,
           "Ooops. We expected status code " . $expected_status_code . ", but received: " . $status_code . '.');
-
     }
     
     return $result;
@@ -832,7 +890,6 @@ sub check_header_result ($$) {
             # XXX: Use more reliable check here and make sure
             # the header has a different name.
             $success = 1;
-
         }
 
     } elsif ($expect_header eq 'SOME CHANGE') {
@@ -957,7 +1014,6 @@ sub get_server_header ($$) {
      or $expect_header eq 'SOME CHANGE') {
 
         $expect_header = $test{'data'};
-
     }
 
     $header_to_get = get_header_name($expect_header);
@@ -1068,7 +1124,6 @@ sub get_cgi_page_or_else ($) {
         } else {
 
             l(LL_ERROR, $log_message);
-
         }
     }
     
@@ -1242,9 +1297,7 @@ sub log_message ($) {
         $message = $time_stamp . ": " . $message;
     }
 
-
     printf(STDERR "%s\n", $message);
-
 }
 
 sub log_result ($$) {
@@ -1322,7 +1375,6 @@ sub log_result ($$) {
         } else {
 
             die "Incomplete support for test type " . $test{'type'} .  " detected.";
-
         }
     }
 
@@ -1335,7 +1387,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 () {
@@ -1360,6 +1412,8 @@ Options and their default values if they have any:
     [--min-level $cli_options{'min-level'}]
     [--privoxy-address]
     [--retries $cli_options{'retries'}]
+    [--show-skipped-tests]
+    [--test-number]
     [--verbose]
     [--version]
 see "perldoc $0" for more information
@@ -1373,13 +1427,13 @@ sub init_cli_options () {
     our %cli_options;
     our $log_level;
 
-    $cli_options{'min-level'} = CLI_MIN_LEVEL;
+    $cli_options{'debug'}     = $log_level;
+    $cli_options{'forks'}     = CLI_FORKS;
+    $cli_options{'loops'}     = CLI_LOOPS;
     $cli_options{'max-level'} = CLI_MAX_LEVEL;
-    $cli_options{'debug'}  = $log_level;
-    $cli_options{'loops'}  = CLI_LOOPS;
     $cli_options{'max-time'}  = CLI_MAX_TIME;
-    $cli_options{'retries'}  = CLI_RETRIES;
-    $cli_options{'forks'}    = CLI_FORKS;
+    $cli_options{'min-level'} = CLI_MIN_LEVEL;
+    $cli_options{'retries'}   = CLI_RETRIES;
 }
 
 sub parse_cli_options () {
@@ -1390,22 +1444,23 @@ sub parse_cli_options () {
     init_cli_options();
 
     GetOptions (
-                'debug=s' => \$cli_options{'debug'},
-                'forks=s' => \$cli_options{'forks'},
-                'help'     => sub { help },
-                'header-fuzzing' => \$cli_options{'header-fuzzing'},
-                'min-level=s' => \$cli_options{'min-level'},
-                'max-level=s' => \$cli_options{'max-level'},
-                'privoxy-address=s' => \$cli_options{'privoxy-address'},
-                'fuzzer-address=s' => \$cli_options{'fuzzer-address'},
-                'level=s' => \$cli_options{'level'},
-                'loops=s' => \$cli_options{'loops'},
-                'test-number=s' => \$cli_options{'test-number'},
-                'fuzzer-feeding' => \$cli_options{'fuzzer-feeding'},
-                'retries=s' => \$cli_options{'retries'},
-                'max-time=s' => \$cli_options{'max-time'},
-                'verbose' => \$cli_options{'verbose'},
-                'version'  => sub { print_version && exit(0) }
+        'debug=s'            => \$cli_options{'debug'},
+        'forks=s'            => \$cli_options{'forks'},
+        'fuzzer-address=s'   => \$cli_options{'fuzzer-address'},
+        'fuzzer-feeding'     => \$cli_options{'fuzzer-feeding'},
+        'header-fuzzing'     => \$cli_options{'header-fuzzing'},
+        'help'               => sub {help},
+        'level=s'            => \$cli_options{'level'},
+        'loops=s'            => \$cli_options{'loops'},
+        'max-level=s'        => \$cli_options{'max-level'},
+        'max-time=s'         => \$cli_options{'max-time'},
+        'min-level=s'        => \$cli_options{'min-level'},
+        'privoxy-address=s'  => \$cli_options{'privoxy-address'},
+        'retries=s'          => \$cli_options{'retries'},
+        'show-skipped-tests' => \$cli_options{'show-skipped-tests'},
+        'test-number=s'      => \$cli_options{'test-number'},
+        'verbose'            => \$cli_options{'verbose'},
+        'version'            => sub {print_version && exit(0)}
     );
     $log_level |= $cli_options{'debug'};
 }
@@ -1484,7 +1539,9 @@ 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<--show-skipped-tests>] [B<--verbose>]
+[B<--version>]
 
 =head1 DESCRIPTION
 
@@ -1629,7 +1686,12 @@ syntax.
 
 B<--retries retries> Retry B<retries> times.
 
-B<--verbose> Also log succesful test runs.
+B<--test-number test-number> Only run the test with the specified
+number.
+
+B<--show-skipped-tests> Log skipped tests even if verbose mode is off.
+
+B<--verbose> Log succesful and skipped tests.
 
 B<--version> Print version and exit.