This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
more warning-silencing in FieldHash
[perl5.git] / regen.pl
index 1c830a2..55bd4dc 100644 (file)
--- a/regen.pl
+++ b/regen.pl
@@ -1,45 +1,65 @@
 #!/usr/bin/perl -w
-use strict;
-use vars qw($Is_W32 $Is_OS2 $Is_Cygwin $Is_NetWare $Needs_Write);
-use Config; # Remember, this is running using an existing perl
-
-# Common functions needed by the regen scripts
-
-$Is_W32 = $^O eq 'MSWin32';
-$Is_OS2 = $^O eq 'os2';
-$Is_Cygwin = $^O eq 'cygwin';
-$Is_NetWare = $Config{osname} eq 'NetWare';
-if ($Is_NetWare) {
-  $Is_W32 = 0;
-}
+require 5.003; # keep this compatible, an old perl is all we may have before
+                # we build the new one
 
-$Needs_Write = $Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare;
+# The idea is to move the regen_headers target out of the Makefile so that
+# it is possible to rebuild the headers before the Makefile is available.
+# (and the Makefile is unavailable until after Configure is run, and we may
+# wish to make a clean source tree but with current headers without running
+# anything else.
 
-sub safer_unlink {
-  my @names = @_;
-  my $cnt = 0;
+use strict;
+my $perl = $^X;
 
-  my $name;
-  foreach $name (@names) {
-    next unless -e $name;
-    chmod 0777, $name if $Needs_Write;
-    ( CORE::unlink($name) and ++$cnt
-      or warn "Couldn't unlink $name: $!\n" );
-  }
-  return $cnt;
-}
+require 'regen_lib.pl';
+# keep warnings.pl in sync with the CPAN distribution by not requiring core
+# changes
+safer_unlink ("warnings.h", "lib/warnings.pm");
 
-sub safer_rename_silent {
-  my ($from, $to) = @_;
+my %gen = (
+          'autodoc.pl'  => [qw[pod/perlapi.pod pod/perlintern.pod]],
+          'bytecode.pl' => [qw[ext/ByteLoader/byterun.h
+                               ext/ByteLoader/byterun.c
+                               ext/B/B/Asmdata.pm]],
+          'embed.pl'    => [qw[proto.h embed.h embedvar.h global.sym
+                               perlapi.h perlapi.c]],
+          'keywords.pl' => [qw[keywords.h]],
+          'opcode.pl'   => [qw[opcode.h opnames.h pp_proto.h pp.sym]],
+          'regcomp.pl'  => [qw[regnodes.h]],
+          'warnings.pl' => [qw[warnings.h lib/warnings.pm]],
+          'reentr.pl' => [qw[reentr.c reentr.h]],
+          );
 
-  # Some dosish systems can't rename over an existing file:
-  safer_unlink $to;
-  chmod 0600, $from if $Needs_Write;
-  rename $from, $to;
+sub do_cksum {
+    my $pl = shift;
+    my %cksum;
+    for my $f (@{ $gen{$pl} }) {
+       local *FH;
+       if (open(FH, $f)) {
+           local $/;
+           $cksum{$f} = unpack("%32C*", <FH>);
+           close FH;
+       } else {
+           warn "$0: $f: $!\n";
+       }
+    }
+    return %cksum;
 }
 
-sub safer_rename {
-  my ($from, $to) = @_;
-  safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
+foreach my $pl (qw (keywords.pl opcode.pl embed.pl bytecode.pl
+                   regcomp.pl warnings.pl autodoc.pl reentr.pl)) {
+  print "$^X $pl\n";
+  my %cksum0;
+  %cksum0 = do_cksum($pl) unless $pl eq 'warnings.pl'; # the files were removed
+  system "$^X $pl";
+  next if $pl eq 'warnings.pl'; # the files were removed
+  my %cksum1 = do_cksum($pl);
+  my @chg;
+  for my $f (@{ $gen{$pl} }) {
+      push(@chg, $f)
+         if !defined($cksum0{$f}) ||
+            !defined($cksum1{$f}) ||
+            $cksum0{$f} ne $cksum1{$f};
+  }
+  print "Changed: @chg\n" if @chg;
 }
-1;