diff options
| -rwxr-xr-x | embed.pl | 94 | ||||
| -rwxr-xr-x | keywords.pl | 11 | ||||
| -rwxr-xr-x | opcode.pl | 80 | ||||
| -rw-r--r-- | reentr.pl | 20 | ||||
| -rw-r--r-- | regcomp.pl | 44 | ||||
| -rw-r--r-- | regen_lib.pl | 42 | ||||
| -rw-r--r-- | warnings.pl | 66 |
7 files changed, 162 insertions, 195 deletions
@@ -79,15 +79,12 @@ sub walk_table (&@) { 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 @@ sub walk_table (&@) { 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 @@ sub multoff ($$) { 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 @@ walk_table { # 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 @@ walk_table { # 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 @@ print EM <<'END'; END -print EM <<'END'; +print $em <<'END'; /* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to disable them. @@ -641,14 +637,12 @@ print EM <<'END'; /* 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 @@ print EM do_not_edit ("embedvar.h"), <<'END'; 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 @@ print EM <<'END'; 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 @@ print EM <<'END'; 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 @@ print EM <<'END'; 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 @@ END_EXTERN_C 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 @@ print CAPIH <<'EOT'; /* 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 @@ END_EXTERN_C /* 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 diff --git a/keywords.pl b/keywords.pl index 8e7a67804b..36035705c4 100755 --- a/keywords.pl +++ b/keywords.pl @@ -3,9 +3,8 @@ use strict; 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 @@ while (<DATA>) { 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 { @@ -8,11 +8,9 @@ BEGIN { 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 @@ PERL_PPDEF(Perl_unimplemented_op) END -print ON <<"END"; +print $on <<"END"; /* -*- buffer-read-only: t -*- * * opnames.h @@ -150,14 +148,14 @@ END 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 @@ END # 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 @@ sub gen_op_is_macro { 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 @@ print PP <<"END"; END -print PPSYM <<"END"; +print $ppsym <<"END"; # -*- buffer-read-only: t -*- # # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! @@ -475,27 +471,27 @@ END 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') { @@ -41,9 +41,8 @@ my %map = ( # 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 @@ close DATA; # Prepare to continue writing the reentr.h. -select H; +select $h; { # Write out all the known prototype signatures. @@ -788,15 +787,14 @@ typedef struct { /* 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 @@ Perl_reentrant_retry(const char *f, ...) /* 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 diff --git a/regcomp.pl b/regcomp.pl index defbb5f785..b6fc11dae1 100644 --- a/regcomp.pl +++ b/regcomp.pl @@ -68,11 +68,9 @@ my $tmp_h = 'tmp_reg.h'; 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 @@ EOP 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 @@ EOP $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 @@ while (++$ind <= $lastregop) { 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 @@ $ind = 0; 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 @@ my $sym = ""; 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 @@ while (<$fh>) { } } 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'; diff --git a/regen_lib.pl b/regen_lib.pl index 896a9ad0fe..824926554a 100644 --- a/regen_lib.pl +++ b/regen_lib.pl @@ -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 @@ 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; @@ -56,18 +40,10 @@ 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 { +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 @@ sub safer_rename { 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; diff --git a/warnings.pl b/warnings.pl index b639fc6cf4..669d13c6e6 100644 --- a/warnings.pl +++ b/warnings.pl @@ -250,12 +250,10 @@ if (@ARGV && $ARGV[0] eq "tree") 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 $k ; 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 @@ print WARN <<'EOM'; /* 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 -*- |