Change close_and_rename() to read_only_bottom_close_and_rename()
authorNicholas Clark <nick@ccl4.org>
Sun, 23 Jan 2011 10:38:58 +0000 (10:38 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 23 Jan 2011 10:41:25 +0000 (10:41 +0000)
All users of close_and_rename() were printing out the appropriate "ex: set ro:"
string to the file handle immediately before closing it. So move that into
the common function and rename it to reflect what it now does. [Except
overload.pl, which should have been, given that it calls read_only_top()]

Print a newline above the "ex: set ro:" line. This removes many newlines from
the regen scripts, but does add newlines to a couple of generated files.

15 files changed:
global.sym
lib/overload/numbers.pm
lib/warnings.pm
overload.c
overload.h
proto.h
regen/embed.pl
regen/keywords.pl
regen/opcode.pl
regen/overload.pl
regen/reentr.pl
regen/regcomp.pl
regen/regen_lib.pl
regen/warnings.pl
warnings.h

index c84a840..01e79a4 100644 (file)
@@ -884,4 +884,5 @@ Perl_reentrant_size
 Perl_do_aspawn
 Perl_do_spawn
 Perl_do_spawn_nowait
+
 # ex: set ro:
index 6856b0a..f56fa63 100644 (file)
@@ -161,3 +161,4 @@ our @enums = qw#
 
 { my $i = 0; our %enums = map { $_ => $i++ } @enums }
 
+# ex: set ro:
index b0905cd..8cd24d4 100644 (file)
@@ -551,4 +551,5 @@ sub warnif
 delete $warnings::{$_} foreach qw(NORMAL FATAL MESSAGE);
 
 1;
+
 # ex: set ro:
index 0d5b74b..91e2d20 100644 (file)
@@ -164,3 +164,5 @@ static const char * const PL_AMG_names[NofAMmeth] = {
     "(qr",             /* regexp     */
     "DESTROY"
 };
+
+/* ex: set ro: */
index b68cee7..24cde2a 100644 (file)
@@ -89,3 +89,4 @@ enum {
 
 #define NofAMmeth max_amg_code
 
+/* ex: set ro: */
diff --git a/proto.h b/proto.h
index c7cacf6..4eabf66 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -7093,4 +7093,5 @@ PERL_CALLCONV int Perl_do_spawn_nowait(pTHX_ char* cmd)
 #  include "pp_proto.h"
 #endif
 END_EXTERN_C
+
 /* ex: set ro: */
index b53a69a..b7d7849 100755 (executable)
@@ -181,7 +181,7 @@ my (@core, @ext, @api);
 # walk table providing an array of components in each line to
 # subroutine, printing the result
 sub walk_table (&@) {
-    my ($function, $filename, $trailer) = @_;
+    my ($function, $filename) = @_;
     my $F;
     if (ref $filename) {       # filehandle
        $F = $filename;
@@ -195,9 +195,8 @@ sub walk_table (&@) {
        # $function->(@args) is not 5.003
        print $F @outs;
     }
-    print $F $trailer if $trailer;
     unless (ref $filename) {
-       close_and_rename($F);
+       read_only_bottom_close_and_rename($F);
     }
 }
 
@@ -333,10 +332,9 @@ sub walk_table (&@) {
 #  include "pp_proto.h"
 #endif
 END_EXTERN_C
-/* ex: set ro: */
 EOF
 
-    close_and_rename($pr);
+    read_only_bottom_close_and_rename($pr);
 }
 
 # generates global.sym (API export list)
@@ -359,7 +357,7 @@ EOF
 }
 
 warn "$unflagged_pointers pointer arguments to clean up\n" if $unflagged_pointers;
-walk_table(\&write_global_sym, "global.sym", "# ex: set ro:\n");
+walk_table(\&write_global_sym, "global.sym");
 
 sub readvars(\%$$@) {
     my ($syms, $file,$pre,$keep_pre) = @_;
@@ -570,11 +568,9 @@ foreach (sort keys %has_va) {
 
 print $em <<'END';
 #endif
-
-/* ex: set ro: */
 END
 
-close_and_rename($em);
+read_only_bottom_close_and_rename($em);
 
 $em = safer_open('embedvar.h-new', 'embedvar.h');
 
@@ -651,11 +647,9 @@ for $sym (sort keys %globvar) {
 print $em <<'END';
 
 #endif /* PERL_GLOBAL_STRUCT */
-
-/* ex: set ro: */
 END
 
-close_and_rename($em);
+read_only_bottom_close_and_rename($em);
 
 my $capi = safer_open('perlapi.c-new', 'perlapi.c');
 my $capih = safer_open('perlapi.h-new', 'perlapi.h');
@@ -762,10 +756,9 @@ print $capih <<'EOT';
 #endif /* MULTIPLICITY && PERL_GLOBAL_STRUCT */
 
 #endif /* __perlapi_h__ */
-
-/* ex: set ro: */
 EOT
-close_and_rename($capih);
+
+read_only_bottom_close_and_rename($capih);
 
 my $warning = do_not_edit ("perlapi.c");
 $warning =~ s! \*/\n! *
@@ -816,10 +809,8 @@ START_EXTERN_C
 END_EXTERN_C
 
 #endif /* MULTIPLICITY && PERL_GLOBAL_STRUCT */
-
-/* ex: set ro: */
 EOT
 
-close_and_rename($capi);
+read_only_bottom_close_and_rename($capi);
 
 # ex: set ts=8 sts=4 sw=4 noet:
index 185d433..452bfc9 100755 (executable)
@@ -32,9 +32,7 @@ while (<DATA>) {
     print &tab(5, "#define KEY_$keyword"), $keynum++, "\n";
 }
 
-print $kw "\n/* ex: set ro: */\n";
-
-close_and_rename($kw);
+read_only_bottom_close_and_rename($kw);
 
 ###########################################################################
 sub tab {
index 676583d..afb25e9 100755 (executable)
@@ -408,7 +408,6 @@ print <<END;
 #endif /* !PERL_GLOBAL_STRUCT_INIT */
 
 END_EXTERN_C
-
 END
 
 # Emit OP_IS_* macros
@@ -418,7 +417,6 @@ 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
     <OPS> table.  opcode.pl verifies the range contiguity.  */
-
 EO_OP_IS_COMMENT
 
 gen_op_is_macro( \%OP_IS_SOCKET, 'OP_IS_SOCKET');
@@ -437,7 +435,7 @@ 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 "\n#define $macname(op)       \\\n\t(";
 
        # verify that op-ct matches 1st..last range (and fencepost)
        # (we know there are no dups)
@@ -445,21 +443,16 @@ sub gen_op_is_macro {
            
            # contiguous ops -> optimized version
            print $on "(op) >= OP_" . uc($first) . " && (op) <= OP_" . uc($last);
-           print $on ")\n\n";
+           print $on ")\n";
        }
        else {
            print $on join(" || \\\n\t ",
                          map { "(op) == OP_" . uc() } sort keys %$op_is);
-           print $on ")\n\n";
+           print $on ")\n";
        }
     }
 }
 
-foreach ($oc, $on) {
-    print $_ "/* ex: set ro: */\n";
-    close_and_rename($_);
-}
-
 my $pp = safer_open('pp_proto.h-new', 'pp_proto.h');
 
 print $pp read_only_top(lang => 'C', by => 'opcode.pl', from => 'its data');
@@ -472,9 +465,9 @@ print $pp read_only_top(lang => 'C', by => 'opcode.pl', from => 'its data');
     }
     print $pp "PERL_CALLCONV OP *$_(pTHX);\n" foreach sort keys %funcs;
 }
-print $pp "\n/* ex: set ro: */\n";
-
-close_and_rename($pp);
+foreach ($oc, $on, $pp) {
+    read_only_bottom_close_and_rename($_);
+}
 
 ###########################################################################
 sub tab {
index 7ff3f12..fa22bd5 100644 (file)
@@ -57,7 +57,6 @@ our \@enums = qw#
 { my \$i = 0; our %names = map { \$_ => \$i++ } \@names }
 
 { my \$i = 0; our %enums = map { \$_ => \$i++ } \@enums }
-
 EOF
 }
 
@@ -89,7 +88,6 @@ print <<'EOF';
 };
 
 #define NofAMmeth max_amg_code
-
 EOF
 
 print $c <<'EOF';
@@ -129,10 +127,9 @@ print $c <<"EOT";
 };
 EOT
 
