Re: [patch] refine make regen to be more selective

   Message-ID: <47D720CE.7060004@gmail.com>
   Date: Tue, 11 Mar 2008 18:16:14 -0600

p4raw-id: //depot/perl@33537

7 files changed, 65 insertions, 30 deletions

diff --git a/embed.pl b/embed.pl
index 97f0d8390e..147c8e2cf4 100755
--- a/embed.pl
+++ b/embed.pl
@@ -84,8 +84,8 @@ sub walk_table (&@) {
 	$F = $filename;
     }
     else {
-	safer_unlink $filename if $filename ne '/dev/null';
-	open F, ">$filename" or die "Can't open $filename: $!";
+	# safer_unlink $filename if $filename ne '/dev/null';
+	open F, ">$filename-new" or die "Can't open $filename: $!";
 	binmode F;
 	$F = \*F;
     }
@@ -112,6 +112,7 @@ sub walk_table (&@) {
     print $F $trailer if $trailer;
     unless (ref $filename) {
 	close $F or die "Error closing $filename: $!";
+	safer_rename("$filename-new", $filename);
     }
 }
 
@@ -388,8 +389,7 @@ sub multoff ($$) {
     return hide("PL_$pre$sym", "PL_$sym");
 }
 
-safer_unlink 'embed.h';
-open(EM, '> embed.h') or die "Can't create embed.h: $!\n";
+open(EM, '> embed.h-new') or die "Can't create embed.h: $!\n";
 binmode EM;
 
 print EM do_not_edit ("embed.h"), <<'END';
@@ -642,9 +642,9 @@ print EM <<'END';
 END
 
 close(EM) or die "Error closing EM: $!";
+safer_rename('embed.h-new', 'embed.h');
 
-safer_unlink 'embedvar.h';
-open(EM, '> embedvar.h')
+open(EM, '> embedvar.h-new')
     or die "Can't create embedvar.h: $!\n";
 binmode EM;
 
@@ -739,12 +739,11 @@ print EM <<'END';
 END
 
 close(EM) or die "Error closing EM: $!";
+safer_rename('embedvar.h-new', 'embedvar.h');
 
-safer_unlink 'perlapi.h';
-safer_unlink 'perlapi.c';
-open(CAPI, '> perlapi.c') or die "Can't create perlapi.c: $!\n";
+open(CAPI, '> perlapi.c-new') or die "Can't create perlapi.c: $!\n";
 binmode CAPI;
-open(CAPIH, '> perlapi.h') or die "Can't create perlapi.h: $!\n";
+open(CAPIH, '> perlapi.h-new') or die "Can't create perlapi.h: $!\n";
 binmode CAPIH;
 
 print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
@@ -869,6 +868,7 @@ print CAPIH <<'EOT';
 /* ex: set ro: */
 EOT
 close CAPIH or die "Error closing CAPIH: $!";
+safer_rename('perlapi.h-new', 'perlapi.h');
 
 print CAPI do_not_edit ("perlapi.c"), <<'EOT';
 
@@ -950,6 +950,7 @@ END_EXTERN_C
 EOT
 
 close(CAPI) or die "Error closing CAPI: $!";
+safer_rename('perlapi.c-new', 'perlapi.c');
 
 # functions that take va_list* for implementing vararg functions
 # NOTE: makedef.pl must be updated if you add symbols to %vfuncs
diff --git a/keywords.pl b/keywords.pl
index eb0c0af41b..8e7a67804b 100755
--- a/keywords.pl
+++ b/keywords.pl
@@ -2,8 +2,8 @@
 use strict;
 
 require 'regen_lib.pl';
-safer_unlink ("keywords.h");
-open(KW, ">keywords.h") || die "Can't create keywords.h: $!\n";
+
+open(KW, ">keywords.h-new") || die "Can't create keywords.h: $!\n";
 binmode KW;
 select KW;
 
@@ -39,6 +39,8 @@ print KW "\n/* ex: set ro: */\n";
 
 close KW or die "Error closing keywords.h: $!";
 
