From 33d456f2f6387bc2ead8fbe16d67a77edc0336eb Mon Sep 17 00:00:00 2001 From: Stefano Lattarini Date: Thu, 25 Aug 2011 12:44:32 +0200 Subject: [PATCH] tap: improve syncing between awk+shell and perl implementations * lib/tap-driver.pl (stringify_test_result): Renamed ... (stringify_result_obj): ... to this. Break up a clause in the long "if/elsif/.../else" construct to avoid unaesthetic line breaks and to be more synced with the sibling function in `tap-driver.sh'. Rename the `$result', `$PASS' and `$FAIL' variables to respectively `$result_obj', `$COOKED_PASS' and `$COOKED_FAIL', for clarity and better syncing. (handle_tap_test): Renamed ... (handle_tap_result): ... to this, and change the name of the `$test' local variable to `$result_obj'. (extract_comment): Reimplement using the simpler `index' and `substr' builtins, rather than with more advanced uses of regular expressions. (%test_results, @test_results): Renamed respectively ... (%test_results_seen, @test_results_list): ... to these, and related adjustments throughout the `TEST_RESULTS' block. (main, get_global_test_result): Refactor and do some cosmetic changes to make these functions clearer and better synced with sibling code in `tap-driver.sh'. Other minor cosmetic and typo fixes. * lib/tap-driver.sh (extract_tap_comment): Remove outdated "FIXME" comments. (get_global_test_result): Small reordering to make it better synced with its sibling function in `tap-driver.pl'. (stringify_result_obj): Consistently use `result_obj' as the parameter name. Other minor cosmetic and typo fixes. --- ChangeLog | 31 ++++++++++++++++ lib/tap-driver.pl | 107 +++++++++++++++++++++++++++++------------------------- lib/tap-driver.sh | 20 +++++----- 3 files changed, 97 insertions(+), 61 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2739949..b30a1c8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,36 @@ 2011-08-25 Stefano Lattarini + tap: improve syncing between awk+shell and perl implementations + * lib/tap-driver.pl (stringify_test_result): Renamed ... + (stringify_result_obj): ... to this. Break up a clause in the + long "if/elsif/.../else" construct to avoid unaesthetic line + breaks and to be more synced with the sibling function in + `tap-driver.sh'. Rename the `$result', `$PASS' and `$FAIL' + variables to respectively `$result_obj', `$COOKED_PASS' and + `$COOKED_FAIL', for clarity and better syncing. + (handle_tap_test): Renamed ... + (handle_tap_result): ... to this, and change the name of the + `$test' local variable to `$result_obj'. + (extract_comment): Reimplement using the simpler `index' and + `substr' builtins, rather than with more advanced uses of + regular expressions. + (%test_results, @test_results): Renamed respectively ... + (%test_results_seen, @test_results_list): ... to these, and + related adjustments throughout the `TEST_RESULTS' block. + (main, get_global_test_result): Refactor and do some cosmetic + changes to make these functions clearer and better synced with + sibling code in `tap-driver.sh'. + Other minor cosmetic and typo fixes. + * lib/tap-driver.sh (extract_tap_comment): Remove outdated + "FIXME" comments. + (get_global_test_result): Small reordering to make it better + synced with its sibling function in `tap-driver.pl'. + (stringify_result_obj): Consistently use `result_obj' as the + parameter name. + Other minor cosmetic and typo fixes. + +2011-08-25 Stefano Lattarini + tap/perl: don't redirect perl warnings/errors to log files With this change, the test `tap-driver-stderr.test' also passes with the perl implementation of the TAP driver. diff --git a/lib/tap-driver.pl b/lib/tap-driver.pl index 9dce6a0..2c328d9 100755 --- a/lib/tap-driver.pl +++ b/lib/tap-driver.pl @@ -32,7 +32,7 @@ use strict; use Getopt::Long (); use TAP::Parser; -my $VERSION = '2011-08-25.08'; # UTC +my $VERSION = '2011-08-25.10'; # UTC my $ME = "tap-driver.pl"; @@ -127,13 +127,13 @@ sub get_test_exit_message (); sub get_test_results (); sub handle_tap_bailout ($); sub handle_tap_plan ($); -sub handle_tap_test ($); +sub handle_tap_result ($); sub is_null_string ($); sub main (@); sub must_recheck (); sub report ($;$); sub start (@); -sub stringify_test_result ($); +sub stringify_result_obj ($); sub testsuite_error ($); sub trap_perl_warnings_and_errors (); sub write_test_results (); @@ -179,41 +179,42 @@ sub yn ($) TEST_RESULTS : { - my (@test_results, %test_results); + my (@test_results_list, %test_results_seen); sub add_test_result ($) { my $res = shift; - push @test_results, $res; - $test_results{$res} = 1; + push @test_results_list, $res; + $test_results_seen{$res} = 1; } sub get_test_results () { - return @test_results; + return @test_results_list; } # Whether the test script should be re-run by "make recheck". sub must_recheck () { - return grep { !/^(?:XFAIL|PASS|SKIP)$/ } (keys %test_results); + return grep { !/^(?:XFAIL|PASS|SKIP)$/ } (keys %test_results_seen); } # Whether the content of the log file associated to this test should # be copied into the "global" test-suite.log. sub copy_in_global_log () { - return grep { not $_ eq "PASS" } (keys %test_results); + return grep { not $_ eq "PASS" } (keys %test_results_seen); } # FIXME: this can certainly be improved ... sub get_global_test_result () { - my @results = keys %test_results; - return "ERROR" if exists $test_results{"ERROR"}; - return "SKIP" if @results == 1 && $results[0] eq "SKIP"; - return "FAIL" if exists $test_results{"FAIL"}; - return "FAIL" if exists $test_results{"XPASS"}; + return "ERROR" + if $test_results_seen{"ERROR"}; + return "FAIL" + if $test_results_seen{"FAIL"} || $test_results_seen{"XPASS"}; + return "SKIP" + if scalar keys %test_results_seen == 1 && $test_results_seen{"SKIP"}; return "PASS"; } @@ -263,7 +264,7 @@ sub get_test_exit_message () { my $wstatus = $parser->wait; # Watch out for possible internal errors. - die "couldn't get the exit ststus of the TAP producer" + die "$ME: couldn't get the exit ststus of the TAP producer" unless defined $wstatus; # Return an undefined value if the producer exited with success. return unless $wstatus; @@ -284,36 +285,38 @@ sub get_test_exit_message () } } -sub stringify_test_result ($) +sub stringify_result_obj ($) { - my $result = shift; - my $PASS = $cfg{"expect-failure"} ? "XPASS": "PASS"; - my $FAIL = $cfg{"expect-failure"} ? "XFAIL": "FAIL"; - if ($result->is_unplanned - || $result->number != $testno - || $plan_seen == LATE_PLAN) + my $result_obj = shift; + my $COOKED_PASS = $cfg{"expect-failure"} ? "XPASS": "PASS"; + my $COOKED_FAIL = $cfg{"expect-failure"} ? "XFAIL": "FAIL"; + if ($result_obj->is_unplanned || $result_obj->number != $testno) + { + return "ERROR"; + } + elsif ($plan_seen == LATE_PLAN) { return "ERROR"; } - elsif (!$result->directive) + elsif (!$result_obj->directive) { - return $result->is_ok ? $PASS: $FAIL; + return $result_obj->is_ok ? $COOKED_PASS: $COOKED_FAIL; } - elsif ($result->has_todo) + elsif ($result_obj->has_todo) { - return $result->is_actual_ok ? "XPASS" : "XFAIL"; + return $result_obj->is_actual_ok ? "XPASS" : "XFAIL"; } - elsif ($result->has_skip) + elsif ($result_obj->has_skip) { - return $result->is_ok ? "SKIP" : $FAIL; + return $result_obj->is_ok ? "SKIP" : $COOKED_FAIL; } - die "INTERNAL ERROR"; # NOTREACHED + die "$ME: INTERNAL ERROR"; # NOTREACHED } sub colored ($$) { my ($color_name, $text) = @_; - return $COLOR{$color_name} . $text . $COLOR{'std'}; + return $COLOR{$color_name} . $text . $COLOR{'std'}; } sub decorate_result ($) @@ -353,7 +356,7 @@ sub report ($;$) } else { - die "INTERNAL ERROR"; # NOTREACHED + die "$ME: INTERNAL ERROR"; # NOTREACHED } $msg .= " $explanation" if defined $explanation; $msg .= "\n"; @@ -369,15 +372,15 @@ sub testsuite_error ($) report "ERROR", "- $_[0]"; } -sub handle_tap_test ($) +sub handle_tap_result ($) { $testno++; - my $test = shift; + my $result_obj = shift; - my $test_result = stringify_test_result $test; - my $string = $test->number; + my $test_result = stringify_result_obj $result_obj; + my $string = $result_obj->number; - my $description = $test->description; + my $description = $result_obj->description; $string .= " $description" unless is_null_string $description; @@ -385,18 +388,18 @@ sub handle_tap_test ($) { $string .= " # AFTER LATE PLAN"; } - elsif ($test->is_unplanned) + elsif ($result_obj->is_unplanned) { $string .= " # UNPLANNED"; } - elsif ($test->number != $testno) + elsif ($result_obj->number != $testno) { $string .= " # OUT-OF-ORDER (expecting $testno)"; } - elsif (my $directive = $test->directive) + elsif (my $directive = $result_obj->directive) { $string .= " # $directive"; - my $explanation = $test->explanation; + my $explanation = $result_obj->explanation; $string .= " $explanation" unless is_null_string $explanation; } @@ -444,11 +447,15 @@ sub handle_tap_bailout ($) sub extract_tap_comment ($) { - local $_ = shift; - if (/^\Q$diag_string\E(.*)$/o) + my $line = shift; + if (index ($line, $diag_string) == 0) { - (my $comment = $1) =~ s/(?:^\s*|\s*$)//g; - return $comment; + # Strip leading `$diag_string' from `$line'. + $line = substr ($line, length ($diag_string)); + # And strip any leading and trailing whitespace left. + $line =~ s/(?:^\s*|\s*$)//g; + # Return what is left (if any). + return $line; } return ""; } @@ -470,7 +477,7 @@ sub main (@) } elsif ($cur->is_test) { - handle_tap_test ($cur); + handle_tap_result ($cur); } elsif ($cur->is_bailout) { @@ -497,11 +504,11 @@ sub main (@) testsuite_error (sprintf "too %s tests run (expected %d, got %d)", $bad_amount, $planned, $run); } - } - if (!$cfg{"ignore-exit"} && !$bailed_out) - { - my $msg = get_test_exit_message (); - testsuite_error $msg if $msg; + if (!$cfg{"ignore-exit"}) + { + my $msg = get_test_exit_message (); + testsuite_error $msg if $msg; + } } write_test_results; close LOG or die "$ME: closing $log_file: $!\n"; diff --git a/lib/tap-driver.sh b/lib/tap-driver.sh index 16a4e04..535bc2b 100755 --- a/lib/tap-driver.sh +++ b/lib/tap-driver.sh @@ -23,7 +23,7 @@ # bugs to or send patches to # . -scriptversion=2011-08-24.09; # UTC +scriptversion=2011-08-25.10; # UTC # Make unconditional expansion of undefined variables an error. This # helps a lot in preventing typo-related bugs. @@ -195,35 +195,35 @@ function get_global_test_result() { if ("ERROR" in test_results_seen) return "ERROR" + if ("FAIL" in test_results_seen || "XPASS" in test_results_seen) + return "FAIL" all_skipped = 1 for (k in test_results_seen) if (k != "SKIP") all_skipped = 0 if (all_skipped) return "SKIP" - if ("FAIL" in test_results_seen || "XPASS" in test_results_seen) - return "FAIL" return "PASS"; } -function stringify_result_obj(obj) +function stringify_result_obj(result_obj) { - if (obj["is_unplanned"] || obj["number"] != testno) + if (result_obj["is_unplanned"] || result_obj["number"] != testno) return "ERROR" if (plan_seen == LATE_PLAN) return "ERROR" if (result_obj["directive"] == "TODO") - return obj["is_ok"] ? "XPASS" : "XFAIL" + return result_obj["is_ok"] ? "XPASS" : "XFAIL" if (result_obj["directive"] == "SKIP") - return obj["is_ok"] ? "SKIP" : COOKED_FAIL; + return result_obj["is_ok"] ? "SKIP" : COOKED_FAIL; if (length(result_obj["directive"])) abort("in function stringify_result_obj()") - return obj["is_ok"] ? COOKED_PASS : COOKED_FAIL + return result_obj["is_ok"] ? COOKED_PASS : COOKED_FAIL } function decorate_result(result) @@ -294,7 +294,7 @@ function handle_tap_result() report(stringify_result_obj(result_obj), details) } -# `skip_reason` should be emprty whenever planned > 0. +# `skip_reason` should be empty whenever planned > 0. function handle_tap_plan(planned, skip_reason) { planned += 0 # Avoid getting confused if, say, `planned` is "00" @@ -329,11 +329,9 @@ function handle_tap_plan(planned, skip_reason) function extract_tap_comment(line) { - # FIXME: verify there is not an off-by-one bug here. if (index(line, diag_string) == 1) { # Strip leading `diag_string` from `line`. - # FIXME: verify there is not an off-by-one bug here. line = substr(line, length(diag_string) + 1) # And strip any leading and trailing whitespace left. sub("^[ \t]*", "", line) -- 2.7.4