perldelta entry for ce3778a3796be3e4604ed9b3671ea624c5affe0b.

[perl5.git] / regen / regen_lib.pl

diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl
index 9e79f69..abeecba 100644 (file)
--- 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 because 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;
     }
@@ -193,4 +224,24 @@ sub wrap {
     Text::Wrap::wrap(@_);
 }
 
+# return the perl version as defined in patchlevel.h.
+# (we may be being run by another perl, so $] won't be right)
+# return e.g. (5, 14, 3, "5.014003")
+
+sub perl_version {
+    my $plh = 'patchlevel.h';
+    open my $fh, "<", $plh or die "can't open '$plh': $!\n";
+    my ($v1,$v2,$v3);
+    while (<$fh>) {
+        $v1 = $1 if /PERL_REVISION\s+(\d+)/;
+        $v2 = $1 if /PERL_VERSION\s+(\d+)/;
+        $v3 = $1 if /PERL_SUBVERSION\s+(\d+)/;
+    }
+    die "can't locate PERL_REVISION in '$plh'"   unless defined $v1;
+    die "can't locate PERL_VERSION in '$plh'"    unless defined $v2;
+    die "can't locate PERL_SUBVERSION in '$plh'" unless defined $v3;
+    return ($v1,$v2,$v3, sprintf("%d.%03d%03d", $v1, $v2, $v3));
+}
+
+
 1;