This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Store the SHA-256 of the source in files generated by regen_perly.pl
authorNicholas Clark <nick@ccl4.org>
Sun, 23 Jan 2011 18:29:20 +0000 (18:29 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 23 Jan 2011 18:45:59 +0000 (18:45 +0000)
bison isn't available everywhere, so we can't simply re-run regen_perly.pl to
verify that perly.{act,h,tab} are up to date. So instead store the SHA-256 of
the input files, and extend t/porting/regen.t to check that the input files
haven't been changed subsequently.

perly.act
perly.h
perly.tab
regen/regen_lib.pl
regen_perly.pl
t/porting/regen.t

index ae8e330..1da1819 100644 (file)
--- a/perly.act
+++ b/perly.act
@@ -1709,4 +1709,7 @@ case 2:
       default: break;
     
 
-/* ex: set ro: */
+/* Generated from:
+ * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y
+ * dc72db91baa0a3c17a6c95718e5ad70e9ac7b75919df1317df7fe6c3f1649239 regen_perly.pl
+ * ex: set ro: */
diff --git a/perly.h b/perly.h
index 25f5864..6c282bf 100644 (file)
--- a/perly.h
+++ b/perly.h
@@ -239,4 +239,7 @@ typedef union YYSTYPE
 
 
 
-/* ex: set ro: */
+/* Generated from:
+ * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y
+ * dc72db91baa0a3c17a6c95718e5ad70e9ac7b75919df1317df7fe6c3f1649239 regen_perly.pl
+ * ex: set ro: */
index 2e4c30c..fee5626 100644 (file)
--- a/perly.tab
+++ b/perly.tab
@@ -1073,4 +1073,7 @@ static const toketypes yy_type_tab[] =
   toketype_opval
 };
 
-/* ex: set ro: */
+/* Generated from:
+ * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y
+ * dc72db91baa0a3c17a6c95718e5ad70e9ac7b75919df1317df7fe6c3f1649239 regen_perly.pl
+ * ex: set ro: */
index 2d4ceac..85defb9 100644 (file)
@@ -133,13 +133,29 @@ EOM
 }
 
 sub read_only_bottom_close_and_rename {
-    my $fh = shift;
+    my ($fh, $sources) = @_;
     my $name = *{$fh}->{name};
     my $lang = *{$fh}->{lang};
     die "No final name specified at open time for $name"
        unless *{$fh}->{final_name};
-    print $fh $lang eq 'Perl'
-       ? "\n# ex: set ro:\n" : "\n/* ex: set ro: */\n";
+    my $comment;
+    if ($sources) {
+       $comment = "Generated from:\n";
+       foreach my $file (sort @$sources) {
+           my $digest = digest($file);
+           $comment .= "$digest $file\n";
+       }
+    }
+    $comment .= "ex: set ro:";
+
+    if ($lang eq 'Perl') {
+       $comment =~ s/^/# /mg;
+    } else {
+       $comment =~ s/^/ * /mg;
+       $comment =~ s! \* !/* !;
+       $comment .= " */";
+    }
+    print $fh "\n$comment\n";
     safer_close($fh);
     rename_if_different($name, *{$fh}->{final_name});
 }
@@ -150,4 +166,17 @@ sub tab {
     $t;
 }
 
+sub digest {
+    my $file = shift;
+    # Need to defer loading this, as the main regen scripts work back to 5.004,
+    # and likely we don't even have this module on every 5.8 install yet:
+    require Digest::SHA;
+
+    local ($/, *FH);
+    open FH, "$file" or die "Can't open $file: $!";
+    my $raw = <FH>;
+    close FH or die "Can't close $file: $!";
+    return Digest::SHA::sha256_hex($raw);
+};
+
 1;
index 00d2a59..ec591c5 100644 (file)
@@ -101,11 +101,9 @@ my $read_only = read_only_top(lang => 'C', by => $0, from => $y_file);
 
 my $act_fh = safer_open("$act_file-new", $act_file);
 print $act_fh $read_only, $actlines;
-read_only_bottom_close_and_rename($act_fh);
 
 my $tab_fh = safer_open("$tab_file-new", $tab_file);
 print $tab_fh $read_only, $tablines;
-read_only_bottom_close_and_rename($tab_fh);
 
 unlink $tmpc_file;
 
@@ -147,7 +145,9 @@ while (<$tmph_fh>) {
 close $tmph_fh;
 unlink $tmph_file;
 
-read_only_bottom_close_and_rename($h_fh);
+foreach ($act_fh, $tab_fh, $h_fh) {
+    read_only_bottom_close_and_rename($_, ['regen_perly.pl', $y_file]);
+}
 
 exit 0;
 
index 810aa35..edae912 100644 (file)
@@ -18,6 +18,36 @@ $ENV{PERL5LIB} = rel2abs($lib);
 
 chdir '..' if $in_t;
 
-print "1..18\n"; # I can't see a clean way to calculate this automatically.
+$INC[0] = 'lib';
+require 'regen/regen_lib.pl';
+require 't/test.pl';
+$::NO_ENDING = $::NO_ENDING = 1;
+
+my $in_regen_pl = 18; # I can't see a clean way to calculate this automatically.
+my @files = qw(perly.act perly.h perly.tab);
+
+plan (tests => $in_regen_pl + @files);
+
+OUTER: foreach my $file (@files) {
+    open my $fh, '<', $file or die "Can't open $file: $!";
+    1 while defined($_ = <$fh>) and !/Generated from:/;
+    if (eof $fh) {
+       fail("Can't find 'Generated from' line in $file");
+       next;
+    }
+    my @bad;
+    while (<$fh>) {
+       last if /ex: set ro:/;
+       unless (/^(?: \* | #)([0-9a-f]+) (\S+)$/) {
+           chomp $_;
+           fail("Bad line in $file: '$_'");
+           next OUTER;
+       }
+       my $digest = digest($2);
+       note("$digest $2");
+       push @bad, $2 unless $digest eq $1;
+    }
+    is("@bad", '', "generated $file is up to date");
+}
 
 system "$^X regen.pl --tap";