Change 33538 by [EMAIL PROTECTED] on 2008/03/15 18:37:34
Rename safer_rename() to rename_if_different(), to accurately describe
what it does. Use File::Compare rather than Digest::MD5, as the files
are small enough to simply read in. (File::Compare dates from 5.004)
DRY by replacing the cargo-culted "open or die" with a new function
safer_open(), which uses Gensym (5.002) to create an anonymous file
handle, and opens and binmodes the file, or dies.
This necessitates replacing bareword file handles with lexicals in all
the callers.
Correct the names of files in close or die constructions.
Affected files ...
... //depot/perl/embed.pl#368 edit
... //depot/perl/keywords.pl#35 edit
... //depot/perl/opcode.pl#179 edit
... //depot/perl/reentr.pl#57 edit
... //depot/perl/regcomp.pl#23 edit
... //depot/perl/regen_lib.pl#3 edit
... //depot/perl/warnings.pl#64 edit
Differences ...
==== //depot/perl/embed.pl#368 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl#367~33537~ 2008-03-15 10:30:19.000000000 -0700
+++ perl/embed.pl 2008-03-15 11:37:34.000000000 -0700
@@ -79,15 +79,12 @@
defined $leader or $leader = do_not_edit ($filename);
my $trailer = shift;
my $F;
- local *F;
if (ref $filename) { # filehandle
$F = $filename;
}
else {
# safer_unlink $filename if $filename ne '/dev/null';
- open F, ">$filename-new" or die "Can't open $filename: $!";
- binmode F;
- $F = \*F;
+ $F = safer_open("$filename-new");
}
print $F $leader if $leader;
seek IN, 0, 0; # so we may restart
@@ -112,7 +109,7 @@
print $F $trailer if $trailer;
unless (ref $filename) {
close $F or die "Error closing $filename: $!";
- safer_rename("$filename-new", $filename);
+ rename_if_different("$filename-new", $filename);
}
}
@@ -389,10 +386,9 @@
return hide("PL_$pre$sym", "PL_$sym");
}
-open(EM, '> embed.h-new') or die "Can't create embed.h: $!\n";
-binmode EM;
+my $em = safer_open('embed.h-new');
-print EM do_not_edit ("embed.h"), <<'END';
+print $em do_not_edit ("embed.h"), <<'END';
/* (Doing namespace management portably in C is really gross.) */
@@ -456,18 +452,18 @@
# Remember the new state.
$ifdef_state = $new_ifdef_state;
$ret;
-} \*EM, "";
+} $em, "";
if ($ifdef_state) {
- print EM "#endif\n";
+ print $em "#endif\n";
}
for $sym (sort keys %ppsym) {
$sym =~ s/^Perl_//;
- print EM hide($sym, "Perl_$sym");
+ print $em hide($sym, "Perl_$sym");
}
-print EM <<'END';
+print $em <<'END';
#else /* PERL_IMPLICIT_CONTEXT */
@@ -534,26 +530,26 @@
# Remember the new state.
$ifdef_state = $new_ifdef_state;
$ret;
-} \*EM, "";
+} $em, "";
if ($ifdef_state) {
- print EM "#endif\n";
+ print $em "#endif\n";
}
for $sym (sort keys %ppsym) {
$sym =~ s/^Perl_//;
if ($sym =~ /^ck_/) {
- print EM hide("$sym(a)", "Perl_$sym(aTHX_ a)");
+ print $em hide("$sym(a)", "Perl_$sym(aTHX_ a)");
}
elsif ($sym =~ /^pp_/) {
- print EM hide("$sym()", "Perl_$sym(aTHX)");
+ print $em hide("$sym()", "Perl_$sym(aTHX)");
}
else {
warn "Illegal symbol '$sym' in pp.sym";
}
}
-print EM <<'END';
+print $em <<'END';
#endif /* PERL_IMPLICIT_CONTEXT */
@@ -561,7 +557,7 @@
END
-print EM <<'END';
+print $em <<'END';
/* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
disable them.
@@ -641,14 +637,12 @@
/* ex: set ro: */
END
-close(EM) or die "Error closing EM: $!";
-safer_rename('embed.h-new', 'embed.h');
+close($em) or die "Error closing EM: $!";
+rename_if_different('embed.h-new', 'embed.h');
-open(EM, '> embedvar.h-new')
- or die "Can't create embedvar.h: $!\n";
-binmode EM;
+$em = safer_open('embedvar.h-new');
-print EM do_not_edit ("embedvar.h"), <<'END';
+print $em do_not_edit ("embedvar.h"), <<'END';
/* (Doing namespace management portably in C is really gross.) */
@@ -677,10 +671,10 @@
END
for $sym (sort keys %intrp) {
- print EM multon($sym,'I','vTHX->');
+ print $em multon($sym,'I','vTHX->');
}
-print EM <<'END';
+print $em <<'END';
#else /* !MULTIPLICITY */
@@ -689,14 +683,14 @@
END
for $sym (sort keys %intrp) {
- print EM multoff($sym,'I');
+ print $em multoff($sym,'I');
}
-print EM <<'END';
+print $em <<'END';
END
-print EM <<'END';
+print $em <<'END';
#endif /* MULTIPLICITY */
@@ -705,21 +699,21 @@
END
for $sym (sort keys %globvar) {
- print EM multon($sym, 'G','my_vars->');
- print EM multon("G$sym",'', 'my_vars->');
+ print $em multon($sym, 'G','my_vars->');
+ print $em multon("G$sym",'', 'my_vars->');
}
-print EM <<'END';
+print $em <<'END';
#else /* !PERL_GLOBAL_STRUCT */
END
for $sym (sort keys %globvar) {
- print EM multoff($sym,'G');
+ print $em multoff($sym,'G');
}
-print EM <<'END';
+print $em <<'END';
#endif /* PERL_GLOBAL_STRUCT */
@@ -728,25 +722,23 @@
END
for $sym (sort @extvars) {
- print EM hide($sym,"PL_$sym");
+ print $em hide($sym,"PL_$sym");
}
-print EM <<'END';
+print $em <<'END';
#endif /* PERL_POLLUTE */
/* ex: set ro: */
END
-close(EM) or die "Error closing EM: $!";
-safer_rename('embedvar.h-new', 'embedvar.h');
+close($em) or die "Error closing EM: $!";
+rename_if_different('embedvar.h-new', 'embedvar.h');
-open(CAPI, '> perlapi.c-new') or die "Can't create perlapi.c: $!\n";
-binmode CAPI;
-open(CAPIH, '> perlapi.h-new') or die "Can't create perlapi.h: $!\n";
-binmode CAPIH;
+my $capi = safer_open('perlapi.c-new');
+my $capih = safer_open('perlapi.h-new');
-print CAPIH do_not_edit ("perlapi.h"), <<'EOT';
+print $capih do_not_edit ("perlapi.h"), <<'EOT';
/* declare accessor functions for Perl variables */
#ifndef __perlapi_h__
@@ -851,14 +843,14 @@
EOT
foreach $sym (sort keys %intrp) {
- print CAPIH bincompat_var('I',$sym);
+ print $capih bincompat_var('I',$sym);
}
foreach $sym (sort keys %globvar) {
- print CAPIH bincompat_var('G',$sym);
+ print $capih bincompat_var('G',$sym);
}
-print CAPIH <<'EOT';
+print $capih <<'EOT';
#endif /* !PERL_CORE */
#endif /* MULTIPLICITY */
@@ -867,10 +859,10 @@
/* ex: set ro: */
EOT
-close CAPIH or die "Error closing CAPIH: $!";
-safer_rename('perlapi.h-new', 'perlapi.h');
+close $capih or die "Error closing CAPIH: $!";
+rename_if_different('perlapi.h-new', 'perlapi.h');
-print CAPI do_not_edit ("perlapi.c"), <<'EOT';
+print $capi do_not_edit ("perlapi.c"), <<'EOT';
#include "EXTERN.h"
#include "perl.h"
@@ -949,8 +941,8 @@
/* ex: set ro: */
EOT
-close(CAPI) or die "Error closing CAPI: $!";
-safer_rename('perlapi.c-new', 'perlapi.c');
+close($capi) or die "Error closing CAPI: $!";
+rename_if_different('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
==== //depot/perl/keywords.pl#35 (xtext) ====
Index: perl/keywords.pl
--- perl/keywords.pl#34~33537~ 2008-03-15 10:30:19.000000000 -0700
+++ perl/keywords.pl 2008-03-15 11:37:34.000000000 -0700
@@ -3,9 +3,8 @@
require 'regen_lib.pl';
-open(KW, ">keywords.h-new") || die "Can't create keywords.h: $!\n";
-binmode KW;
-select KW;
+my $kw = safer_open("keywords.h-new");
+select $kw;
print <<EOM;
/* -*- buffer-read-only: t -*-
@@ -35,11 +34,11 @@
print &tab(5, "#define KEY_$keyword"), $keynum++, "\n";
}
-print KW "\n/* ex: set ro: */\n";
+print $kw "\n/* ex: set ro: */\n";
-close KW or die "Error closing keywords.h: $!";
+close $kw or die "Error closing keywords.h-new: $!";
-safer_rename("keywords.h-new", "keywords.h");
+rename_if_different("keywords.h-new", "keywords.h");
###########################################################################
sub tab {
==== //depot/perl/opcode.pl#179 (xtext) ====
Index: perl/opcode.pl
--- perl/opcode.pl#178~33537~ 2008-03-15 10:30:19.000000000 -0700
+++ perl/opcode.pl 2008-03-15 11:37:34.000000000 -0700
@@ -8,11 +8,9 @@
my $opcode_new = 'opcode.h-new';
my $opname_new = 'opnames.h-new';
-open(OC, ">$opcode_new") || die "Can't create $opcode_new: $!\n";
-binmode OC;
-open(ON, ">$opname_new") || die "Can't create $opname_new: $!\n";
-binmode ON;
-select OC;
+my $oc = safer_open($opcode_new);
+my $on = safer_open($opname_new);
+select $oc;
# Read data.
@@ -128,7 +126,7 @@
END
-print ON <<"END";
+print $on <<"END";
/* -*- buffer-read-only: t -*-
*
* opnames.h
@@ -150,14 +148,14 @@
my $i = 0;
for (@ops) {
- # print ON "\t", &tab(3,"OP_\U$_,"), "/* ", $i++, " */\n";
- print ON "\t", &tab(3,"OP_\U$_"), " = ", $i++, ",\n";
+ # print $on "\t", &tab(3,"OP_\U$_,"), "/* ", $i++, " */\n";
+ print $on "\t", &tab(3,"OP_\U$_"), " = ", $i++, ",\n";
}
-print ON "\t", &tab(3,"OP_max"), "\n";
-print ON "} opcode;\n";
-print ON "\n#define MAXO ", scalar @ops, "\n";
-print ON "#define OP_phoney_INPUT_ONLY -1\n";
-print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n";
+print $on "\t", &tab(3,"OP_max"), "\n";
+print $on "} opcode;\n";
+print $on "\n#define MAXO ", scalar @ops, "\n";
+print $on "#define OP_phoney_INPUT_ONLY -1\n";
+print $on "#define OP_phoney_OUTPUT_ONLY -2\n\n";
# Emit op names and descriptions.
@@ -395,7 +393,7 @@
# Emit OP_IS_* macros
-print ON <<EO_OP_IS_COMMENT;
+print $on <<EO_OP_IS_COMMENT;
/* the OP_IS_(SOCKET|FILETEST) macros are optimized to a simple range
check because all the member OPs are contiguous in opcode.pl
@@ -419,42 +417,40 @@
my $last = pop @rest; # @rest slurped, get its last
die "Invalid range of ops: $first .. $last\n" unless $last;
- print ON "#define $macname(op) \\\n\t(";
+ print $on "#define $macname(op) \\\n\t(";
# verify that op-ct matches 1st..last range (and fencepost)
# (we know there are no dups)
if ( $op_is->{$last} - $op_is->{$first} == scalar @rest + 1) {
# contiguous ops -> optimized version
- print ON "(op) >= OP_" . uc($first) . " && (op) <= OP_" . uc($last);
- print ON ")\n\n";
+ print $on "(op) >= OP_" . uc($first) . " && (op) <= OP_" .
uc($last);
+ print $on ")\n\n";
}
else {
- print ON join(" || \\\n\t ",
+ print $on join(" || \\\n\t ",
map { "(op) == OP_" . uc() } sort keys %$op_is);
- print ON ")\n\n";
+ print $on ")\n\n";
}
}
}
-print OC "/* ex: set ro: */\n";
-print ON "/* ex: set ro: */\n";
+print $oc "/* ex: set ro: */\n";
+print $on "/* ex: set ro: */\n";
-close OC or die "Error closing opcode.h: $!\n";
-close ON or die "Error closing opnames.h: $!\n";
+close $oc or die "Error closing $opcode_new: $!\n";
+close $on or die "Error closing $opname_new: $!\n";
-safer_rename $opcode_new, 'opcode.h';
-safer_rename $opname_new, 'opnames.h';
+rename_if_different $opcode_new, 'opcode.h';
+rename_if_different $opname_new, 'opnames.h';
my $pp_proto_new = 'pp_proto.h-new';
my $pp_sym_new = 'pp.sym-new';
-open PP, ">$pp_proto_new" or die "Error creating $pp_proto_new: $!\n";
-binmode PP;
-open PPSYM, ">$pp_sym_new" or die "Error creating $pp_sym_new: $!\n";
-binmode PPSYM;
+my $pp = safer_open($pp_proto_new);
+my $ppsym = safer_open($pp_sym_new);
-print PP <<"END";
+print $pp <<"END";
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by opcode.pl from its data. Any changes made here
@@ -463,7 +459,7 @@
END
-print PPSYM <<"END";
+print $ppsym <<"END";
# -*- buffer-read-only: t -*-
#
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
@@ -475,27 +471,27 @@
for (sort keys %ckname) {
- print PP "PERL_CKDEF(Perl_$_)\n";
- print PPSYM "Perl_$_\n";
+ print $pp "PERL_CKDEF(Perl_$_)\n";
+ print $ppsym "Perl_$_\n";
#OP *\t", &tab(3,$_),"(OP* o);\n";
}
-print PP "\n\n";
+print $pp "\n\n";
for (@ops) {
next if /^i_(pre|post)(inc|dec)$/;
next if /^custom$/;
- print PP "PERL_PPDEF(Perl_pp_$_)\n";
- print PPSYM "Perl_pp_$_\n";
+ print $pp "PERL_PPDEF(Perl_pp_$_)\n";
+ print $ppsym "Perl_pp_$_\n";
}
-print PP "\n/* ex: set ro: */\n";
-print PPSYM "\n# ex: set ro:\n";
+print $pp "\n/* ex: set ro: */\n";
+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";
+close $pp or die "Error closing pp_proto.h-new: $!\n";
+close $ppsym or die "Error closing pp.sym-new: $!\n";
-safer_rename $pp_proto_new, 'pp_proto.h';
-safer_rename $pp_sym_new, 'pp.sym';
+rename_if_different $pp_proto_new, 'pp_proto.h';
+rename_if_different $pp_sym_new, 'pp.sym';
END {
foreach ('opcode.h', 'opnames.h', 'pp_proto.h', 'pp.sym') {
==== //depot/perl/reentr.pl#57 (text) ====
Index: perl/reentr.pl
--- perl/reentr.pl#56~33537~ 2008-03-15 10:30:19.000000000 -0700
+++ perl/reentr.pl 2008-03-15 11:37:34.000000000 -0700
@@ -41,9 +41,8 @@
# safer_unlink 'reentr.h';
-die "reentr.pl: $!" unless open(H, ">reentr.h-new");
-binmode H;
-select H;
+my $h = safer_open("reentr.h-new");
+select $h;
print <<EOF;
/* -*- buffer-read-only: t -*-
*
@@ -332,7 +331,7 @@
# Prepare to continue writing the reentr.h.
-select H;
+select $h;
{
# Write out all the known prototype signatures.
@@ -788,15 +787,14 @@
/* ex: set ro: */
EOF
-close(H);
-safer_rename('reentr.h-new', 'reentr.h');
+close($h);
+rename_if_different('reentr.h-new', 'reentr.h');
# Prepare to write the reentr.c.
# safer_unlink 'reentr.c';
-die "reentr.c: $!" unless open(C, ">reentr.c-new");
-binmode C;
-select C;
+my $c = safer_open("reentr.c-new");
+select $c;
print <<EOF;
/* -*- buffer-read-only: t -*-
*
@@ -1091,8 +1089,8 @@
/* ex: set ro: */
EOF
-close(C);
-safer_rename('reentr.c-new', 'reentr.c');
+close($c);
+rename_if_different('reentr.c-new', 'reentr.c');
__DATA__
asctime S |time |const struct tm|B_SB|B_SBI|I_SB|I_SBI
==== //depot/perl/regcomp.pl#23 (text) ====
Index: perl/regcomp.pl
--- perl/regcomp.pl#22~32762~ 2007-12-29 05:29:37.000000000 -0800
+++ perl/regcomp.pl 2008-03-15 11:37:34.000000000 -0700
@@ -68,11 +68,9 @@
unlink $tmp_h if -f $tmp_h;
-open OUT, ">$tmp_h";
-#*OUT=\*STDOUT;
-binmode OUT;
+my $out = safer_open($tmp_h);
-printf OUT <<EOP,
+printf $out <<EOP,
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by regcomp.pl from regcomp.sym.
@@ -92,16 +90,16 @@
for ($ind=1; $ind <= $lastregop ; $ind++) {
my $oind = $ind - 1;
- printf OUT "#define\t%*s\t%d\t/* %#04x %s */\n",
+ printf $out "#define\t%*s\t%d\t/* %#04x %s */\n",
-$width, $name[$ind], $ind-1, $ind-1, $rest[$ind];
}
-print OUT "\t/* ------------ States ------------- */\n";
+print $out "\t/* ------------ States ------------- */\n";
for ( ; $ind <= $tot ; $ind++) {
- printf OUT "#define\t%*s\t(REGNODE_MAX + %d)\t/* %s */\n",
+ printf $out "#define\t%*s\t(REGNODE_MAX + %d)\t/* %s */\n",
-$width, $name[$ind], $ind - $lastregop, $rest[$ind];
}
-print OUT <<EOP;
+print $out <<EOP;
/* PL_regkind[] What type of regop or state is this. */
@@ -113,13 +111,13 @@
$ind = 0;
while (++$ind <= $tot) {
- printf OUT "\t%*s\t/* %*s */\n",
+ printf $out "\t%*s\t/* %*s */\n",
-1-$twidth, "$type[$ind],", -$width, $name[$ind];
- print OUT "\t/* ------------ States ------------- */\n"
+ print $out "\t/* ------------ States ------------- */\n"
if $ind == $lastregop and $lastregop != $tot;
}
-print OUT <<EOP;
+print $out <<EOP;
};
#endif
@@ -134,11 +132,11 @@
my $size = 0;
$size = "EXTRA_SIZE(struct regnode_$args[$ind])" if $args[$ind];
- printf OUT "\t%*s\t/* %*s */\n",
+ printf $out "\t%*s\t/* %*s */\n",
-37, "$size,",-$rwidth,$name[$ind];
}
-print OUT <<EOP;
+print $out <<EOP;
};
/* reg_off_by_arg[] - Which argument holds the offset to the next node */
@@ -150,11 +148,11 @@
while (++$ind <= $lastregop) {
my $size = $longj[$ind] || 0;
- printf OUT "\t%d,\t/* %*s */\n",
+ printf $out "\t%d,\t/* %*s */\n",
$size, -$rwidth, $name[$ind]
}
-print OUT <<EOP;
+print $out <<EOP;
};
#endif /* REG_COMP_C */
@@ -173,17 +171,17 @@
while (++$ind <= $tot) {
my $size = $longj[$ind] || 0;
- printf OUT "\t%*s\t/* $sym%#04x */\n",
+ printf $out "\t%*s\t/* $sym%#04x */\n",
-3-$width,qq("$name[$ind]",), $ind - $ofs;
if ($ind == $lastregop and $lastregop != $tot) {
- print OUT "\t/* ------------ States ------------- */\n";
+ print $out "\t/* ------------ States ------------- */\n";
$ofs = $lastregop;
$sym = 'REGNODE_MAX +';
}
}
-print OUT <<EOP;
+print $out <<EOP;
};
#endif /* DOINIT */
@@ -211,20 +209,20 @@
}
}
my %vrxf=reverse %rxfv;
-printf OUT "\t/* Bits in extflags defined: %032b */\n",$val;
+printf $out "\t/* Bits in extflags defined: %032b */\n",$val;
for (0..31) {
my $n=$vrxf{2**$_}||"UNUSED_BIT_$_";
$n=~s/^RXf_(PMf_)?//;
- printf OUT qq(\t%-20s/* 0x%08x */\n),
+ printf $out qq(\t%-20s/* 0x%08x */\n),
qq("$n",),2**$_;
}
-print OUT <<EOP;
+print $out <<EOP;
};
#endif /* DOINIT */
/* ex: set ro: */
EOP
-close OUT or die "close $tmp_h: $!";
+close $out or die "close $tmp_h: $!";
-safer_rename $tmp_h, 'regnodes.h';
+rename_if_different $tmp_h, 'regnodes.h';
==== //depot/perl/regen_lib.pl#3 (text) ====
Index: perl/regen_lib.pl
--- perl/regen_lib.pl#2~33537~ 2008-03-15 10:30:19.000000000 -0700
+++ perl/regen_lib.pl 2008-03-15 11:37:34.000000000 -0700
@@ -2,6 +2,8 @@
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
+use File::Compare;
+use Symbol;
# Common functions needed by the regen scripts
@@ -15,24 +17,6 @@
$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;
@@ -56,18 +40,10 @@
rename $from, $to;
}
-sub safer_rename_always {
- my ($from, $to) = @_;
- safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
-}
-
-sub safer_rename {
+sub rename_if_different {
my ($from, $to) = @_;
- my $fc = cksum($from);
- my $tc = cksum($to);
-
- if ($fc and $fc eq $tc) {
+ if (compare($from, $to) == 0) {
warn "no changes between '$from' & '$to'\n";
safer_unlink($from);
return;
@@ -75,4 +51,14 @@
warn "changed '$from' to '$to'\n";
safer_rename_silent($from, $to) or die "renaming $from to $to: $!";
}
+
+# Saf*er*, but not totally safe. And assumes always open for output.
+sub safer_open {
+ my $name = shift;
+ my $fh = gensym;
+ open $fh, ">$name" or die "Can't create $name: $!";
+ binmode $fh;
+ $fh;
+}
+
1;
==== //depot/perl/warnings.pl#64 (text) ====
Index: perl/warnings.pl
--- perl/warnings.pl#63~33537~ 2008-03-15 10:30:19.000000000 -0700
+++ perl/warnings.pl 2008-03-15 11:37:34.000000000 -0700
@@ -250,12 +250,10 @@
exit ;
}
-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;
-binmode PM;
+my $warn = safer_open("warnings.h-new");
+my $pm = safer_open("lib/warnings.pm-new");
-print WARN <<'EOM' ;
+print $warn <<'EOM' ;
/* -*- buffer-read-only: t -*-
!!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by warnings.pl
@@ -307,19 +305,19 @@
my $last_ver = 0;
foreach $k (sort { $a <=> $b } keys %ValueToName) {
my ($name, $version) = @{ $ValueToName{$k} };
- print WARN "\n/* Warnings Categories added in Perl $version */\n\n"
+ print $warn "\n/* Warnings Categories added in Perl $version */\n\n"
if $last_ver != $version ;
- print WARN tab(5, "#define WARN_$name"), "$k\n" ;
+ print $warn tab(5, "#define WARN_$name"), "$k\n" ;
$last_ver = $version ;
}
-print WARN "\n" ;
+print $warn "\n" ;
-print WARN tab(5, '#define WARNsize'), "$warn_size\n" ;
+print $warn tab(5, '#define WARNsize'), "$warn_size\n" ;
#print WARN tab(5, '#define WARN_ALLstring'), '"', ('\377' x $warn_size) ,
"\"\n" ;
-print WARN tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) ,
"\"\n" ;
-print WARN tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) ,
"\"\n" ;
+print $warn tab(5, '#define WARN_ALLstring'), '"', ('\125' x $warn_size) ,
"\"\n" ;
+print $warn tab(5, '#define WARN_NONEstring'), '"', ('\0' x $warn_size) ,
"\"\n" ;
-print WARN <<'EOM';
+print $warn <<'EOM';
#define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD)
#define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD)
@@ -364,70 +362,70 @@
/* ex: set ro: */
EOM
-close WARN ;
-safer_rename("warnings.h-new", "warnings.h");
+close $warn;
+rename_if_different("warnings.h-new", "warnings.h");
while (<DATA>) {
last if /^KEYWORDS$/ ;
- print PM $_ ;
+ print $pm $_ ;
}
#$list{'all'} = [ $offset .. 8 * ($warn_size/2) - 1 ] ;
$last_ver = 0;
-print PM "our %Offsets = (\n" ;
+print $pm "our %Offsets = (\n" ;
foreach my $k (sort { $a <=> $b } keys %ValueToName) {
my ($name, $version) = @{ $ValueToName{$k} };
$name = lc $name;
$k *= 2 ;
if ( $last_ver != $version ) {
- print PM "\n";
- print PM tab(4, " # Warnings Categories added in Perl $version");
- print PM "\n\n";
+ print $pm "\n";
+ print $pm tab(4, " # Warnings Categories added in Perl $version");
+ print $pm "\n\n";
}
- print PM tab(4, " '$name'"), "=> $k,\n" ;
+ print $pm tab(4, " '$name'"), "=> $k,\n" ;
$last_ver = $version;
}
-print PM " );\n\n" ;
+print $pm " );\n\n" ;
-print PM "our %Bits = (\n" ;
+print $pm "our %Bits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
- print PM tab(4, " '$k'"), '=> "',
+ print $pm tab(4, " '$k'"), '=> "',
# mkHex($warn_size, @list),
mkHex($warn_size, map $_ * 2 , @list),
'", # [', mkRange(@list), "]\n" ;
}
-print PM " );\n\n" ;
+print $pm " );\n\n" ;
-print PM "our %DeadBits = (\n" ;
+print $pm "our %DeadBits = (\n" ;
foreach $k (sort keys %list) {
my $v = $list{$k} ;
my @list = sort { $a <=> $b } @$v ;
- print PM tab(4, " '$k'"), '=> "',
+ print $pm tab(4, " '$k'"), '=> "',
# mkHex($warn_size, @list),
mkHex($warn_size, map $_ * 2 + 1 , @list),
'", # [', mkRange(@list), "]\n" ;
}
-print PM " );\n\n" ;
-print PM '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
-print PM '$LAST_BIT = ' . "$index ;\n" ;
-print PM '$BYTES = ' . "$warn_size ;\n" ;
+print $pm " );\n\n" ;
+print $pm '$NONE = "', ('\0' x $warn_size) , "\";\n" ;
+print $pm '$LAST_BIT = ' . "$index ;\n" ;
+print $pm '$BYTES = ' . "$warn_size ;\n" ;
while (<DATA>) {
- print PM $_ ;
+ print $pm $_ ;
}
-print PM "# ex: set ro:\n";
-close PM ;
-safer_rename("lib/warnings.pm-new", "lib/warnings.pm");
+print $pm "# ex: set ro:\n";
+close $pm;
+rename_if_different("lib/warnings.pm-new", "lib/warnings.pm");
__END__
# -*- buffer-read-only: t -*-
End of Patch.
