This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a 'quote' argument to read_only_top(), to pass in an optional Tolkien.
authorNicholas Clark <nick@ccl4.org>
Sat, 14 May 2011 21:13:56 +0000 (22:13 +0100)
committerNicholas Clark <nick@ccl4.org>
Thu, 19 May 2011 09:18:16 +0000 (10:18 +0100)
Use this in embed.pl for perlapi.c, and reentr.pl for reentr.c.

regen/embed.pl
regen/reentr.pl
regen/regen_lib.pl

index c28a0c3..0cb40ed 100755 (executable)
@@ -40,16 +40,16 @@ my $unflagged_pointers;
 # implicit interpreter context argument.
 #
 
-sub do_not_edit ($)
+sub do_not_edit
 {
-    my $file = shift;
+    my ($file, $quote) = @_;
 
     return read_only_top(lang => ($file =~ /\.[ch]$/ ? 'C' : 'Perl'),
                         file => $file, style => '*', by => 'regen/embed.pl',
                         from => ['data in embed.fnc', 'regen/embed.pl',
                                  'regen/opcodes', 'intrpvar.h', 'perlvars.h'],
                         final => "\nEdit those files and run 'make regen_headers' to effect changes.\n",
-                        copyright => [1993 .. 2009]);
+                        copyright => [1993 .. 2009], quote => $quote);
 } # do_not_edit
 
 open IN, "embed.fnc" or die $!;
@@ -763,8 +763,8 @@ EOT
 
 read_only_bottom_close_and_rename($capih);
 
-my $warning = do_not_edit ("perlapi.c");
-$warning =~ s! \*/\n! *
+my $warning = do_not_edit ("perlapi.c", <<'EOQ');
+ *
  *
  * Up to the threshold of the door there mounted a flight of twenty-seven
  * broad stairs, hewn by some unknown art of the same black stone.  This
@@ -773,7 +773,7 @@ $warning =~ s! \*/\n! *
  *     [p.577 of _The Lord of the Rings_, III/x: "The Voice of Saruman"]
  *
  */
-!;
+EOQ
 
 print $capi $warning, <<'EOT';
 #include "EXTERN.h"
index dabbe34..4eedee2 100644 (file)
@@ -782,15 +782,14 @@ read_only_bottom_close_and_rename($h);
 
 # Prepare to write the reentr.c.
 
-my $c = open_new('reentr.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_new('reentr.c', '>',
+                {by => 'regen/reentr.pl', from => 'data in regen/reentr.pl',
+                 file => 'reentr.c', style => '*',
+                 copyright => [2002, 2003, 2005 .. 2007],
+                 quote => <<'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
@@ -799,9 +798,9 @@ $top =~ s! \*/\n! *
  * care about the differences between various platforms' idiosyncrasies
  * regarding these reentrant interfaces.  
  */
-!s;
+EOQ
 
-print $c $top, <<"EOF";
+print $c <<"EOF";
 #include "EXTERN.h"
 #define PERL_IN_REENTR_C
 #include "perl.h"
index 4715236..dcee0a6 100644 (file)
@@ -129,6 +129,7 @@ EOM
        ? wrap('# ', '# ', $raw) . "\n" : wrap('/* ', $style, $raw) . " */\n\n";
     $cooked =~ tr/\0/ /; # Don't break Larry's name etc
     $cooked =~ s/ +$//mg; # Remove all trailing spaces
+    $cooked =~ s! \*/\n!$args{quote}!s if $args{quote};
     return $cooked;
 }