-close_and_rename($h);
-close_and_rename($c);
-close_and_rename($p);
-
+foreach ($h, $c, $p) {
+    read_only_bottom_close_and_rename($_);
+}
 __DATA__
 # Fallback should be the first
 fallback       ()
index 0045b18..6c7b5e6 100644 (file)
@@ -782,11 +782,9 @@ typedef struct {
 #endif /* USE_REENTRANT_API */
  
 #endif
-
-/* ex: set ro: */
 EOF
 
-close_and_rename($h);
+read_only_bottom_close_and_rename($h);
 
 # Prepare to write the reentr.c.
 
@@ -1077,11 +1075,9 @@ Perl_reentrant_retry(const char *f, ...)
     va_end(ap);
     return retptr;
 }
-
-/* ex: set ro: */
 EOF
 
-close_and_rename($c);
+read_only_bottom_close_and_rename($c);
 
 __DATA__
 asctime S      |time   |const struct tm|B_SB|B_SBI|I_SB|I_SBI
index ccb8feb..63e070a 100644 (file)
@@ -122,7 +122,6 @@ EXTCONST U8 PL_${varname}_bitmask[] = {
     $out_mask
 };
 #endif /* DOINIT */
-
 EOP
 }
 
@@ -321,11 +320,9 @@ print $out process_flags('V', 'varies', <<'EOC');
 EOC
 
 print $out process_flags('S', 'simple', <<'EOC');
