X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl_keyword.pl;h=f53416cc50edde78d09432373b5d485f00d1ff91;hb=fb6e4a4e4598d2f4d2f011525b2ff33f3b73f007;hp=02d5df4b452eb243f25128afceebcb4b90d7d4b5;hpb=35175a9ce4be48663a7f98d01d6f5a77a0214ecf;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl_keyword.pl b/perl_keyword.pl
index 02d5df4..f53416c 100644
--- a/perl_keyword.pl
+++ b/perl_keyword.pl
@@ -5,34 +5,47 @@ 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 say scalar sort
+	    split state study sub tr tie tied use undef UNITCHECK 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 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);
+
+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;
 
@@ -52,8 +65,9 @@ print <<END;
  */
 
 I32
-Perl_keyword (pTHX_ char *name, I32 len)
+Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 {
+    dVAR;
 $switch
 unknown:
   return 0;
@@ -71,7 +85,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 (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
+END
+  }
   return <<END;
 return ${sign}KEY_$k;
 END