This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge perl_keyword.pl into regen/keywords.pl, to generate keywords.[ch]
authorNicholas Clark <nick@ccl4.org>
Mon, 24 Jan 2011 11:06:50 +0000 (11:06 +0000)
committerNicholas Clark <nick@ccl4.org>
Mon, 24 Jan 2011 11:13:21 +0000 (11:13 +0000)
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)

Cross/Makefile-cross-SH
MANIFEST
Makefile.SH
keywords.c
keywords.h
perl_keyword.pl [deleted file]
regen.pl
regen/keywords.pl
t/porting/regen.t
vms/descrip_mms.template

index cc17671..2ea58f5 100644 (file)
@@ -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
index be2876e..d253cbe 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index 28c539d..c8ad2a8 100755 (executable)
@@ -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
index 199eaed..61bfc69 100644 (file)
@@ -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: */
index 7915fc7..b821121 100644 (file)
 #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 (file)
index 7eecff6..0000000
+++ /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
-}
index 277413c..14ef147 100644 (file)
--- a/regen.pl
+++ b/regen.pl
@@ -16,7 +16,6 @@ use strict;
 # Which scripts to run.
 
 my @scripts = qw(
-keywords.pl
 opcode.pl
 overload.pl
 reentr.pl
index 9b06182..eeed6d4 100755 (executable)
 #!/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
index d3a5d41..4c44cf2 100644 (file)
@@ -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);
index 73c2a31..3dd6da5 100644 (file)
@@ -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