diff options
| -rw-r--r-- | perly.act | 5 | ||||
| -rw-r--r-- | perly.h | 5 | ||||
| -rw-r--r-- | perly.tab | 5 | ||||
| -rw-r--r-- | regen/regen_lib.pl | 35 | ||||
| -rw-r--r-- | regen_perly.pl | 6 | ||||
| -rw-r--r-- | t/porting/regen.t | 32 |
6 files changed, 78 insertions, 10 deletions
@@ -1709,4 +1709,7 @@ case 2: default: break; -/* ex: set ro: */ +/* Generated from: + * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y + * dc72db91baa0a3c17a6c95718e5ad70e9ac7b75919df1317df7fe6c3f1649239 regen_perly.pl + * ex: set ro: */ @@ -239,4 +239,7 @@ typedef union YYSTYPE -/* ex: set ro: */ +/* Generated from: + * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y + * dc72db91baa0a3c17a6c95718e5ad70e9ac7b75919df1317df7fe6c3f1649239 regen_perly.pl + * ex: set ro: */ @@ -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: */ diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl index 2d4ceac14f..85defb9ab6 100644 --- a/regen/regen_lib.pl +++ b/regen/regen_lib.pl @@ -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; diff --git a/regen_perly.pl b/regen_perly.pl index 00d2a59a18..ec591c5b42 100644 --- a/regen_perly.pl +++ b/regen_perly.pl @@ -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; diff --git a/t/porting/regen.t b/t/porting/regen.t index 810aa3547f..edae912a75 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -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"; |