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)

1 files changed, 333 insertions, 265 deletions

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