latest switch/say/~~

Message-Id: <20051217204431.GB28940@rpc142.cs.man.ac.uk>

p4raw-id: //depot/perl@26400

1 files changed, 44 insertions, 27 deletions

diff --git a/perl_keyword.pl b/perl_keyword.pl
index bb8bc74865..d0471f6891 100644
--- a/perl_keyword.pl
+++ b/perl_keyword.pl
@@ -5,34 +5,45 @@ 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 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',
+	);
 
 my %pos = map { ($_ => 1) } @pos;
 
@@ -71,7 +82,13 @@ if(ckWARN_d(WARN_SYNTAX))
   Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
 END
   }
-
+  elsif (my $feature = $feature_kw{$k}) {
+    my $feature_len = length($feature);
+    $feature =~ s/([\\"])/\\$1/g;
+    return <<END;
+return (FEATURE_IS_ENABLED("$feature", $feature_len) ? ${sign}KEY_$k : 0);
+END
+  }
   return <<END;
 return ${sign}KEY_$k;
 END