From cc49830d6031e8e74c0426f77e2b3589e5774765 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sat, 14 May 2011 21:59:38 +0100 Subject: [PATCH] Add an optional third argument to open_new(), to invoke read_only_top() with. Merge together many calls to open_new() and read_only_top(). --- keywords.c | 2 +- keywords.h | 2 +- perly.act | 2 +- perly.h | 2 +- perly.tab | 2 +- regen/keywords.pl | 14 ++++++-------- regen/mk_PL_charclass.pl | 4 ++-- regen/opcode.pl | 25 ++++++++++++------------- regen/overload.pl | 23 +++++++++-------------- regen/reentr.pl | 10 +++++----- regen/regcomp.pl | 6 ++---- regen/regen_lib.pl | 6 ++++-- regen/warnings.pl | 8 ++++---- regen_perly.pl | 13 +++++-------- 14 files changed, 54 insertions(+), 65 deletions(-) diff --git a/keywords.c b/keywords.c index 077f7ce..7228d4b 100644 --- a/keywords.c +++ b/keywords.c @@ -3399,5 +3399,5 @@ unknown: } /* Generated from: - * 1591f96938e2a916423e17015c46f40221214a9ba8670000a2bf43578af159c2 regen/keywords.pl + * 71ce7e36f80b1103f4a197ed423fe2dbd92fd9f619e126bfcf9f0b0153586bab regen/keywords.pl * ex: set ro: */ diff --git a/keywords.h b/keywords.h index 5b412d6..1e2a036 100644 --- a/keywords.h +++ b/keywords.h @@ -268,5 +268,5 @@ #define KEY_y 252 /* Generated from: - * 1591f96938e2a916423e17015c46f40221214a9ba8670000a2bf43578af159c2 regen/keywords.pl + * 71ce7e36f80b1103f4a197ed423fe2dbd92fd9f619e126bfcf9f0b0153586bab regen/keywords.pl * ex: set ro: */ diff --git a/perly.act b/perly.act index 8de864a..d8a5424 100644 --- a/perly.act +++ b/perly.act @@ -1711,5 +1711,5 @@ case 2: /* Generated from: * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y - * 7fdc8be39a1ba22bcb9eb32a5e4e483f3b6abc1a1c95fea864ae5b7d46aa744b regen_perly.pl + * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 08d488f..701fd5c 100644 --- a/perly.h +++ b/perly.h @@ -241,5 +241,5 @@ typedef union YYSTYPE /* Generated from: * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y - * 7fdc8be39a1ba22bcb9eb32a5e4e483f3b6abc1a1c95fea864ae5b7d46aa744b regen_perly.pl + * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 38fec29..3920cd2 100644 --- a/perly.tab +++ b/perly.tab @@ -1075,5 +1075,5 @@ static const toketypes yy_type_tab[] = /* Generated from: * bd41fc813e5d2d23ff7edef2ab1ef88bbb054176476b7d989db7522dce1c9328 perly.y - * 7fdc8be39a1ba22bcb9eb32a5e4e483f3b6abc1a1c95fea864ae5b7d46aa744b regen_perly.pl + * 738ca60a0b4cb075902435e976a2f393d438e8e6e32ba81e037dd773b75c87b5 regen_perly.pl * ex: set ro: */ diff --git a/regen/keywords.pl b/regen/keywords.pl index 9d2f3ca..5f36956 100755 --- a/regen/keywords.pl +++ b/regen/keywords.pl @@ -13,14 +13,12 @@ use Devel::Tokenizer::C 0.05; require 'regen/regen_lib.pl'; -my $h = open_new('keywords.h'); -my $c = open_new('keywords.c'); - -print $h read_only_top(lang => 'C', by => 'regen/keywords.pl', - from => 'its data', file => 'keywords.h', style => '*', - copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]); -print $c read_only_top(lang => 'C', by => 'regen/keywords.pl', - from => 'its data', style => '*'); +my $h = open_new('keywords.h', '>', + { by => 'regen/keywords.pl', from => 'its data', + file => 'keywords.h', style => '*', + copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]}); +my $c = open_new('keywords.c', '>', + { by => 'regen/keywords.pl', from => 'its data', style => '*'}); my %by_strength; diff --git a/regen/mk_PL_charclass.pl b/regen/mk_PL_charclass.pl index 0d161f3..ecd5cd2 100644 --- a/regen/mk_PL_charclass.pl +++ b/regen/mk_PL_charclass.pl @@ -222,8 +222,8 @@ my @C1 = qw( APC ); -my $out_fh = open_new('l1_char_class_tab.h'); -print $out_fh read_only_top(lang => 'C', style => '*', by => $0, from => $file); +my $out_fh = open_new('l1_char_class_tab.h', '>', + {style => '*', by => $0, from => $file}); # Output the table using fairly short names for each char. for my $ord (0..255) { diff --git a/regen/opcode.pl b/regen/opcode.pl index c52506a..ed3875e 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -20,8 +20,14 @@ BEGIN { require 'regen/regen_lib.pl'; } -my $oc = open_new('opcode.h'); -my $on = open_new('opnames.h'); +my $oc = open_new('opcode.h', '>', + {by => 'regen/opcode.pl', from => 'its data', + file => 'opcode.h', style => '*', + copyright => [1993 .. 2007]}); + +my $on = open_new('opnames.h', '>', + { by => 'regen/opcode.pl', from => 'its data', style => '*', + file => 'opnames.h', copyright => [1999 .. 2008] }); # Read data. @@ -138,10 +144,7 @@ foreach my $sock_func (qw(socket bind listen accept shutdown # Emit defines. -print $oc read_only_top(lang => 'C', by => 'regen/opcode.pl', from => 'its data', - file => 'opcode.h', style => '*', - copyright => [1993 .. 2007]), - "#ifndef PERL_GLOBAL_STRUCT_INIT\n\n"; +print $oc "#ifndef PERL_GLOBAL_STRUCT_INIT\n\n"; { my $last_cond = ''; @@ -178,10 +181,7 @@ print $oc read_only_top(lang => 'C', by => 'regen/opcode.pl', from => 'its data' unimplemented(); } -print $on read_only_top(lang => 'C', by => 'regen/opcode.pl', - from => 'its data', style => '*', - file => 'opnames.h', copyright => [1999 .. 2008]), - "typedef enum opcode {\n"; +print $on "typedef enum opcode {\n"; my $i = 0; for (@ops) { @@ -441,9 +441,8 @@ sub gen_op_is_macro { } } -my $pp = open_new('pp_proto.h'); - -print $pp read_only_top(lang => 'C', by => 'opcode.pl', from => 'its data'); +my $pp = open_new('pp_proto.h', '>', + { by => 'opcode.pl', from => 'its data' }); { my %funcs; diff --git a/regen/overload.pl b/regen/overload.pl index 5ddce69..652b2b7 100644 --- a/regen/overload.pl +++ b/regen/overload.pl @@ -30,13 +30,16 @@ while () { push @names, $name; } -my $c = open_new('overload.c'); -my $h = open_new('overload.h'); -mkdir("lib/overload", 0777) unless -d 'lib/overload'; -my $p = open_new('lib/overload/numbers.pm'); +my ($c, $h) = map { + open_new($_, '>', + { by => 'regen/overload.pl', file => $_, style => '*', + copyright => [1997, 1998, 2000, 2001, 2005 .. 2007, 2011] }); +} 'overload.c', 'overload.h'; -print $p read_only_top(lang => 'Perl', by => 'regen/overload.pl', - file => 'lib/overload/numbers.pm', copyright => [2008]); +mkdir("lib/overload", 0777) unless -d 'lib/overload'; +my $p = open_new('lib/overload/numbers.pm', '>', + { by => 'regen/overload.pl', + file => 'lib/overload/numbers.pm', copyright => [2008] }); { local $" = "\n "; @@ -57,14 +60,6 @@ our \@enums = qw# EOF } -for ([$c, 'overload.c'], [$h, 'overload.h']) { - my ($handle, $file) = @$_; - print $handle read_only_top(lang => 'C', by => 'regen/overload.pl', - file => $file, style => '*', - copyright => [1997, 1998, 2000, 2001, - 2005 .. 2007, 2011]); -} - print $h "enum {\n"; for (0..$#enums) { diff --git a/regen/reentr.pl b/regen/reentr.pl index 39e2452..dabbe34 100644 --- a/regen/reentr.pl +++ b/regen/reentr.pl @@ -51,11 +51,11 @@ my %map = ( # Example #3: S_CBI means type func_r(const char*, char*, int) -my $h = open_new('reentr.h'); -print $h read_only_top(lang => 'C', by => 'regen/reentr.pl', - from => 'data in regen/reentr.pl', - file => 'reentr.h', style => '*', - copyright => [2002, 2003, 2005 .. 2007]); +my $h = open_new('reentr.h', '>', + { by => 'regen/reentr.pl', + from => 'data in regen/reentr.pl', + file => 'reentr.h', style => '*', + copyright => [2002, 2003, 2005 .. 2007]}); print $h < 'C', by => 'regen/regcomp.pl', - from => 'regcomp.sym'); +my $out = open_new('regnodes.h', '>', + { by => 'regen/regcomp.pl', from => 'regcomp.sym' }); printf $out <') { if (-f $name) { @@ -49,8 +50,9 @@ sub open_new { } *{$fh}->{name} = $name; *{$fh}->{final_name} = $final_name; - *{$fh}->{lang} = ($final_name =~ /\.(?:c|h|tab|act)$/ ? 'C' : 'Perl'); + *{$fh}->{lang} = $lang; binmode $fh; + print $fh read_only_top(lang => $lang, %$header) if $header; $fh; } diff --git a/regen/warnings.pl b/regen/warnings.pl index e6cd8be..3d65d87 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -260,11 +260,11 @@ if (@ARGV && $ARGV[0] eq "tree") exit ; } -my $warn = open_new('warnings.h'); -my $pm = open_new('lib/warnings.pm'); +my ($warn, $pm) = map { + open_new($_, '>', { by => 'regen/warnings.pl' }); +} 'warnings.h', 'lib/warnings.pm'; -print $pm read_only_top(lang => 'Perl', by => 'regen/warnings.pl'); -print $warn read_only_top(lang => 'C', by => 'regen/warnings.pl'), <<'EOM'; +print $warn <<'EOM'; #define Off(x) ((x) / 8) #define Bit(x) (1 << ((x) % 8)) diff --git a/regen_perly.pl b/regen_perly.pl index 668f164..a96a918 100644 --- a/regen_perly.pl +++ b/regen_perly.pl @@ -97,13 +97,13 @@ my ($actlines, $tablines) = extract($clines); $tablines .= make_type_tab($y_file, $tablines); -my $read_only = read_only_top(lang => 'C', by => $0, from => $y_file); +my ($act_fh, $tab_fh, $h_fh) = map { + open_new($_, '>', { by => $0, from => $y_file }); +} $act_file, $tab_file, $h_file; -my $act_fh = open_new($act_file); -print $act_fh $read_only, $actlines; +print $act_fh $actlines; -my $tab_fh = open_new($tab_file); -print $tab_fh $read_only, $tablines; +print $tab_fh $tablines; unlink $tmpc_file; @@ -112,9 +112,6 @@ unlink $tmpc_file; # C<#line 188 "perlytmp.h"> gets picked up by make depend, so remove them. open my $tmph_fh, '<', $tmph_file or die "Can't open $tmph_file: $!\n"; -my $h_fh = open_new($h_file); - -print $h_fh $read_only; my $endcore_done = 0; # Token macros need to be generated manually on bison 2.4 -- 2.7.4