This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
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)
# 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
#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;
# 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}) {
}
if ($opts{U}) {
@@
-224,7
+225,7
@@
while (<DATA>) { # Read in the protypes.
push @prereq, 'i_systime';
}
# Output the metaconfig unit header.
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
?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
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
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}) {
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 ;;
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}) {
$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
case "\$${func}_r_proto" in
''|0) d_${func}_r=undef
${func}_r_proto=0
@@
-332,15
+333,11
@@
EOF
close DATA;
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) {
{
# 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++;
}
}
$i++;
}
}
@@
-766,7
+763,7
@@
EOF
local $" = '';
local $" = '';
-print <<EOF;
+print
$h
<<EOF;
/* Defines for indicating which special features are supported. */
/* Defines for indicating which special features are supported. */
@@
-783,26
+780,16
@@
typedef struct {
#endif /* USE_REENTRANT_API */
#endif
#endif /* USE_REENTRANT_API */
#endif
-
-/* ex: set ro: */
EOF
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.
# 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
* "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
*
* 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.
*/
* 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"
#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;
}
va_end(ap);
return retptr;
}
-
-/* ex: set ro: */
EOF
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
__DATA__
asctime S |time |const struct tm|B_SB|B_SBI|I_SB|I_SBI