diff options
| -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 |