Merge branch 'blead' of ssh://perl5.git.perl.org/perl into blead

[perl5.git] / regen / reentr.pl

diff --git a/regen/reentr.pl b/regen/reentr.pl
index 3586bc1..49d7efa 100644 (file)
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -50,16 +50,18 @@ my %map = (
 # Example #2: S_SBIE  means type func_r(type, char*, int, int*)
 # Example #3: S_CBI   means type func_r(const char*, char*, int)
 
+sub open_print_header {
+    my ($file, $quote) = @_;
+    return open_new($file, '>',
+                   { by => 'regen/reentr.pl',
+                     from => 'data in regen/reentr.pl',
+                     file => $file, style => '*',
+                     copyright => [2002, 2003, 2005 .. 2007],
+                     quote => $quote });
+}
 
-# safer_unlink 'reentr.h';
-my $h = safer_open("reentr.h-new");
-select $h;
-print read_only_top(lang => 'C', by => 'regen/reentr.pl',
-                   from => 'data in regen/reentr.pl',
-                   file => 'reentr.h', style => '*',
-                   copyright => [2002, 2003, 2005 .. 2007]);
-
-print <<EOF;
+my $h = open_print_header('reentr.h');
+print $h <<EOF;
 #ifndef REENTR_H
 #define REENTR_H
 
@@ -203,7 +205,6 @@ while (<DATA>) { # Read in the protypes.
     # If given the -U option open up the metaconfig unit for this function.
     if ($opts{U} && open(U, ">d_${func}_r.U"))  {
        binmode U;
-       select U;
     }
 
     if ($opts{U}) {
@@ -224,7 +225,7 @@ while (<DATA>) { # Read in the protypes.
            push @prereq, 'i_systime';
        }
        # Output the metaconfig unit header.
-       print <<EOF;
+       print U <<"EOF";
 ?RCS: \$Id: d_${func}_r.U,v $
 ?RCS:
 ?RCS: Copyright (c) 2002,2003 Jarkko Hietaniemi
@@ -269,7 +270,7 @@ eval \$inlibc
 case "\$d_${func}_r" in
 "\$define")
 EOF
-       print <<EOF;
+       print U <<"EOF";
        hdrs="$hdrs"
        case "\$d_${func}_r_proto:\$usethreads" in
        ":define")      d_${func}_r_proto=define
@@ -285,7 +286,7 @@ EOF
         my ($r, $a) = ($p =~ /^(.)_(.+)/);
        my $v = join(", ", map { $m{$_} } split '', $a);
        if ($opts{U}) {
-           print <<EOF ;
+           print U <<"EOF";
        case "\$${func}_r_proto" in
        ''|0) try='$m{$r} ${func}_r($v);'
        ./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;;
@@ -301,7 +302,7 @@ EOF
        $seenm{$func} = \%m;
     }
     if ($opts{U}) {
-       print <<EOF;
+       print U <<"EOF";
        case "\$${func}_r_proto" in
        ''|0)   d_${func}_r=undef
                ${func}_r_proto=0
@@ -332,15 +333,11 @@ EOF
 
 close DATA;
 
-# Prepare to continue writing the reentr.h.
-
-select $h;
-
 {
     # Write out all the known prototype signatures.
     my $i = 1;
     for my $p (sort keys %seenp) {
-       print "#define REENTRANT_PROTO_${p}     ${i}\n";
+       print $h "#define REENTRANT_PROTO_${p}  ${i}\n";
        $i++;
     }
 }
@@ -766,7 +763,7 @@ EOF
 
 local $" = '';
 
-print <<EOF;
+print $h <<EOF;
 
 /* Defines for indicating which special features are supported. */
 
@@ -783,26 +780,16 @@ typedef struct {
 #endif /* USE_REENTRANT_API */
  
 #endif
-
-/* ex: set ro: */
 EOF
 
-safer_close($h);
-rename_if_different('reentr.h-new', 'reentr.h');
+read_only_bottom_close_and_rename($h);
 
 # Prepare to write the reentr.c.
 
-# safer_unlink 'reentr.c';
-my $c = safer_open("reentr.c-new");
-select $c;
-my $top = read_only_top(lang => 'C', by => 'regen/reentr.pl',
-                       from => 'data in regen/reentr.pl',
-                       file => 'reentr.c', style => '*',
-                       copyright => [2002, 2003, 2005 .. 2007]);
-
-$top =~ s! \*/\n! *
+my $c = open_print_header('reentr.c', <<'EOQ');
+ *
  * "Saruman," I said, standing away from him, "only one hand at a time can
- *  wield the One, and you know that well, so do not trouble to say we\!"
+ *  wield the One, and you know that well, so do not trouble to say we!"
  *
  * This file contains a collection of automatically created wrappers
  * (created by running reentr.pl) for reentrant (thread-safe) versions of
@@ -811,9 +798,9 @@ $top =~ s! \*/\n! *
  * care about the differences between various platforms' idiosyncrasies
  * regarding these reentrant interfaces.  
  */
-!s;
+EOQ
 
-print $top, <<EOF;
+print $c <<"EOF";
 #include "EXTERN.h"
 #define PERL_IN_REENTR_C
 #include "perl.h"
@@ -1080,12 +1067,9 @@ Perl_reentrant_retry(const char *f, ...)
     va_end(ap);
     return retptr;
 }
-
-/* ex: set ro: */
 EOF
 
-safer_close($c);
-rename_if_different('reentr.c-new', 'reentr.c');
+read_only_bottom_close_and_rename($c);
 
 __DATA__
 asctime S      |time   |const struct tm|B_SB|B_SBI|I_SB|I_SBI