diff options
23 files changed, 361 insertions, 566 deletions
@@ -22046,13 +22046,6 @@ for xxx in $known_extensions ; do $define) avail_ext="$avail_ext $xxx" ;; esac ;; - XS/APItest/KeywordRPN|xs/apitest/keywordrpn) - # This is just for testing. Skip it unless we have dynamic loading. - - case "$usedl" in - $define) avail_ext="$avail_ext $xxx" ;; - esac - ;; XS/Typemap|xs/typemap) # This is just for testing. Skip it unless we have dynamic loading. case "$usedl" in diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index a5efdd89ea..2424b6a4eb 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -550,7 +550,7 @@ doublesize='8' drand01='drand48()' drand48_r_proto='0' dtrace='' -dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' +dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -565,7 +565,7 @@ endservent_r_proto='0' eunicefix=':' exe_ext='' expr='expr' -extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared Errno' +extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared Errno' extras='' fflushNULL='define' fflushall='undef' @@ -755,7 +755,7 @@ issymlink='/usr/bin/test -h' ivdformat='"ld"' ivsize='4' ivtype='long' -known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' +known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' ksh='' ld='cc' lddlflags='-shared -L/usr/local/lib' diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index 86a7c60618..2c24606058 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -531,7 +531,7 @@ dlsrc='dl_dlopen.xs' doublesize='8' drand01='drand48()' drand48_r_proto='0' -dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' +dynamic_ext='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -546,7 +546,7 @@ endservent_r_proto='0' eunicefix=':' exe_ext='' expr='expr' -extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared Errno' +extensions='B ByteLoader Cwd Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared Errno' extras='' fflushNULL='define' fflushall='undef' @@ -736,7 +736,7 @@ issymlink='/usr/bin/test -h' ivdformat='"ld"' ivsize='4' ivtype='long' -known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' +known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' ksh='' ld='arm-none-linux-gnueabi-gcc' lddlflags='-shared -L/usr/local/lib' @@ -3329,14 +3329,6 @@ ext/XS-APItest/APItest.xs XS::APItest extension ext/XS-APItest/core.c Test API functions when PERL_CORE is defined ext/XS-APItest/core_or_not.inc Code common to core.c and notcore.c ext/XS-APItest/exception.c XS::APItest extension -ext/XS-APItest-KeywordRPN/KeywordRPN.pm XS::APItest::KeywordRPN extension -ext/XS-APItest-KeywordRPN/KeywordRPN.xs XS::APItest::KeywordRPN extension -ext/XS-APItest-KeywordRPN/Makefile.PL XS::APItest::KeywordRPN extension -ext/XS-APItest-KeywordRPN/README XS::APItest::KeywordRPN extension -ext/XS-APItest-KeywordRPN/t/keyword_plugin.t test keyword plugin mechanism -ext/XS-APItest-KeywordRPN/t/multiline.t test plugin parsing across lines -ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t test for a bug in lex_stuff_pvn -ext/XS-APItest-KeywordRPN/t/swaptwostmts.t test recursive descent statement parsing ext/XS-APItest/Makefile.PL XS::APItest extension ext/XS-APItest/MANIFEST XS::APItest extension ext/XS-APItest/notcore.c Test API functions when PERL_CORE is not defined @@ -3352,6 +3344,8 @@ ext/XS-APItest/t/copyhints.t test hv_copy_hints_hv() API ext/XS-APItest/t/exception.t XS::APItest extension ext/XS-APItest/t/grok.t XS::APItest: tests for grok* functions ext/XS-APItest/t/hash.t XS::APItest: tests for hash related APIs +ext/XS-APItest/t/keyword_multiline.t test keyword plugin parsing across lines +ext/XS-APItest/t/keyword_plugin.t test keyword plugin mechanism ext/XS-APItest/t/Markers.pm Helper for ./blockhooks.t ext/XS-APItest/t/my_cxt.t XS::APItest: test MY_CXT interface ext/XS-APItest/t/my_exit.t XS::APItest: test my_exit @@ -3364,8 +3358,10 @@ ext/XS-APItest/t/ptr_table.t Test ptr_table_* APIs ext/XS-APItest/t/push.t XS::APItest extension ext/XS-APItest/t/rmagical.t XS::APItest extension ext/XS-APItest/t/savehints.t test SAVEHINTS() API +ext/XS-APItest/t/stuff_svcur_bug.t test for a bug in lex_stuff_pvn ext/XS-APItest/t/svpeek.t XS::APItest extension ext/XS-APItest/t/svsetsv.t Test behaviour of sv_setsv with/without PERL_CORE +ext/XS-APItest/t/swaptwostmts.t test recursive descent statement parsing ext/XS-APItest/t/temp_lv_sub.t XS::APItest: tests for lvalue subs returning temps ext/XS-APItest/t/utf16_to_utf8.t Test behaviour of utf16_to_utf8{,reversed} ext/XS-APItest/t/xs_special_subs_require.t for require too diff --git a/NetWare/Makefile b/NetWare/Makefile index f1a88e3324..eee12960d6 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -326,7 +326,6 @@ STORABLE_NLM = $(EXTDIR)\Storable\Storable.NLM LISTUTIL_NLM = $(EXTDIR)\List\Util.NLM MIMEBASE64_NLM = $(EXTDIR)\MIME\Base64\Base64.NLM XSAPITEST_NLM = $(EXTDIR)\XS\APItest\APItest.NLM -XSAPITESTKEYWORDRPN_NLM = $(EXTDIR)\XS\APItest\KeywordRPN\KeywordRPN.NLM XSTYPEMAP_NLM = $(EXTDIR)\XS\Typemap\Typemap.NLM UNICODENORMALIZE_NLM = $(EXTDIR)\Unicode\Normalize\Normalize.NLM @@ -351,7 +350,6 @@ EXTENSION_NLM = \ $(LISTUTIL_NLM) \ $(MIMEBASE64_NLM) \ $(XSAPITEST_NLM) \ - $(XSAPITESTKEYWORDRPN_NLM) \ $(XSTYPEMAP_NLM) \ $(UNICODENORMALIZE_NLM) \ $(FILTER_NLM) @@ -791,7 +789,7 @@ X2P_OBJ = $(X2P_SRC:.c=.obj) DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attributes B re \ Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob \ - Storable/Storable List/Util MIME/Base64/Base64 XS/APItest/APItest XS/APItest/KeywordRPN \ + Storable/Storable List/Util MIME/Base64/Base64 XS/APItest/APItest \ XS/Typemap/Typemap Unicode/Normalize/Normalize Sys/Hostname STATIC_EXT = DynaLoader @@ -819,7 +817,6 @@ STORABLE = $(EXTDIR)\Storable\Storable LISTUTIL = $(EXTDIR)\List\Util MIMEBASE64 = $(EXTDIR)\MIME\Base64\Base64 XSAPITEST = $(EXTDIR)\XS\APItest\APItest -XSAPITESTKEYWORDRPN = $(EXTDIR)\XS\APItest\KeywordRPN\KeywordRPN XSTYPEMAP = $(EXTDIR)\XS\Typemap\Typemap UNICODENORMALIZE = $(EXTDIR)\Unicode\Normalize\Normalize @@ -846,7 +843,6 @@ EXTENSION_C = \ $(LISTUTIL).c \ $(MIMEBASE64).c \ $(XSAPITEST).c \ - $(XSAPITESTKEYWORDRPN).c \ $(XSTYPEMAP).c \ $(UNICODENORMALIZE).c \ @@ -1271,12 +1267,6 @@ $(XSAPITEST_NLM): $(MAKE) cd ..\..\..\netware -$(XSAPITESTKEYWORDRPN_NLM): - cd $(EXTDIR)\XS\$(*B) - ..\..\..\miniperl -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl - $(MAKE) - cd ..\..\..\netware - $(XSTYPEMAP_NLM): cd $(EXTDIR)\XS\$(*B) ..\..\..\miniperl -I..\..\lib Makefile.PL PERL_CORE=1 INSTALLDIRS=perl diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index f50c19f4d4..0d652743d4 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1598,13 +1598,6 @@ use File::Glob qw(:case); 'UPSTREAM' => 'cpan', }, - 'XS::APItest::KeywordRPN' => - { - 'MAINTAINER' => 'zefram', - 'FILES' => q[ext/XS-APItest-KeywordRPN], - 'UPSTREAM' => 'blead', - }, - 'XSLoader' => { 'MAINTAINER' => 'saper', diff --git a/Porting/config.sh b/Porting/config.sh index 77fbfc2cac..47f9493709 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -564,7 +564,7 @@ doublesize='8' drand01='drand48()' drand48_r_proto='0' dtrace='' -dynamic_ext='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap threads/shared Hash/Util/FieldHash' +dynamic_ext='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/Typemap threads/shared Hash/Util/FieldHash' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -579,7 +579,7 @@ endservent_r_proto='0' eunicefix=':' exe_ext='' expr='expr' -extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap threads/shared Hash/Util/FieldHash Compress/Zlib Errno IO_Compress_Base IO_Compress_Zlib Module/Pluggable Test/Harness' +extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize XS/APItest XS/Typemap threads/shared Hash/Util/FieldHash Compress/Zlib Errno IO_Compress_Base IO_Compress_Zlib Module/Pluggable Test/Harness' extern_C='extern' extras='' fflushNULL='define' @@ -771,7 +771,7 @@ issymlink='test -h' ivdformat='"Ld"' ivsize='8' ivtype='long long' -known_extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize Win32 Win32API/File Win32CORE XS/APItest XS/APItest/KeywordRPN XS/Typemap threads/shared Hash/Util/FieldHash' +known_extensions='attributes B Compress/Raw/Zlib Cwd Data/Dumper DB_File Devel/DProf Devel/Peek Devel/PPPort Digest/MD5 Digest/SHA Encode Fcntl File/Glob Filter/Util/Call GDBM_File Hash/Util I18N/Langinfo IO IPC/SysV List/Util Math/BigInt/FastCalc MIME/Base64 NDBM_File ODBM_File Opcode PerlIO/encoding PerlIO/scalar PerlIO/via POSIX re SDBM_File Socket Storable Sys/Hostname Sys/Syslog Text/Soundex threads Time/HiRes Time/Piece Unicode/Normalize Win32 Win32API/File Win32CORE XS/APItest XS/Typemap threads/shared Hash/Util/FieldHash' ksh='' ld='cc' lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector' diff --git a/djgpp/config.over b/djgpp/config.over index 5d97c85725..f385f55369 100644 --- a/djgpp/config.over +++ b/djgpp/config.over @@ -46,7 +46,6 @@ repair() -e 's=cwd=Cwd=' \ -e 's=perlio/via=PerlIO/via=' \ -e 's=perlio/encoding=PerlIO/encoding=' \ - -e 's=xs/apitest/keywordrpn=XS/APItest/KeywordRPN=' \ -e 's=xs/apitest=XS/APItest=' \ -e 's=xs/typemap=XS/Typemap=' \ -e 's=unicode/normaliz=Unicode/Normalize=' \ diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.pm b/ext/XS-APItest-KeywordRPN/KeywordRPN.pm deleted file mode 100644 index 224faf773d..0000000000 --- a/ext/XS-APItest-KeywordRPN/KeywordRPN.pm +++ /dev/null @@ -1,143 +0,0 @@ -=head1 NAME - -XS::APItest::KeywordRPN - write arithmetic expressions in RPN - -=head1 SYNOPSIS - - use XS::APItest::KeywordRPN qw(rpn calcrpn); - - $triangle = rpn($n $n 1 + * 2 /); - - calcrpn $triangle { $n $n 1 + * 2 / } - -=head1 DESCRIPTION - -This module supplies plugged-in keywords, using the new mechanism in Perl -5.11.2, that allow arithmetic to be expressed in reverse Polish notation, -in an otherwise Perl program. This module has serious limitations and -is not intended for real use: its purpose is only to test the keyword -plugin mechanism. For that purpose it is part of the Perl core source -distribution, and is not meant to be installed. - -=head2 RPN expression syntax - -Tokens of an RPN expression may be separated by whitespace, but such -separation is usually not required. It is required only where unseparated -tokens would look like a longer token. For example, C<12 34 +> can be -written as C<12 34+>, but not as C<1234 +>. - -An RPN expression may be any of: - -=over - -=item C<1234> - -A sequence of digits is an unsigned decimal literal number. - -=item C<$foo> - -An alphanumeric name preceded by dollar sign refers to a Perl scalar -variable. Only variables declared with C<my> or C<state> are supported. -If the variable's value is not a native integer, it will be converted -to an integer, by Perl's usual mechanisms, at the time it is evaluated. - -=item I<A> I<B> C<+> - -Sum of I<A> and I<B>. - -=item I<A> I<B> C<-> - -Difference of I<A> and I<B>, the result of subtracting I<B> from I<A>. - -=item I<A> I<B> C<*> - -Product of I<A> and I<B>. - -=item I<A> I<B> C</> - -Quotient when I<A> is divided by I<B>, rounded towards zero. -Division by zero generates an exception. - -=item I<A> I<B> C<%> - -Remainder when I<A> is divided by I<B> with the quotient rounded towards zero. -Division by zero generates an exception. - -=back - -Because the arithmetic operators all have fixed arity and are postfixed, -there is no need for operator precedence, nor for a grouping operator -to override precedence. This is half of the point of RPN. - -An RPN expression can also be interpreted in another way, as a sequence -of operations on a stack, one operation per token. A literal or variable -token pushes a value onto the stack. A binary operator pulls two items -off the stack, performs a calculation with them, and pushes the result -back onto the stack. The stack starts out empty, and at the end of the -expression there must be exactly one value left on the stack. - -=cut - -package XS::APItest::KeywordRPN; - -{ use 5.011001; } -use warnings; -use strict; - -our $VERSION = "0.005"; - -require XSLoader; -XSLoader::load(__PACKAGE__, $VERSION); - -=head1 OPERATORS - -These are the operators being added to the Perl language. - -=over - -=item rpn(EXPRESSION) - -This construct is a Perl expression. I<EXPRESSION> must be an RPN -arithmetic expression, as described above. The RPN expression is -evaluated, and its value is returned as the value of the Perl expression. - -=item calcrpn VARIABLE { EXPRESSION } - -This construct is a complete Perl statement. (No semicolon should -follow the closing brace.) I<VARIABLE> must be a Perl scalar C<my> -variable, and I<EXPRESSION> must be an RPN arithmetic expression as -described above. The RPN expression is evaluated, and its value is -assigned to the variable. - -=back - -=head1 BUGS - -This module only performs arithmetic on native integers, and only a -small subset of the arithmetic operations that Perl offers. This is -due to it being intended only for demonstration and test purposes. - -The RPN parser is liable to leak memory when a parse error occurs. -It doesn't leak on success, however. - -=head1 SEE ALSO - -L<Devel::Declare>, -L<perlapi/PL_keyword_plugin> - -=head1 AUTHOR - -Andrew Main (Zefram) <zefram@fysh.org> - -=head1 COPYRIGHT - -Copyright (C) 2009 Andrew Main (Zefram) <zefram@fysh.org> - -=head1 LICENSE - -This module is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. - -=cut - -1; diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs deleted file mode 100644 index 6c622564ff..0000000000 --- a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs +++ /dev/null @@ -1,308 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV) -#define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP) -#define sv_is_string(sv) \ - (!sv_is_glob(sv) && !sv_is_regexp(sv) && \ - (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK))) - -static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv; -static SV *hintkey_swaptwostmts_sv; -static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); - -/* low-level parser helpers */ - -#define PL_bufptr (PL_parser->bufptr) -#define PL_bufend (PL_parser->bufend) - -/* RPN parser */ - -static OP *THX_parse_var(pTHX) -{ - char *s = PL_bufptr; - char *start = s; - PADOFFSET varpos; - OP *padop; - if(*s != '$') croak("RPN syntax error"); - while(1) { - char c = *++s; - if(!isALNUM(c)) break; - } - if(s-start < 2) croak("RPN syntax error"); - lex_read_to(s); - { - /* because pad_findmy() doesn't really use length yet */ - SV *namesv = sv_2mortal(newSVpvn(start, s-start)); - varpos = pad_findmy(SvPVX(namesv), s-start, 0); - } - if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos)) - croak("RPN only supports \"my\" variables"); - padop = newOP(OP_PADSV, 0); - padop->op_targ = varpos; - return padop; -} -#define parse_var() THX_parse_var(aTHX) - -#define push_rpn_item(o) \ - (tmpop = (o), tmpop->op_sibling = stack, stack = tmpop) -#define pop_rpn_item() \ - (!stack ? (croak("RPN stack underflow"), (OP*)NULL) : \ - (tmpop = stack, stack = stack->op_sibling, \ - tmpop->op_sibling = NULL, tmpop)) - -static OP *THX_parse_rpn_expr(pTHX) -{ - OP *stack = NULL, *tmpop; - while(1) { - I32 c; - lex_read_space(0); - c = lex_peek_unichar(0); - switch(c) { - case /*(*/')': case /*{*/'}': { - OP *result = pop_rpn_item(); - if(stack) - croak("RPN expression must return " - "a single value"); - return result; - } break; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': { - UV val = 0; - do { - lex_read_unichar(0); - val = 10*val + (c - '0'); - c = lex_peek_unichar(0); - } while(c >= '0' && c <= '9'); - push_rpn_item(newSVOP(OP_CONST, 0, - newSVuv(val))); - } break; - case '$': { - push_rpn_item(parse_var()); - } break; - case '+': { - OP *b = pop_rpn_item(); - OP *a = pop_rpn_item(); - lex_read_unichar(0); - push_rpn_item(newBINOP(OP_I_ADD, 0, a, b)); - } break; - case '-': { - OP *b = pop_rpn_item(); - OP *a = pop_rpn_item(); - lex_read_unichar(0); - push_rpn_item(newBINOP(OP_I_SUBTRACT, 0, a, b)); - } break; - case '*': { - OP *b = pop_rpn_item(); - OP *a = pop_rpn_item(); - lex_read_unichar(0); - push_rpn_item(newBINOP(OP_I_MULTIPLY, 0, a, b)); - } break; - case '/': { - OP *b = pop_rpn_item(); - OP *a = pop_rpn_item(); - lex_read_unichar(0); - push_rpn_item(newBINOP(OP_I_DIVIDE, 0, a, b)); - } break; - case '%': { - OP *b = pop_rpn_item(); - OP *a = pop_rpn_item(); - lex_read_unichar(0); - push_rpn_item(newBINOP(OP_I_MODULO, 0, a, b)); - } break; - default: { - croak("RPN syntax error"); - } break; - } - } -} -#define parse_rpn_expr() THX_parse_rpn_expr(aTHX) - -static OP *THX_parse_keyword_rpn(pTHX) -{ - OP *op; - lex_read_space(0); - if(lex_peek_unichar(0) != '('/*)*/) - croak("RPN expression must be parenthesised"); - lex_read_unichar(0); - op = parse_rpn_expr(); - if(lex_peek_unichar(0) != /*(*/')') - croak("RPN expression must be parenthesised"); - lex_read_unichar(0); - return op; -} -#define parse_keyword_rpn() THX_parse_keyword_rpn(aTHX) - -static OP *THX_parse_keyword_calcrpn(pTHX) -{ - OP *varop, *exprop; - lex_read_space(0); - varop = parse_var(); - lex_read_space(0); - if(lex_peek_unichar(0) != '{'/*}*/) - croak("RPN expression must be braced"); - lex_read_unichar(0); - exprop = parse_rpn_expr(); - if(lex_peek_unichar(0) != /*{*/'}') - croak("RPN expression must be braced"); - lex_read_unichar(0); - return newASSIGNOP(OPf_STACKED, varop, 0, exprop); -} -#define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX) - -static OP *THX_parse_keyword_stufftest(pTHX) -{ - I32 c; - bool do_stuff; - lex_read_space(0); - do_stuff = lex_peek_unichar(0) == '+'; - if(do_stuff) { - lex_read_unichar(0); - lex_read_space(0); - } - c = lex_peek_unichar(0); - if(c == ';') { - lex_read_unichar(0); - } else if(c != /*{*/'}') { - croak("syntax error"); - } - if(do_stuff) lex_stuff_pvs(" ", 0); - return newOP(OP_NULL, 0); -} -#define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX) - -static OP *THX_parse_keyword_swaptwostmts(pTHX) -{ - OP *a, *b; - a = parse_fullstmt(0); - b = parse_fullstmt(0); - if(a && b) - PL_hints |= HINT_BLOCK_SCOPE; - /* should use append_list(), but that's not part of the public API */ - return !a ? b : !b ? a : newLISTOP(OP_LINESEQ, 0, b, a); -} -#define parse_keyword_swaptwostmts() THX_parse_keyword_swaptwostmts(aTHX) - -/* plugin glue */ - -static int THX_keyword_active(pTHX_ SV *hintkey_sv) -{ - HE *he; - if(!GvHV(PL_hintgv)) return 0; - he = hv_fetch_ent(GvHV(PL_hintgv), hintkey_sv, 0, - SvSHARED_HASH(hintkey_sv)); - return he && SvTRUE(HeVAL(he)); -} -#define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv) - -static void THX_keyword_enable(pTHX_ SV *hintkey_sv) -{ - SV *val_sv = newSViv(1); - HE *he; - PL_hints |= HINT_LOCALIZE_HH; - gv_HVadd(PL_hintgv); - he = hv_store_ent(GvHV(PL_hintgv), - hintkey_sv, val_sv, SvSHARED_HASH(hintkey_sv)); - if(he) { - SV *val = HeVAL(he); - SvSETMAGIC(val); - } else { - SvREFCNT_dec(val_sv); - } -} -#define keyword_enable(hintkey_sv) THX_keyword_enable(aTHX_ hintkey_sv) - -static void THX_keyword_disable(pTHX_ SV *hintkey_sv) -{ - if(GvHV(PL_hintgv)) { - PL_hints |= HINT_LOCALIZE_HH; - hv_delete_ent(GvHV(PL_hintgv), - hintkey_sv, G_DISCARD, SvSHARED_HASH(hintkey_sv)); - } -} -#define keyword_disable(hintkey_sv) THX_keyword_disable(aTHX_ hintkey_sv) - -static int my_keyword_plugin(pTHX_ - char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) -{ - if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) && - keyword_active(hintkey_rpn_sv)) { - *op_ptr = parse_keyword_rpn(); - return KEYWORD_PLUGIN_EXPR; - } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) && - keyword_active(hintkey_calcrpn_sv)) { - *op_ptr = parse_keyword_calcrpn(); - return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) && - keyword_active(hintkey_stufftest_sv)) { - *op_ptr = parse_keyword_stufftest(); - return KEYWORD_PLUGIN_STMT; - } else if(keyword_len == 12 && - strnEQ(keyword_ptr, "swaptwostmts", 12) && - keyword_active(hintkey_swaptwostmts_sv)) { - *op_ptr = parse_keyword_swaptwostmts(); - return KEYWORD_PLUGIN_STMT; - } else { - return next_keyword_plugin(aTHX_ - keyword_ptr, keyword_len, op_ptr); - } -} - -MODULE = XS::APItest::KeywordRPN PACKAGE = XS::APItest::KeywordRPN - -BOOT: - hintkey_rpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/rpn"); - hintkey_calcrpn_sv = newSVpvs_share("XS::APItest::KeywordRPN/calcrpn"); - hintkey_stufftest_sv = - newSVpvs_share("XS::APItest::KeywordRPN/stufftest"); - hintkey_swaptwostmts_sv = - newSVpvs_share("XS::APItest::KeywordRPN/swaptwostmts"); - next_keyword_plugin = PL_keyword_plugin; - PL_keyword_plugin = my_keyword_plugin; - -void -import(SV *classname, ...) -PREINIT: - int i; -PPCODE: - for(i = 1; i != items; i++) { - SV *item = ST(i); - if(sv_is_string(item) && strEQ(SvPVX(item), "rpn")) { - keyword_enable(hintkey_rpn_sv); - } else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) { - keyword_enable(hintkey_calcrpn_sv); - } else if(sv_is_string(item) && - strEQ(SvPVX(item), "stufftest")) { - keyword_enable(hintkey_stufftest_sv); - } else if(sv_is_string(item) && - strEQ(SvPVX(item), "swaptwostmts")) { - keyword_enable(hintkey_swaptwostmts_sv); - } else { - croak("\"%s\" is not exported by the %s module", - SvPV_nolen(item), SvPV_nolen(ST(0))); - } - } - -void -unimport(SV *classname, ...) -PREINIT: - int i; -PPCODE: - for(i = 1; i != items; i++) { - SV *item = ST(i); - if(sv_is_string(item) && strEQ(SvPVX(item), "rpn")) { - keyword_disable(hintkey_rpn_sv); - } else if(sv_is_string(item) && strEQ(SvPVX(item), "calcrpn")) { - keyword_disable(hintkey_calcrpn_sv); - } else if(sv_is_string(item) && - strEQ(SvPVX(item), "stufftest")) { - keyword_disable(hintkey_stufftest_sv); - } else if(sv_is_string(item) && - strEQ(SvPVX(item), "swaptwostmts")) { - keyword_disable(hintkey_swaptwostmts_sv); - } else { - croak("\"%s\" is not exported by the %s module", - SvPV_nolen(item), SvPV_nolen(ST(0))); - } - } diff --git a/ext/XS-APItest-KeywordRPN/Makefile.PL b/ext/XS-APItest-KeywordRPN/Makefile.PL deleted file mode 100644 index ae2c72a40c..0000000000 --- a/ext/XS-APItest-KeywordRPN/Makefile.PL +++ /dev/null @@ -1,17 +0,0 @@ -{ use 5.006; } -use warnings; -use strict; - -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => "XS::APItest::KeywordRPN", - VERSION_FROM => "KeywordRPN.pm", - PREREQ_PM => {}, - ABSTRACT_FROM => "KeywordRPN.pm", - AUTHOR => "Andrew Main (Zefram) <zefram\@fysh.org>", -); - -sub MY::install { "install ::\n" } - -1; diff --git a/ext/XS-APItest-KeywordRPN/README b/ext/XS-APItest-KeywordRPN/README deleted file mode 100644 index 4caa629af1..0000000000 --- a/ext/XS-APItest-KeywordRPN/README +++ /dev/null @@ -1,25 +0,0 @@ -NAME - -XS::APItest::KeywordRPN - write arithmetic expressions in RPN - -DESCRIPTION - -This module supplies plugged-in keywords, using the new mechanism in Perl -5.11.2, that allow arithmetic to be expressed in reverse Polish notation, -in an otherwise Perl program. This module has serious limitations and -is not intended for real use: its purpose is only to test the keyword -plugin mechanism. For that purpose it is part of the Perl core source -distribution, and is not meant to be installed. - -AUTHOR - -Andrew Main (Zefram) <zefram@fysh.org> - -COPYRIGHT - -Copyright (C) 2009 Andrew Main (Zefram) <zefram@fysh.org> - -LICENSE - -This module is free software; you can redistribute it and/or modify it -under the same terms as Perl itself. diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index ca121adcc9..474d528fb4 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -1,6 +1,6 @@ package XS::APItest; -use 5.008; +{ use 5.011001; } use strict; use warnings; use Carp; @@ -35,6 +35,11 @@ sub import { } } } + foreach (keys %{$exports||{}}) { + next unless /\A(?:rpn|calcrpn|stufftest|swaptwostmts)\z/; + $^H{"XS::APItest/$_"} = 1; + delete $exports->{$_}; + } if ($exports) { my @carp = keys %$exports; if (@carp) { @@ -45,7 +50,7 @@ sub import { } } -our $VERSION = '0.22'; +our $VERSION = '0.23'; use vars '$WARNINGS_ON_BOOTSTRAP'; use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END); @@ -101,6 +106,10 @@ XS::APItest - Test the perl C API use XS::APItest; print_double(4); + use XS::APItest qw(rpn calcrpn); + $triangle = rpn($n $n 1 + * 2 /); + calcrpn $triangle { $n $n 1 + * 2 / } + =head1 ABSTRACT This module tests the perl C API. Also exposes various bit of the perl @@ -226,6 +235,86 @@ Exercises the C function of the same name. Returns nothing. =back +=head1 KEYWORDS + +These are not supplied by default, but must be explicitly imported. +They are lexically scoped. + +=over + +=item rpn(EXPRESSION) + +This construct is a Perl expression. I<EXPRESSION> must be an RPN +arithmetic expression, as described below. The RPN expression is +evaluated, and its value is returned as the value of the Perl expression. + +=item calcrpn VARIABLE { EXPRESSION } + +This construct is a complete Perl statement. (No semicolon should +follow the closing brace.) I<VARIABLE> must be a Perl scalar C<my> +variable, and I<EXPRESSION> must be an RPN arithmetic expression as +described below. The RPN expression is evaluated, and its value is +assigned to the variable. + +=back + +=head2 RPN expression syntax + +Tokens of an RPN expression may be separated by whitespace, but such +separation is usually not required. It is required only where unseparated +tokens would look like a longer token. For example, C<12 34 +> can be +written as C<12 34+>, but not as C<1234 +>. + +An RPN expression may be any of: + +=over + +=item C<1234> + +A sequence of digits is an unsigned decimal literal number. + +=item C<$foo> + +An alphanumeric name preceded by dollar sign refers to a Perl scalar +variable. Only variables declared with C<my> or C<state> are supported. +If the variable's value is not a native integer, it will be converted +to an integer, by Perl's usual mechanisms, at the time it is evaluated. + +=item I<A> I<B> C<+> + +Sum of I<A> and I<B>. + +=item I<A> I<B> C<-> + +Difference of I<A> and I<B>, the result of subtracting I<B> from I<A>. + +=item I<A> I<B> C<*> + +Product of I<A> and I<B>. + +=item I<A> I<B> C</> + +Quotient when I<A> is divided by I<B>, rounded towards zero. +Division by zero generates an exception. + +=item I<A> I<B> C<%> + +Remainder when I<A> is divided by I<B> with the quotient rounded towards zero. +Division by zero generates an exception. + +=back + +Because the arithmetic operators all have fixed arity and are postfixed, +there is no need for operator precedence, nor for a grouping operator +to override precedence. This is half of the point of RPN. + +An RPN expression can also be interpreted in another way, as a sequence +of operations on a stack, one operation per token. A literal or variable +token pushes a value onto the stack. A binary operator pulls two items +off the stack, performs a calculation with them, and pushes the result +back onto the stack. The stack starts out empty, and at the end of the +expression there must be exactly one value left on the stack. + =head1 SEE ALSO L<XS::Typemap>, L<perlapi>. @@ -234,13 +323,16 @@ L<XS::Typemap>, L<perlapi>. Tim Jenness, E<lt>t.jenness@jach.hawaii.eduE<gt>, Christian Soeller, E<lt>csoelle@mph.auckland.ac.nzE<gt>, -Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt> +Hugo van der Sanden E<lt>hv@crypt.compulink.co.ukE<gt>, +Andrew Main (Zefram) <zefram@fysh.org> =head1 COPYRIGHT AND LICENSE Copyright (C) 2002,2004 Tim Jenness, Christian Soeller, Hugo van der Sanden. All Rights Reserved. +Copyright (C) 2009 Andrew Main (Zefram) <zefram@fysh.org> + This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 48542dd6d0..67c27380dc 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -372,6 +372,224 @@ my_rpeep (pTHX_ OP *o) } } +/** RPN keyword parser **/ + +#define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV) +#define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP) +#define sv_is_string(sv) \ + (!sv_is_glob(sv) && !sv_is_regexp(sv) && \ + (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK))) + +static SV *hintkey_rpn_sv, *hintkey_calcrpn_sv, *hintkey_stufftest_sv; +static SV *hintkey_swaptwostmts_sv; +static int (*next_keyword_plugin)(pTHX_ char *, STRLEN, OP **); + +/* low-level parser helpers */ + +#define PL_bufptr (PL_parser->bufptr) +#define PL_bufend (PL_parser->bufend) + +/* RPN parser */ + +#define parse_var() THX_parse_var(aTHX) +static OP *THX_parse_var(pTHX) +{ + char *s = PL_bufptr; + char *start = s; + PADOFFSET varpos; + OP *padop; + if(*s != '$') croak("RPN syntax error"); + while(1) { + char c = *++s; + if(!isALNUM(c)) break; + } + if(s-start < 2) croak("RPN syntax error"); + lex_read_to(s); + { + /* because pad_findmy() doesn't really use length yet */ + SV *namesv = sv_2mortal(newSVpvn(start, s-start)); + varpos = pad_findmy(SvPVX(namesv), s-start, 0); + } + if(varpos == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(varpos)) + croak("RPN only supports \"my\" variables"); + padop = newOP(OP_PADSV, 0); + padop->op_targ = varpos; + return padop; +} + +#define push_rpn_item(o) \ + (tmpop = (o), tmpop->op_sibling = stack, stack = tmpop) +#define pop_rpn_item() \ + (!stack ? (croak("RPN stack underflow"), (OP*)NULL) : \ + (tmpop = stack, stack = stack->op_sibling, \ + tmpop->op_sibling = NULL, tmpop)) + +#define parse_rpn_expr() THX_parse_rpn_expr(aTHX) +static OP *THX_parse_rpn_expr(pTHX) +{ + OP *stack = NULL, *tmpop; + while(1) { + I32 c; + lex_read_space(0); + c = lex_peek_unichar(0); + switch(c) { + case /*(*/')': case /*{*/'}': { + OP *result = pop_rpn_item(); + if(stack) croak("RPN expression must return a single value"); + return result; + } break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': { + UV val = 0; + do { + lex_read_unichar(0); + val = 10*val + (c - '0'); + c = lex_peek_unichar(0); + } while(c >= '0' && c <= '9'); + push_rpn_item(newSVOP(OP_CONST, 0, newSVuv(val))); + } break; + case '$': { + push_rpn_item(parse_var()); + } break; + case '+': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + lex_read_unichar(0); + push_rpn_item(newBINOP(OP_I_ADD, 0, a, b)); + } break; + case '-': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + lex_read_unichar(0); + push_rpn_item(newBINOP(OP_I_SUBTRACT, 0, a, b)); + } break; + case '*': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + lex_read_unichar(0); + push_rpn_item(newBINOP(OP_I_MULTIPLY, 0, a, b)); + } break; + case '/': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + lex_read_unichar(0); + push_rpn_item(newBINOP(OP_I_DIVIDE, 0, a, b)); + } break; + case '%': { + OP *b = pop_rpn_item(); + OP *a = pop_rpn_item(); + lex_read_unichar(0); + push_rpn_item(newBINOP(OP_I_MODULO, 0, a, b)); + } break; + default: { + croak("RPN syntax error"); + } break; + } + } +} + +#define parse_keyword_rpn() THX_parse_keyword_rpn(aTHX) +static OP *THX_parse_keyword_rpn(pTHX) +{ + OP *op; + lex_read_space(0); + if(lex_peek_unichar(0) != '('/*)*/) + croak("RPN expression must be parenthesised"); + lex_read_unichar(0); + op = parse_rpn_expr(); + if(lex_peek_unichar(0) != /*(*/')') + croak("RPN expression must be parenthesised"); + lex_read_unichar(0); + return op; +} + +#define parse_keyword_calcrpn() THX_parse_keyword_calcrpn(aTHX) +static OP *THX_parse_keyword_calcrpn(pTHX) +{ + OP *varop, *exprop; + lex_read_space(0); + varop = parse_var(); + lex_read_space(0); + if(lex_peek_unichar(0) != '{'/*}*/) + croak("RPN expression must be braced"); + lex_read_unichar(0); + exprop = parse_rpn_expr(); + if(lex_peek_unichar(0) != /*{*/'}') + croak("RPN expression must be braced"); + lex_read_unichar(0); + return newASSIGNOP(OPf_STACKED, varop, 0, exprop); +} + +#define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX) +static OP *THX_parse_keyword_stufftest(pTHX) +{ + I32 c; + bool do_stuff; + lex_read_space(0); + do_stuff = lex_peek_unichar(0) == '+'; + if(do_stuff) { + lex_read_unichar(0); + lex_read_space(0); + } + c = lex_peek_unichar(0); + if(c == ';') { + lex_read_unichar(0); + } else if(c != /*{*/'}') { + croak("syntax error"); + } + if(do_stuff) lex_stuff_pvs(" ", 0); + return newOP(OP_NULL, 0); +} + +#define parse_keyword_swaptwostmts() THX_parse_keyword_swaptwostmts(aTHX) +static OP *THX_parse_keyword_swaptwostmts(pTHX) +{ + OP *a, *b; + a = parse_fullstmt(0); + b = parse_fullstmt(0); + if(a && b) + PL_hints |= HINT_BLOCK_SCOPE; + /* should use append_list(), but that's not part of the public API */ + return !a ? b : !b ? a : newLISTOP(OP_LINESEQ, 0, b, a); +} + +/* plugin glue */ + +#define keyword_active(hintkey_sv) THX_keyword_active(aTHX_ hintkey_sv) +static int THX_keyword_active(pTHX_ SV *hintkey_sv) +{ + HE *he; + if(!GvHV(PL_hintgv)) return 0; + he = hv_fetch_ent(GvHV(PL_hintgv), hintkey_sv, 0, + SvSHARED_HASH(hintkey_sv)); + return he && SvTRUE(HeVAL(he)); +} + +static int my_keyword_plugin(pTHX_ + char *keyword_ptr, STRLEN keyword_len, OP **op_ptr) +{ + if(keyword_len == 3 && strnEQ(keyword_ptr, "rpn", 3) && + keyword_active(hintkey_rpn_sv)) { + *op_ptr = parse_keyword_rpn(); + return KEYWORD_PLUGIN_EXPR; + } else if(keyword_len == 7 && strnEQ(keyword_ptr, "calcrpn", 7) && + keyword_active(hintkey_calcrpn_sv)) { + *op_ptr = parse_keyword_calcrpn(); + return KEYWORD_PLUGIN_STMT; + } else if(keyword_len == 9 && strnEQ(keyword_ptr, "stufftest", 9) && + keyword_active(hintkey_stufftest_sv)) { + *op_ptr = parse_keyword_stufftest(); + return KEYWORD_PLUGIN_STMT; + } else if(keyword_len == 12 && + strnEQ(keyword_ptr, "swaptwostmts", 12) && + keyword_active(hintkey_swaptwostmts_sv)) { + *op_ptr = parse_keyword_swaptwostmts(); + return KEYWORD_PLUGIN_STMT; + } else { + return next_keyword_plugin(aTHX_ keyword_ptr, keyword_len, op_ptr); + } +} + #include "const-c.inc" MODULE = XS::APItest PACKAGE = XS::APItest @@ -1319,3 +1537,13 @@ BOOT: cv = GvCV(*meth); CvLVALUE_on(cv); } + +BOOT: +{ + hintkey_rpn_sv = newSVpvs_share("XS::APItest/rpn"); + hintkey_calcrpn_sv = newSVpvs_share("XS::APItest/calcrpn"); + hintkey_stufftest_sv = newSVpvs_share("XS::APItest/stufftest"); + hintkey_swaptwostmts_sv = newSVpvs_share("XS::APItest/swaptwostmts"); + next_keyword_plugin = PL_keyword_plugin; + PL_keyword_plugin = my_keyword_plugin; +} diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL index 340fc7e910..3af0eb4f96 100644 --- a/ext/XS-APItest/Makefile.PL +++ b/ext/XS-APItest/Makefile.PL @@ -8,7 +8,7 @@ WriteMakefile( 'VERSION_FROM' => 'APItest.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ABSTRACT_FROM => 'APItest.pm', # retrieve abstract from module - AUTHOR => 'Tim Jenness <t.jenness@jach.hawaii.edu>, Christian Soeller <csoelle@mph.auckland.ac.nz>, Hugo van der Sanden <hv@crypt.compulink.co.uk>', + AUTHOR => 'Tim Jenness <t.jenness@jach.hawaii.edu>, Christian Soeller <csoelle@mph.auckland.ac.nz>, Hugo van der Sanden <hv@crypt.compulink.co.uk>, Andrew Main (Zefram) <zefram@fysh.org>', 'C' => ['exception.c', 'core.c', 'notcore.c'], 'OBJECT' => '$(BASEEXT)$(OBJ_EXT) $(O_FILES)', realclean => {FILES => 'const-c.inc const-xs.inc'}, diff --git a/ext/XS-APItest-KeywordRPN/t/multiline.t b/ext/XS-APItest/t/keyword_multiline.t index b5c9c83063..e2cbdb87cb 100644 --- a/ext/XS-APItest-KeywordRPN/t/multiline.t +++ b/ext/XS-APItest/t/keyword_multiline.t @@ -6,7 +6,7 @@ use Test::More tests => 4; my($t, $n); $n = 5; -use XS::APItest::KeywordRPN qw(rpn); +use XS::APItest qw(rpn); $t = rpn($n $n 1 + * #wibble diff --git a/ext/XS-APItest-KeywordRPN/t/keyword_plugin.t b/ext/XS-APItest/t/keyword_plugin.t index 85f4b603a3..a20c952dcb 100644 --- a/ext/XS-APItest-KeywordRPN/t/keyword_plugin.t +++ b/ext/XS-APItest/t/keyword_plugin.t @@ -11,14 +11,14 @@ $num = 5; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN (); + use XS::APItest (); $triangle = rpn($num $num 1 + * 2 /); }; isnt $@, ""; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN qw(rpn); + use XS::APItest qw(rpn); $triangle = rpn($num $num 1 + * 2 /); }; is $@, ""; @@ -26,7 +26,7 @@ is $triangle, 15; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN qw(rpn); + use XS::APItest qw(rpn); $triangle = join(":", "x", rpn($num $num 1 + * 2 /), "y"); }; is $@, ""; @@ -34,7 +34,7 @@ is $triangle, "x:15:y"; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN qw(rpn); + use XS::APItest qw(rpn); $triangle = 1 + rpn($num $num 1 + * 2 /) * 10; }; is $@, ""; @@ -42,7 +42,7 @@ is $triangle, 151; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN qw(rpn); + use XS::APItest qw(rpn); $triangle = rpn($num $num 1 + * 2 /); $triangle++; }; @@ -51,7 +51,7 @@ is $triangle, 16; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN qw(rpn); + use XS::APItest qw(rpn); $triangle = rpn($num $num 1 + * 2 /) $triangle++; }; @@ -59,7 +59,7 @@ isnt $@, ""; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN qw(calcrpn); + use XS::APItest qw(calcrpn); calcrpn $triangle { $num $num 1 + * 2 / } $triangle++; }; @@ -68,7 +68,7 @@ is $triangle, 16; $triangle = undef; eval q{ - use XS::APItest::KeywordRPN qw(calcrpn); + use XS::APItest qw(calcrpn); 123 + calcrpn $triangle { $num $num 1 + * 2 / } ; }; isnt $@, ""; diff --git a/ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t b/ext/XS-APItest/t/stuff_svcur_bug.t index 4fd6e1151b..6d0544cc87 100644 --- a/ext/XS-APItest-KeywordRPN/t/stuff_svcur_bug.t +++ b/ext/XS-APItest/t/stuff_svcur_bug.t @@ -4,7 +4,7 @@ use strict; use Test::More tests => 1; ok 1; -use XS::APItest::KeywordRPN qw(stufftest); +use XS::APItest qw(stufftest); # In the buggy case, a syntax error occurs at EOF. # Adding a semicolon, any following statements, or anything else diff --git a/ext/XS-APItest-KeywordRPN/t/swaptwostmts.t b/ext/XS-APItest/t/swaptwostmts.t index 44e9e7aaae..c11d650962 100644 --- a/ext/XS-APItest-KeywordRPN/t/swaptwostmts.t +++ b/ext/XS-APItest/t/swaptwostmts.t @@ -9,7 +9,7 @@ my $t; $t = ""; eval q{ - use XS::APItest::KeywordRPN (); + use XS::APItest (); $t .= "a"; swaptwostmts $t .= "b"; @@ -20,7 +20,7 @@ isnt $@, ""; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $t .= "a"; swaptwostmts $t .= "b"; @@ -32,7 +32,7 @@ is $t, "acbd"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $t .= "a"; swaptwostmts if(1) { $t .= "b"; } @@ -44,7 +44,7 @@ is $t, "acbd"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $t .= "a"; swaptwostmts $t .= "b"; @@ -56,7 +56,7 @@ is $t, "acbd"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $t .= "a"; swaptwostmts $t .= "b"; @@ -74,7 +74,7 @@ is $t, "acedfcedfcedfbg"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $t .= "a"; swaptwostmts $t .= "b"; @@ -85,7 +85,7 @@ is $t, "acb"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $t .= "a"; swaptwostmts $t .= "b"; @@ -96,7 +96,7 @@ is $t, "acb"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $t .= "a"; swaptwostmts $t .= "b" @@ -105,7 +105,7 @@ isnt $@, ""; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); $_ = $t; $_ .= "a"; swaptwostmts @@ -119,7 +119,7 @@ is $t, "Abd"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); sub add_to_t { $t .= $_[0]; } add_to_t "a"; swaptwostmts @@ -132,7 +132,7 @@ is $t, "acbd"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); { $t .= "a"; } swaptwostmts if(1) { { $t .= "b"; } } @@ -144,7 +144,7 @@ is $t, "acbd"; $t = ""; eval q{ - use XS::APItest::KeywordRPN qw(swaptwostmts); + use XS::APItest qw(swaptwostmts); no warnings "void"; "@{[ $t .= 'a' ]}"; swaptwostmts diff --git a/installman b/installman index 066f7e0461..7665047347 100755 --- a/installman +++ b/installman @@ -68,7 +68,6 @@ $packlist = ExtUtils::Packlist->new("$opts{destdir}$Config{installarchlib}/.pack my %do_not_install = map { ($_ => 1) } qw( Pod/Functions.pm XS/APItest.pm - XS/APItest/KeywordRPN.pm ); # Install the main pod pages. diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index e3fdfaa6a1..168404c9ad 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -737,7 +737,7 @@ issymlink='/bin/test -h' ivdformat='"ld"' ivsize='4' ivtype='long' -known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/APItest/KeywordRPN XS/Typemap attributes re threads threads/shared' +known_extensions='B ByteLoader Cwd DB_File Data/Dumper Devel/DProf Devel/PPPort Devel/Peek Digest/MD5 Encode Fcntl File/Glob Filter/Util/Call GDBM_File I18N/Langinfo IO IPC/SysV List/Util MIME/Base64 NDBM_File ODBM_File Opcode POSIX PerlIO/encoding PerlIO/scalar PerlIO/via SDBM_File Socket Storable Sys/Hostname Sys/Syslog Time/HiRes Unicode/Normalize XS/APItest XS/Typemap attributes re threads threads/shared' ksh='' ld='ld' lddlflags='' diff --git a/symbian/install.cfg b/symbian/install.cfg index 879b3619e7..4b86b8211e 100644 --- a/symbian/install.cfg +++ b/symbian/install.cfg @@ -114,6 +114,5 @@ ext XSLoader # ext Unicode/Normalize nonconst # ext Win32 USELESS # ext XS/APItest USELESS -# ext XS/APItest/KeywordRPN USELESS # ext XS/Typemap nonconst USELESS diff --git a/utils/perlivp.PL b/utils/perlivp.PL index 97832613ee..887533b9cf 100644 --- a/utils/perlivp.PL +++ b/utils/perlivp.PL @@ -216,7 +216,6 @@ if (defined($Config{'extensions'})) { next if $_ eq 'podlators'; # test modules next if $_ eq 'XS/APItest'; - next if $_ eq 'XS/APItest/KeywordRPN'; next if $_ eq 'XS/Typemap'; # VMS$ perl -e "eval ""require \""Devel/DProf.pm\"";"" print $@" # \NT> perl -e "eval \"require 'Devel/DProf.pm'\"; print $@" |