X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl_keyword.pl;h=b2e9e3424cfd24d1033990ae3f694b8892b66b9a;hb=461824dcfbc00b3c4e20590f06d6c9881e4a416b;hp=bb8bc74865a7ecb3ce84ae5b72c2801049ede7f8;hpb=672994ceae26eaea7b543577cbf4ae1bf28d2934;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl_keyword.pl b/perl_keyword.pl
index bb8bc74..b2e9e34 100644
--- a/perl_keyword.pl
+++ b/perl_keyword.pl
@@ -5,34 +5,49 @@ use Devel::Tokenizer::C 0.05;
 use strict;
 use warnings;
 
-my @pos = qw(__DATA__ __END__ AUTOLOAD BEGIN CHECK DESTROY do delete defined
-	     END else eval elsif exists for format foreach 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 scalar sort split
-	     study sub tr tie tied use undef until untie unless while y);
+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 scalar sort
+	    split state study sub tr tie tied use undef until untie unless when
+	    while y);
 
 my @neg = qw(__FILE__ __LINE__ __PACKAGE__ and abs alarm atan2 accept bless
-	     bind binmode CORE cmp chr cos chop close chdir chomp chmod chown
-	     crypt chroot caller connect closedir continue die dump dbmopen
-	     dbmclose eq eof err 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 time
-	     times telldir truncate uc utime umask unpack unlink unshift
-	     ucfirst values vec warn wait write waitpid wantarray x xor);
+	    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 err 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 say 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 time times telldir truncate uc utime umask unpack
+	    unlink unshift 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',
+
+	err	=> 'err',
+
+	state	=> 'state',
+	);
 
 my %pos = map { ($_ => 1) } @pos;
 
@@ -54,6 +69,7 @@ print <<END;
 I32
 Perl_keyword (pTHX_ const char *name, I32 len)
 {
+    dVAR;
 $switch
 unknown:
   return 0;
@@ -71,7 +87,12 @@ if(ckWARN_d(WARN_SYNTAX))
   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
 END
   }
-
+  elsif (my $feature = $feature_kw{$k}) {
+    $feature =~ s/([\\"])/\\$1/g;
+    return <<END;
+return (FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
+END
+  }
   return <<END;
 return ${sign}KEY_$k;
 END