diff options
author | Nicholas Clark <nick@ccl4.org> | 2011-01-24 11:06:50 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2011-01-24 11:13:21 +0000 |
commit | f133ac5ddfc5d70fa61dd22a319c90b6c5016bc0 (patch) | |
tree | 084781d3bbe1ee1ec6177e934eaea361b6bf103d | |
parent | 26ea9e123d12cb8db56e9e161eaec98bd295b821 (diff) | |
download | perl-f133ac5ddfc5d70fa61dd22a319c90b6c5016bc0.tar.gz |
Merge perl_keyword.pl into regen/keywords.pl, to generate keywords.[ch]
Prepend + or - in front of all the keyword names in __DATA__ to mark weak and
strong keywords, needed for keyword.c
As keywords.c needs Devel::Tokenizer::C 0.05, not a core module (and not a
common module either) we can no longer run it as part of regen.pl. So store
the sha256 of the source in the generated files, and use this in to check that
they are not stale (in t/porting/regen.t)
-rw-r--r-- | Cross/Makefile-cross-SH | 3 | ||||
-rw-r--r-- | MANIFEST | 3 | ||||
-rwxr-xr-x | Makefile.SH | 3 | ||||
-rw-r--r-- | keywords.c | 14 | ||||
-rw-r--r-- | keywords.h | 4 | ||||
-rw-r--r-- | perl_keyword.pl | 105 | ||||
-rw-r--r-- | regen.pl | 1 | ||||
-rwxr-xr-x | regen/keywords.pl | 598 | ||||
-rw-r--r-- | t/porting/regen.t | 4 | ||||
-rw-r--r-- | vms/descrip_mms.template | 1 |
10 files changed, 351 insertions, 385 deletions
diff --git a/Cross/Makefile-cross-SH b/Cross/Makefile-cross-SH index cc17671283..2ea58f5a9d 100644 --- a/Cross/Makefile-cross-SH +++ b/Cross/Makefile-cross-SH @@ -846,7 +846,6 @@ CHMOD_W = chmod +w # The following files are generated automatically # embed.pl: proto.h embed.h embedvar.h global.sym # perlapi.h perlapi.c -# keywords.pl: keywords.h # opcode.pl: opcode.h opnames.h pp_proto.h # regcomp.pl: regnodes.h # warnings.pl: warnings.h lib/warnings.pm @@ -857,7 +856,7 @@ CHMOD_W = chmod +w # with your existing copy of perl # (make regen_headers is kept for backwards compatibility) -AUTOGEN_FILES = keywords.h opcode.h opnames.h pp_proto.h proto.h \ +AUTOGEN_FILES = opcode.h opnames.h pp_proto.h proto.h \ embed.h embedvar.h global.sym \ perlapi.h perlapi.c regnodes.h \ warnings.h lib/warnings.pm @@ -3765,7 +3765,7 @@ installperl Perl script to do "make install" dirty work INTERN.h Included before domestic .h files intrpvar.h Variables held in each interpreter instance iperlsys.h Perl's interface to the system -keywords.c Perl_keyword(), generated by perl_keyword.pl +keywords.c Perl_keyword(), generated by regen/keywords.pl keywords.h The keyword numbers l1_char_class_tab.h 256 word bit table of character classes (for handy.h) lib/abbrev.pl An abbreviation table builder @@ -4207,7 +4207,6 @@ perlio.c C code for PerlIO abstraction perlio.h PerlIO abstraction perliol.h PerlIO Layer definition perlio.sym Symbols for PerlIO abstraction -perl_keyword.pl A script to generate Perl_keyword() in toke.c perlsdio.h Fake stdio using perlio perlsfio.h Prototype sfio mapping for PerlIO perlsh A poor man's perl shell diff --git a/Makefile.SH b/Makefile.SH index 28c539de80..c8ad2a8f52 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -1117,7 +1117,6 @@ CHMOD_W = chmod +w # The following files are generated automatically # embed.pl: proto.h embed.h embedvar.h global.sym # perlapi.h perlapi.c -# keywords.pl: keywords.h # opcode.pl: opcode.h opnames.h pp_proto.h # regcomp.pl: regnodes.h # warnings.pl: warnings.h lib/warnings.pm @@ -1128,7 +1127,7 @@ CHMOD_W = chmod +w # with your existing copy of perl # (make regen_headers is kept for backwards compatibility) -AUTOGEN_FILES = keywords.h opcode.h opnames.h pp_proto.h proto.h \ +AUTOGEN_FILES = opcode.h opnames.h pp_proto.h proto.h \ embed.h embedvar.h global.sym \ perlapi.h perlapi.c regnodes.h \ warnings.h lib/warnings.pm diff --git a/keywords.c b/keywords.c index 199eaedf68..61bfc69e76 100644 --- a/keywords.c +++ b/keywords.c @@ -1,5 +1,7 @@ -/* - * The following code was generated by perl_keyword.pl. +/* -*- buffer-read-only: t -*- + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by regen/keywords.pl from its data. + * Any changes made here will be lost! */ #include "EXTERN.h" @@ -10,9 +12,9 @@ I32 Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) { - dVAR; + dVAR; - PERL_ARGS_ASSERT_KEYWORD; + PERL_ARGS_ASSERT_KEYWORD; switch (len) { @@ -3395,3 +3397,7 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) unknown: return 0; } + +/* Generated from: + * 28d95638560707fb8bee100dab74c90107c3e000f635e3bd310d4e2501d3b073 regen/keywords.pl + * ex: set ro: */ diff --git a/keywords.h b/keywords.h index 7915fc7f5e..b821121780 100644 --- a/keywords.h +++ b/keywords.h @@ -267,4 +267,6 @@ #define KEY_xor 251 #define KEY_y 252 -/* ex: set ro: */ +/* Generated from: + * 28d95638560707fb8bee100dab74c90107c3e000f635e3bd310d4e2501d3b073 regen/keywords.pl + * ex: set ro: */ diff --git a/perl_keyword.pl b/perl_keyword.pl deleted file mode 100644 index 7eecff60bb..0000000000 --- a/perl_keyword.pl +++ /dev/null @@ -1,105 +0,0 @@ - -# How to generate the logic of the lookup table Perl_keyword() in toke.c - -use Devel::Tokenizer::C 0.05; -use strict; -use warnings; - -my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY default defined - delete do END else eval elsif exists for format foreach given grep - goto glob INIT if last local m my map next no our pos print printf - package prototype q qr qq qw qx redo return require s say scalar sort - split state study sub tr use undef UNITCHECK until - unless when while y); - -my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless - break bind binmode CORE cmp chr cos chop close chdir chomp chmod - chown crypt chroot caller connect closedir continue die dump - dbmopen dbmclose eq eof exp exit exec each endgrent endpwent - endnetent endhostent endservent endprotoent fork fcntl flock fileno - formline getppid getpgrp getpwent getpwnam getpwuid getpeername - getprotoent getpriority getprotobyname getprotobynumber - gethostbyname gethostbyaddr gethostent getnetbyname getnetbyaddr - getnetent getservbyname getservbyport getservent getsockname - getsockopt getgrent getgrnam getgrgid getlogin getc gt ge gmtime - hex int index ioctl join keys kill lt le lc log link lock lstat - length listen lcfirst localtime mkdir msgctl msgget msgrcv msgsnd - ne not or ord oct open opendir pop push pack pipe quotemeta ref - read rand recv rmdir reset rename rindex reverse readdir readlink - readline readpipe rewinddir seek send semop select semctl semget - setpgrp seekdir setpwent setgrent setnetent setsockopt sethostent - setservent setpriority setprotoent shift shmctl shmget shmread - shmwrite shutdown sin sleep socket socketpair sprintf splice sqrt - srand stat substr system symlink syscall sysopen sysread sysseek - syswrite tell tie tied time times telldir truncate uc utime - umask unpack unlink unshift untie ucfirst values vec warn wait - write waitpid wantarray - x xor); - -my %feature_kw = ( - given => 'switch', - when => 'switch', - default => 'switch', - # continue is already a keyword - break => 'switch', - - say => 'say', - - state => 'state', - ); - -my %pos = map { ($_ => 1) } @pos; - -my $t = Devel::Tokenizer::C->new( TokenFunc => \&perl_keyword - , TokenString => 'name' - , StringLength => 'len' - , MergeSwitches => 1 - ); - -$t->add_tokens(@pos, @neg, 'elseif'); - -my $switch = $t->generate(Indent => ' '); - -print <<END; -/* - * The following code was generated by $0. - */ - -#include "EXTERN.h" -#define PERL_IN_KEYWORDS_C -#include "perl.h" -#include "keywords.h" - -I32 -Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) -{ - dVAR; - - PERL_ARGS_ASSERT_KEYWORD; - -$switch -unknown: - return 0; -} -END - -sub perl_keyword -{ - my $k = shift; - my $sign = $pos{$k} ? '' : '-'; - - if ($k eq 'elseif') { - return <<END; -Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); -END - } - elsif (my $feature = $feature_kw{$k}) { - $feature =~ s/([\\"])/\\$1/g; - return <<END; -return (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0); -END - } - return <<END; -return ${sign}KEY_$k; -END -} @@ -16,7 +16,6 @@ use strict; # Which scripts to run. my @scripts = qw( -keywords.pl opcode.pl overload.pl reentr.pl diff --git a/regen/keywords.pl b/regen/keywords.pl index 9b06182806..eeed6d4cb2 100755 --- a/regen/keywords.pl +++ b/regen/keywords.pl @@ -1,290 +1,358 @@ #!/usr/bin/perl -w -# +# # Regenerate (overwriting only if changed): # -# keywords.h +# keywords.h keywords.c # # from information stored in the DATA section of this file. # # Accepts the standard regen_lib -q and -v args. -# -# This script is normally invoked from regen.pl. use strict; +use Devel::Tokenizer::C 0.05; require 'regen/regen_lib.pl'; -my $kw = safer_open('keywords.h-new', 'keywords.h'); +my $h = safer_open('keywords.h-new', 'keywords.h'); +my $c = safer_open('keywords.c-new', 'keywords.c'); -print $kw read_only_top(lang => 'C', by => 'regen/keywords.pl', - from => 'its data', file => 'keywords.h', style => '*', - copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]); +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 => '*'); -# Read & print data. +my %by_strength; my $keynum = 0; while (<DATA>) { chop; next unless $_; next if /^#/; - my ($keyword) = split; - print $kw tab(5, "#define KEY_$keyword"), $keynum++, "\n"; + my ($strength, $keyword) = /^([- +])([A-Z_a-z2]+)/; + die "Bad line '$_'" unless defined $strength; + print $h tab(5, "#define KEY_$keyword"), $keynum++, "\n"; + push @{$by_strength{$strength}}, $keyword; } -read_only_bottom_close_and_rename($kw); +my %feature_kw = ( + given => 'switch', + when => 'switch', + default => 'switch', + # continue is already a keyword + break => 'switch', -__END__ + say => 'say', -NULL -__FILE__ -__LINE__ -__PACKAGE__ -__DATA__ -__END__ -AUTOLOAD -BEGIN -UNITCHECK -CORE -DESTROY + state => 'state', + ); + +my %pos = map { ($_ => 1) } @{$by_strength{'+'}}; + +my $t = Devel::Tokenizer::C->new(TokenFunc => \&perl_keyword, + TokenString => 'name', + StringLength => 'len', + MergeSwitches => 1, + ); + +$t->add_tokens(@{$by_strength{'+'}}, @{$by_strength{'-'}}, 'elseif'); + +my $switch = $t->generate(Indent => ' '); + +print $c <<"END"; +#include "EXTERN.h" +#define PERL_IN_KEYWORDS_C +#include "perl.h" +#include "keywords.h" + +I32 +Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) +{ + dVAR; + + PERL_ARGS_ASSERT_KEYWORD; + +$switch +unknown: + return 0; +} +END + +sub perl_keyword +{ + my $k = shift; + my $sign = $pos{$k} ? '' : '-'; + + if ($k eq 'elseif') { + return <<END; +Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); +END + } + elsif (my $feature = $feature_kw{$k}) { + $feature =~ s/([\\"])/\\$1/g; + return <<END; +return (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0); +END + } + return <<END; +return ${sign}KEY_$k; END -INIT -CHECK -abs -accept -alarm -and -atan2 -bind -binmode -bless -break -caller -chdir -chmod -chomp -chop -chown -chr -chroot -close -closedir -cmp -connect -continue -cos -crypt -dbmclose -dbmopen -default -defined -delete -die -do -dump -each -else -elsif -endgrent -endhostent -endnetent -endprotoent -endpwent -endservent -eof -eq -eval -exec -exists -exit -exp -fcntl -fileno -flock -for -foreach -fork -format -formline -ge -getc -getgrent -getgrgid -getgrnam -gethostbyaddr -gethostbyname -gethostent -getlogin -getnetbyaddr -getnetbyname -getnetent -getpeername -getpgrp -getppid -getpriority -getprotobyname -getprotobynumber -getprotoent -getpwent -getpwnam -getpwuid -getservbyname -getservbyport -getservent -getsockname -getsockopt -given -glob -gmtime -goto -grep -gt -hex -if -index -int -ioctl -join -keys -kill -last -lc -lcfirst -le -length -link -listen -local -localtime -lock -log -lstat -lt -m -map -mkdir -msgctl -msgget -msgrcv -msgsnd -my -ne -next -no -not -oct -open -opendir -or -ord -our -pack -package -pipe -pop -pos -print -printf -prototype -push -q -qq -qr -quotemeta -qw -qx -rand -read -readdir -readline -readlink -readpipe -recv -redo -ref -rename -require -reset -return -reverse -rewinddir -rindex -rmdir -s -say -scalar -seek -seekdir -select -semctl -semget -semop -send -setgrent -sethostent -setnetent -setpgrp -setpriority -setprotoent -setpwent -setservent -setsockopt -shift -shmctl -shmget -shmread -shmwrite -shutdown -sin -sleep -socket -socketpair -sort -splice -split -sprintf -sqrt -srand -stat -state -study -sub -substr -symlink -syscall -sysopen -sysread -sysseek -system -syswrite -tell -telldir -tie -tied -time -times -tr -truncate -uc -ucfirst -umask -undef -unless -unlink -unpack -unshift -untie -until -use -utime -values -vec -wait -waitpid -wantarray -warn -when -while -write -x -xor -y +} + +read_only_bottom_close_and_rename($_, [$0]) foreach $c, $h; + +__END__ + + NULL +-__FILE__ +-__LINE__ +-__PACKAGE__ ++__DATA__ ++__END__ ++AUTOLOAD ++BEGIN ++UNITCHECK +-CORE ++DESTROY ++END ++INIT ++CHECK +-abs +-accept +-alarm +-and +-atan2 +-bind +-binmode +-bless +-break +-caller +-chdir +-chmod +-chomp +-chop +-chown +-chr +-chroot +-close +-closedir +-cmp +-connect +-continue +-cos +-crypt +-dbmclose +-dbmopen ++default ++defined ++delete +-die ++do +-dump +-each ++else ++elsif +-endgrent +-endhostent +-endnetent +-endprotoent +-endpwent +-endservent +-eof +-eq ++eval +-exec ++exists +-exit +-exp +-fcntl +-fileno +-flock ++for ++foreach +-fork ++format +-formline +-ge +-getc +-getgrent +-getgrgid +-getgrnam +-gethostbyaddr +-gethostbyname +-gethostent +-getlogin +-getnetbyaddr +-getnetbyname +-getnetent +-getpeername +-getpgrp +-getppid +-getpriority +-getprotobyname +-getprotobynumber +-getprotoent +-getpwent +-getpwnam +-getpwuid +-getservbyname +-getservbyport +-getservent +-getsockname +-getsockopt ++given ++glob +-gmtime ++goto ++grep +-gt +-hex ++if +-index +-int +-ioctl +-join +-keys +-kill ++last +-lc +-lcfirst +-le +-length +-link +-listen ++local +-localtime +-lock +-log +-lstat +-lt ++m ++map +-mkdir +-msgctl +-msgget +-msgrcv +-msgsnd ++my +-ne ++next ++no +-not +-oct +-open +-opendir +-or +-ord ++our +-pack ++package +-pipe +-pop ++pos ++print ++printf ++prototype +-push ++q ++qq ++qr +-quotemeta ++qw ++qx +-rand +-read +-readdir +-readline +-readlink +-readpipe +-recv ++redo +-ref +-rename ++require +-reset ++return +-reverse +-rewinddir +-rindex +-rmdir ++s ++say ++scalar +-seek +-seekdir +-select +-semctl +-semget +-semop +-send +-setgrent +-sethostent +-setnetent +-setpgrp +-setpriority +-setprotoent +-setpwent +-setservent +-setsockopt +-shift +-shmctl +-shmget +-shmread +-shmwrite +-shutdown +-sin +-sleep +-socket +-socketpair ++sort +-splice ++split +-sprintf +-sqrt +-srand +-stat ++state ++study ++sub +-substr +-symlink +-syscall +-sysopen +-sysread +-sysseek +-system +-syswrite +-tell +-telldir +-tie +-tied +-time +-times ++tr +-truncate +-uc +-ucfirst +-umask ++undef ++unless +-unlink +-unpack +-unshift +-untie ++until ++use +-utime +-values +-vec +-wait +-waitpid +-wantarray +-warn ++when ++while +-write +-x +-xor ++y diff --git a/t/porting/regen.t b/t/porting/regen.t index d3a5d41f52..4c44cf235d 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -23,8 +23,8 @@ require 'regen/regen_lib.pl'; require 't/test.pl'; $::NO_ENDING = $::NO_ENDING = 1; -my $in_regen_pl = 18; # I can't see a clean way to calculate this automatically. -my @files = qw(perly.act perly.h perly.tab); +my $in_regen_pl = 17; # I can't see a clean way to calculate this automatically. +my @files = qw(perly.act perly.h perly.tab keywords.c keywords.h); my @progs = qw(Porting/makemeta regen/regcharclass.pl regen/mk_PL_charclass.pl); plan (tests => $in_regen_pl + @files + @progs); diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 73c2a31c10..3dd6da5c9d 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -1466,7 +1466,6 @@ $(SOCKH) : [.vms]$(SOCKH) # The following files are generated automatically # embed.pl: proto.h embed.h embedvar.h global.sym # perlapi.h perlapi.c -# keywords.pl: keywords.h # opcode.pl: opcode.h opnames.h pp_proto.h # regcomp.pl: regnodes.h # warnings.pl: warnings.h lib/warnings.pm |