diff options
author | Nicholas Clark <nick@ccl4.org> | 2013-07-22 09:26:24 +0200 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2013-07-24 09:36:11 +0200 |
commit | e206599ac5717a273d976ec79a65f25cf6246226 (patch) | |
tree | 52bc22f6150dc68f201b8e36e3cce892e1ee1363 /regen/regen_lib.pl | |
parent | 020a5f5fd939288c1ef0a8336a233d1aa5c1254d (diff) | |
download | perl-e206599ac5717a273d976ec79a65f25cf6246226.tar.gz |
On failure, regen_lib.pl now generates diagnostics, not just "not ok".
We have to stop using File::Compare's compare(), as it doesn't return
diagnostics about what went wrong.
Diffstat (limited to 'regen/regen_lib.pl')
-rw-r--r-- | regen/regen_lib.pl | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl index 9e79f69775..b64e0b00a7 100644 --- a/regen/regen_lib.pl +++ b/regen/regen_lib.pl @@ -67,8 +67,39 @@ sub close_and_rename { close $fh or die "Error closing $name: $!"; if ($TAP) { - my $not = compare($name, $final_name) ? 'not ' : ''; - print STDOUT $not . "ok - $0 $final_name\n"; + # Don't use compare beacuse if there are errors it doesn't give any + # way to generate diagnostics about what went wrong. + # These files are small enough to read into memory. + local $/; + # This is the file we just closed, so it should open cleanly: + open $fh, '<', $name + or die "Can't open '$name': $!"; + my $want = <$fh>; + die "Can't read '$name': $!" + unless defined $want; + close $fh + or die "Can't close '$name': $!"; + + my $fail; + if (!open $fh, '<', $final_name) { + $fail = "Can't open '$final_name': $!"; + } else { + my $have = <$fh>; + if (!defined $have) { + $fail = "Can't read '$final_name': $!"; + close $fh; + } elsif (!close $fh) { + $fail = "Can't close '$final_name': $!"; + } elsif ($want ne $have) { + $fail = "'$name' and '$final_name' differ"; + } + } + if ($fail) { + print STDOUT "not ok - $0 $final_name\n"; + print STDERR "$fail\n"; + } else { + print STDOUT "ok - $0 $final_name\n"; + } safer_unlink($name); return; } |