+
 /* The following always have a length of 1. U8 we can do strchr() on it. */
 /* (Note that length 1 means "one character" under UTF8, not "one octet".) */
 EOC
 
-print $out <<EOP;
-/* ex: set ro: */
-EOP
-close_and_rename($out);
+read_only_bottom_close_and_rename($out);
index d8cbd12..90f10b5 100644 (file)
@@ -69,7 +69,10 @@ sub safer_open {
     my $fh = gensym;
     open $fh, ">$name" or die "Can't create $name: $!";
     *{$fh}->{name} = $name;
-    *{$fh}->{final_name} = $final_name if defined $final_name;
+    if (defined $final_name) {
+       *{$fh}->{final_name} = $final_name;
+       *{$fh}->{lang} = ($final_name =~ /\.[ch]$/ ? 'C' : 'Perl');
+    }
     binmode $fh;
     $fh;
 }
@@ -129,11 +132,14 @@ EOM
     return $cooked;
 }
 
-sub close_and_rename {
+sub read_only_bottom_close_and_rename {
     my $fh = shift;
     my $name = *{$fh}->{name};
+    my $lang = *{$fh}->{lang};
     die "No final name specified at open time for $name"
        unless *{$fh}->{final_name};
+    print $fh $lang eq 'Perl'
+       ? "\n# ex: set ro:\n" : "\n/* ex: set ro: */\n";
     safer_close($fh);
     rename_if_different($name, *{$fh}->{final_name});
 }
index 6eee635..2b0ddcc 100644 (file)
@@ -366,10 +366,9 @@ print $warn <<'EOM';
              isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
 
 /* end of file warnings.h */
-/* ex: set ro: */
 EOM
 
-close_and_rename($warn);
+read_only_bottom_close_and_rename($warn);
 
 while (<DATA>) {
     last if /^KEYWORDS$/ ;
@@ -425,8 +424,7 @@ while (<DATA>) {
     print $pm $_ ;
 }
 
-print $pm "# ex: set ro:\n";
-close_and_rename($pm);
+read_only_bottom_close_and_rename($pm);
 
 __END__
 package warnings;
index bf82366..d8793d1 100644 (file)
              isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))
 
 /* end of file warnings.h */
+
 /* ex: set ro: */