+safer_rename("keywords.h-new", "keywords.h");
+
 ###########################################################################
 sub tab {
     my ($l, $t) = @_;
diff --git a/opcode.pl b/opcode.pl
index ef9ab1e283..69ef23c4b8 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -443,9 +443,6 @@ print ON "/* ex: set ro: */\n";
 close OC or die "Error closing opcode.h: $!\n";
 close ON or die "Error closing opnames.h: $!\n";
 
-foreach ('opcode.h', 'opnames.h') {
-    safer_rename_silent $_, "$_-old";
-}
 safer_rename $opcode_new, 'opcode.h';
 safer_rename $opname_new, 'opnames.h';
 
@@ -497,9 +494,6 @@ print PPSYM "\n# ex: set ro:\n";
 close PP or die "Error closing pp_proto.h: $!\n";
 close PPSYM or die "Error closing pp.sym: $!\n";
 
-foreach ('pp_proto.h', 'pp.sym') {
-    safer_rename_silent $_, "$_-old";
-}
 safer_rename $pp_proto_new, 'pp_proto.h';
 safer_rename $pp_sym_new, 'pp.sym';
 
diff --git a/reentr.pl b/reentr.pl
index 8bed03c7ab..aea679df44 100644
--- a/reentr.pl
+++ b/reentr.pl
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 use Getopt::Std;
 my %opts;
-getopts('U', \%opts);
+getopts('Uv', \%opts);
 
 my %map = (
 	   V => "void",
@@ -40,8 +40,8 @@ my %map = (
 # Example #3: S_CBI   means type func_r(const char*, char*, int)
 
 
-safer_unlink 'reentr.h';
-die "reentr.h: $!" unless open(H, ">reentr.h");
+# safer_unlink 'reentr.h';
+die "reentr.pl: $!" unless open(H, ">reentr.h-new");
 binmode H;
 select H;
 print <<EOF;
@@ -789,11 +789,12 @@ typedef struct {
 EOF
 
 close(H);
+safer_rename('reentr.h-new', 'reentr.h');
 
 # Prepare to write the reentr.c.
 
-safer_unlink 'reentr.c';
-die "reentr.c: $!" unless open(C, ">reentr.c");
+# safer_unlink 'reentr.c';
+die "reentr.c: $!" unless open(C, ">reentr.c-new");
 binmode C;
 select C;
 print <<EOF;
@@ -1090,6 +1091,9 @@ Perl_reentrant_retry(const char *f, ...)
 /* ex: set ro: */
 EOF
 
+close(C);
+safer_rename('reentr.c-new', 'reentr.c');
+
 __DATA__
 asctime S	|time	|const struct tm|B_SB|B_SBI|I_SB|I_SBI
 crypt CC	|crypt	|struct crypt_data|B_CCS|B_CCD|D=CRYPTD*
diff --git a/regen.pl b/regen.pl
index a1f1ab8d87..821fa2ebc5 100644
--- a/regen.pl
+++ b/regen.pl
@@ -13,8 +13,8 @@ my $perl = $^X;
 
 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");
+# changes.  Um, what ?
+# safer_unlink ("warnings.h", "lib/warnings.pm");
 
 my %gen = (
 	   'autodoc.pl'  => [qw[pod/perlapi.pod pod/perlintern.pod]],
diff --git a/regen_lib.pl b/regen_lib.pl
index 1c830a2cdc..896a9ad0fe 100644
--- a/regen_lib.pl
+++ b/regen_lib.pl
@@ -15,6 +15,24 @@ if ($Is_NetWare) {
 
 $Needs_Write = $Is_OS2 || $Is_W32 || $Is_Cygwin || $Is_NetWare;
 
+eval "use Digest::MD5 'md5'; 1;"
+    or warn "Digest::MD5 unavailable, doing unconditional regen\n";
+
+sub cksum {
+    my $pl = shift;
+    my ($buf, $cksum);
+    local *FH;
+    if (open(FH, $pl)) {
+	local $/;
+	$buf = <FH>;
+	$cksum = defined &md5 ? md5($buf) : 0;
+	close FH;
+    } else {
+	warn "$0: $pl: $!\n";
+    }
+    return $cksum;
+}
+
 sub safer_unlink {
   my @names = @_;
   my $cnt = 0;
@@ -38,8 +56,23 @@ sub safer_rename_silent {
   rename $from, $to;
 }
 
+sub safer_rename_always {
+  my ($from, $to) = @_;
+  safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
+}
+
 sub safer_rename {
   my ($from, $to) = @_;
+
+  my $fc = cksum($from);
+  my $tc = cksum($to);
+  
+  if ($fc and $fc eq $tc) {
+      warn "no changes between '$from' & '$to'\n";
+      safer_unlink($from);
+      return;
+  }
+  warn "changed '$from' to '$to'\n";
   safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
 }
 1;
diff --git a/warnings.pl b/warnings.pl
index 97d5d14bab..b639fc6cf4 100644
--- a/warnings.pl
+++ b/warnings.pl
@@ -3,7 +3,8 @@
 $VERSION = '1.02_02';
 
 BEGIN {
-  push @INC, './lib';
+    require 'regen_lib.pl';
+    push @INC, './lib';
 }
 use strict ;
 
@@ -249,11 +250,9 @@ if (@ARGV && $ARGV[0] eq "tree")
     exit ;
 }
 
-unlink "warnings.h";
-unlink "lib/warnings.pm";
-open(WARN, ">warnings.h") || die "Can't create warnings.h: $!\n";
+open(WARN, ">warnings.h-new") || die "Can't create warnings.h: $!\n";
+open(PM, ">lib/warnings.pm-new") || die "Can't create lib/warnings.pm: $!\n";
 binmode WARN;
-open(PM, ">lib/warnings.pm") || die "Can't create lib/warnings.pm: $!\n";
 binmode PM;
 
 print WARN <<'EOM' ;
@@ -366,6 +365,7 @@ print WARN <<'EOM';
 EOM
 
 close WARN ;
+safer_rename("warnings.h-new", "warnings.h");
 
 while (<DATA>) {
     last if /^KEYWORDS$/ ;
@@ -427,6 +427,7 @@ while (<DATA>) {
 
 print PM "# ex: set ro:\n";
 close PM ;
+safer_rename("lib/warnings.pm-new", "lib/warnings.pm");
 
 __END__
 # -*- buffer-read-only: t -*-