symbian/xsbuild.pl

[perl5.git] / perl_keyword.pl

diff --git a/perl_keyword.pl b/perl_keyword.pl
index bb8bc74..f71c7d0 100644 (file)
--- 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 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 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);
+
+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;
 
@@ -52,8 +67,9 @@ print <<END;
  */
 
 I32
-Perl_keyword (pTHX_ const char *name, I32 len)
+Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords)
 {
+    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 (all_keywords || FEATURE_IS_ENABLED("$feature") ? ${sign}KEY_$k : 0);
+END
+  }
   return <<END;
 return ${sign}KEY_$k;
 END