global:
- JOBS=4
matrix:
+ # exercise a variety of build options
+ # threads often cause build issues
- CONFIGURE_ARGS='-Uusethreads'
- CONFIGURE_ARGS='-Dusethreads'
- - CONFIGURE_ARGS='-DPERL_GLOBAL_STRUCT'
+ # it's easy to miss dVAR
- CONFIGURE_ARGS='-DPERL_GLOBAL_STRUCT_PRIVATE'
- - CONFIGURE_ARGS='-Duseshrplib -Dusesitecustomize'
+ # test scripts can be sensitive to PERL_UNICODE, and check long doubles
+ - CONFIGURE_ARGS='-Duseshrplib -Dusesitecustomize -Duselongdouble' PERL_UNICODE='' LANG='en_US.UTF-8'
+ # we've rarely had a problem with non-Englush locales, and exercise quadmath
+ - CONFIGURE_ARGS='-Duseshrplib -Dusequadmath -Dusecbacktrace -Dusethreads' PERL_UNICODE='' LANG='de_DE.UTF-8'
matrix:
fast_finish: true
- "Report for %{repository} (%{commit}) from %{author} (%{elapsed_time})"
- "Status: %{message}"
- "Build URL: %{build_url}"
- - "GitHub URL: https://github.com/p5h/perl5demo/commit/%{commit}" # adjust this url to use the production repo
+ - "GitHub URL: https://github.com/%{repository_slug}/commit/%{commit}"
on_success: change # default: always
on_failure: always # default: always
# use_notice: true
Bruce Barnett <barnett@grymoire.crd.ge.com>
Bruce J. Keeler <bkeelerx@iwa.dp.intel.com>
Bruce P. Schuck <bruce@aps.org>
+Bryan Stenson <bryan@siliconvortex.com>
Bud Huff <BAHUFF@us.oracle.com>
Byron Brummer <byron@omix.com>
C Aditya <caditya@novell.com>
Peter J. Holzer <hjp@hjp.at>
Peter Jaspers-Fayer
Peter John Acklam <pjacklam@online.no>
+Peter Liscovius
Peter Martini <PeterCMartini@GMail.com>
Peter O'Gorman <peter@pogma.com>
Peter Prymmer <PPrymmer@factset.com>
d_asctime_r=''
d_asinh=''
d_atanh=''
+d_attribute_always_inline=''
d_attribute_deprecated=''
d_attribute_format=''
d_attribute_malloc=''
signal_t=''
d_wait4=''
d_waitpid=''
+d_wcrtomb=''
d_wcscmp=''
d_wcstombs=''
d_wcsxfrm=''
fi
$rm -f try try.*
case "$gccversion" in
-1.*) cpp=`./loc gcc-cpp $cpp $pth` ;;
+1*) cpp=`./loc gcc-cpp $cpp $pth` ;;
esac
case "$gccversion" in
'') gccosandvers='' ;;
# gcc 3.* complain about adding -Idirectories that they already know about,
# so we will take those off from locincpth.
case "$gccversion" in
-3.*)
+3*)
echo "main(){}">try.c
for incdir in $locincpth; do
warn=`$cc $ccflags -I$incdir -c try.c 2>&1 | \
case "$hint" in
default|recommended)
case "$gccversion" in
- 1.*) dflt="$dflt -fpcc-struct-return" ;;
+ 1*) dflt="$dflt -fpcc-struct-return" ;;
esac
case "$optimize:$DEBUGGING" in
*-g*:old) dflt="$dflt -DDEBUGGING";;
esac
case "$gccversion" in
- 2.*) if $test -d /etc/conf/kconfig.d &&
+ 2*) if $test -d /etc/conf/kconfig.d &&
$contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1
then
# Interactive Systems (ISC) POSIX mode.
;;
esac
case "$gccversion" in
- 1.*) ;;
+ 1*) ;;
2.[0-8]*) ;;
?*) set strict-aliasing -fno-strict-aliasing
eval $checkccflag
;;
esac
case "$gccversion" in
-1.*) cppflags="$cppflags -D__GNUC__"
+1*) cppflags="$cppflags -D__GNUC__"
esac
case "$mips_type" in
'');;
set backtrace d_backtrace
eval $inlibc
-: add flags if using c backtrace
+: Check if C backtrace is actually supported.
case "$usecbacktrace" in
"") usecbacktrace=$undef ;;
[yY]*|true|$define)
case "$d_backtrace" in
[yY]*|true|$define)
- case " $ccflags " in
- *" -DUSE_C_BACKTRACE "*) ;; # Already there.
- *) ccflags="$ccflags -DUSE_C_BACKTRACE -g" ;;
- esac
;;
*)
echo "This system does not support backtrace" >&4
eval $setvar
$rm -f attrib*
+: Look for GCC-style attribute always_inline
+case "$d_attribute_always_inline" in
+'')
+echo " "
+echo "Checking whether your compiler can handle __attribute__((always_inline)) ..." >&4
+$cat >attrib.c <<'EOCP'
+#include <stdio.h>
+static __inline__ __attribute__((always_inline)) int I_will_always_be_inlined(void);
+EOCP
+if $cc $ccflags -c attrib.c >attrib.out 2>&1 ; then
+ if $contains 'warning' attrib.out >/dev/null 2>&1; then
+ echo "Your C compiler doesn't support __attribute__((always_inline))."
+ val="$undef"
+ else
+ echo "Your C compiler supports __attribute__((always_inline))."
+ val="$define"
+ fi
+else
+ echo "Your C compiler doesn't seem to understand __attribute__ at all."
+ val="$undef"
+fi
+;;
+*) val="$d_attribute_always_inline" ;;
+esac
+set d_attribute_always_inline
+eval $setvar
+$rm -f attrib*
+
: see if getpgrp exists
set getpgrp d_getpgrp
eval $inlibc
echo "Checking to see if you have isless..." >&4
$cat >try.c <<EOCP
#include <math.h>
-int main() { return isless(0.0); }
+int main() { return isless(2.0, 1.0); }
EOCP
set try
if eval $compile; then
;;
esac
+: Checking 32bit alignedness
$cat <<EOM
Checking to see whether you can access character data unalignedly...
-
-We assume only aligned access is permitted.
EOM
-: Checking 32bit alignedness
-: We no longer check and assume it is required.
case "$d_u32align" in
-'') d_u32align="$define" ;;
+'') $cat >try.c <<EOCP
+#include <stdio.h>
+#$i_stdlib I_STDLIB
+#ifdef I_STDLIB
+#include <stdlib.h>
+#endif
+#define U32 $u32type
+#define BYTEORDER 0x$byteorder
+#define U8 $u8type
+#include <signal.h>
+#ifdef SIGBUS
+$signal_t bletch(int s) { exit(4); }
+#endif
+int main() {
+#if BYTEORDER == 0x1234 || BYTEORDER == 0x4321
+ volatile U8 buf[8];
+ volatile U32 *up;
+ int i;
+
+ if (sizeof(U32) != 4) {
+ printf("sizeof(U32) is not 4, but %d\n", sizeof(U32));
+ exit(1);
+ }
+
+ fflush(stdout);
+
+#ifdef SIGBUS
+ signal(SIGBUS, bletch);
+#endif
+
+ buf[0] = 0;
+ buf[1] = 0;
+ buf[2] = 0;
+ buf[3] = 1;
+ buf[4] = 0;
+ buf[5] = 0;
+ buf[6] = 0;
+ buf[7] = 1;
+
+ for (i = 0; i < 4; i++) {
+ up = (U32*)(buf + i);
+ if (! ((*up == 1 << (8*i)) || /* big-endian */
+ (*up == 1 << (8*(3-i))) /* little-endian */
+ )
+ )
+ {
+ printf("read failed (%x)\n", *up);
+ exit(2);
+ }
+ }
+
+ /* write test */
+ for (i = 0; i < 4; i++) {
+ up = (U32*)(buf + i);
+ *up = 0xBeef;
+ if (*up != 0xBeef) {
+ printf("write failed (%x)\n", *up);
+ exit(3);
+ }
+ }
+
+ exit(0);
+#else
+ printf("1\n");
+ exit(1);
+#endif
+ return 0;
+}
+EOCP
+set try
+if eval $compile_ok; then
+ echo "(Testing for character data alignment may crash the test. That's okay.)" >&4
+ $run ./try 2>&1 >/dev/null
+ case "$?" in
+ 0) cat >&4 <<EOM
+You can access character data pretty unalignedly.
+EOM
+ d_u32align="$undef"
+ ;;
+ *) cat >&4 <<EOM
+It seems that you must access character data in an aligned manner.
+EOM
+ d_u32align="$define"
+ ;;
+ esac
+else
+ rp='Can you access character data at unaligned addresses?'
+ dflt='n'
+ . ./myread
+ case "$ans" in
+ [yY]*) d_u32align="$undef" ;;
+ *) d_u32align="$define" ;;
+ esac
+fi
+$rm_try
+;;
esac
: see if ualarm exists
set waitpid d_waitpid
eval $inlibc
+: see if wcrtomb exists
+set wcrtomb d_wcrtomb
+eval $inlibc
+
: look for wcscmp
echo " "
$cat >try.c <<'EOCP'
: add -D_FORTIFY_SOURCE if feasible and not already there
case "$gccversion" in
-[456789].*|[1-9][0-9]*) case "$optimize$ccflags" in
+[456789].*) case "$optimize$ccflags" in
*-O*) case "$ccflags$cppsymbols" in
*_FORTIFY_SOURCE=*) # Don't add it again.
echo "You seem to have -D_FORTIFY_SOURCE already, not adding it." >&4
d_atanh='$d_atanh'
d_atolf='$d_atolf'
d_atoll='$d_atoll'
+d_attribute_always_inline='$d_attribute_always_inline'
d_attribute_deprecated='$d_attribute_deprecated'
d_attribute_format='$d_attribute_format'
d_attribute_malloc='$d_attribute_malloc'
d_vsnprintf='$d_vsnprintf'
d_wait4='$d_wait4'
d_waitpid='$d_waitpid'
+d_wcrtomb='$d_wcrtomb'
d_wcscmp='$d_wcscmp'
d_wcstombs='$d_wcstombs'
d_wcsxfrm='$d_wcsxfrm'
alignbytes='4'
aphostname='/bin/hostname'
api_revision='5'
-api_subversion='6'
+api_subversion='7'
api_version='31'
-api_versionstring='5.31.6'
+api_versionstring='5.31.7'
ar='ar'
-archlib='/usr/lib/perl5/5.31.6/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.31.6/armv4l-linux'
+archlib='/usr/lib/perl5/5.31.7/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.31.7/armv4l-linux'
archname64=''
archname='armv4l-linux'
archobjs=''
cat='cat'
cc='cc'
cccdlflags='-fpic'
-ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.31.6/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.31.7/armv4l-linux/CORE'
ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccname='arm-linux-gcc'
d_atanh='undef'
d_atolf='undef'
d_atoll='define'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='define'
d_wait4='define'
d_waitpid='define'
+d_wcrtomb='undef'
d_wcscmp='undef'
d_wcstombs='define'
d_wcsxfrm='undef'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.31.6/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.31.7/armv4l-linux'
installbin='./install_me_here/usr/bin'
installhtml1dir=''
installhtml3dir=''
installman3dir='./install_me_here/usr/share/man/man3'
installprefix='./install_me_here/usr'
installprefixexp='./install_me_here/usr'
-installprivlib='./install_me_here/usr/lib/perl5/5.31.6'
+installprivlib='./install_me_here/usr/lib/perl5/5.31.7'
installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.31.6/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.31.7/armv4l-linux'
installsitebin='./install_me_here/usr/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.31.6'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.31.7'
installsiteman1dir='./install_me_here/usr/share/man/man1'
installsiteman3dir='./install_me_here/usr/share/man/man3'
installsitescript='./install_me_here/usr/bin'
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/usr/lib/perl5/5.31.6'
-privlibexp='/usr/lib/perl5/5.31.6'
+privlib='/usr/lib/perl5/5.31.7'
+privlibexp='/usr/lib/perl5/5.31.7'
procselfexe='"/proc/self/exe"'
prototype='define'
ptrsize='4'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0'
sig_size='68'
signal_t='void'
-sitearch='/usr/lib/perl5/site_perl/5.31.6/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.31.6/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.31.7/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.31.7/armv4l-linux'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.31.6'
+sitelib='/usr/lib/perl5/site_perl/5.31.7'
sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.31.6'
+sitelibexp='/usr/lib/perl5/site_perl/5.31.7'
siteman1dir='/usr/share/man/man1'
siteman1direxp='/usr/share/man/man1'
siteman3dir='/usr/share/man/man3'
strerror_r_proto='0'
strings='/usr/include/string.h'
submit=''
-subversion='6'
+subversion='7'
sysman='/usr/share/man/man1'
tail=''
tar=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.31.6'
-version_patchlevel_string='version 31 subversion 6'
+version='5.31.7'
+version_patchlevel_string='version 31 subversion 7'
versiononly='undef'
vi=''
xlibpth='/usr/lib/386 /lib/386'
config_argc=0
PERL_REVISION=5
PERL_VERSION=31
-PERL_SUBVERSION=6
+PERL_SUBVERSION=7
PERL_API_REVISION=5
PERL_API_VERSION=31
-PERL_API_SUBVERSION=6
+PERL_API_SUBVERSION=7
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
alignbytes='4'
aphostname='/bin/hostname'
api_revision='5'
-api_subversion='6'
+api_subversion='7'
api_version='31'
-api_versionstring='5.31.6'
+api_versionstring='5.31.7'
ar='ar'
-archlib='/usr/lib/perl5/5.31.6/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.31.6/armv4l-linux'
+archlib='/usr/lib/perl5/5.31.7/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.31.7/armv4l-linux'
archname64=''
archname='armv4l-linux'
archobjs=''
cat='cat'
cc='arm-none-linux-gnueabi-gcc'
cccdlflags='-fpic'
-ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.31.6/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.31.7/armv4l-linux/CORE'
ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
ccname='arm-linux-gcc'
d_atanh='undef'
d_atolf='undef'
d_atoll='define'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='define'
d_wait4='define'
d_waitpid='define'
+d_wcrtomb='undef'
d_wcscmp='undef'
d_wcstombs='define'
d_wcsxfrm='undef'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.31.6/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.31.7/armv4l-linux'
installbin='./install_me_here/usr/bin'
installhtml1dir=''
installhtml3dir=''
installman3dir='./install_me_here/usr/share/man/man3'
installprefix='./install_me_here/usr'
installprefixexp='./install_me_here/usr'
-installprivlib='./install_me_here/usr/lib/perl5/5.31.6'
+installprivlib='./install_me_here/usr/lib/perl5/5.31.7'
installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.31.6/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.31.7/armv4l-linux'
installsitebin='./install_me_here/usr/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.31.6'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.31.7'
installsiteman1dir='./install_me_here/usr/share/man/man1'
installsiteman3dir='./install_me_here/usr/share/man/man3'
installsitescript='./install_me_here/usr/bin'
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/usr/lib/perl5/5.31.6'
-privlibexp='/usr/lib/perl5/5.31.6'
+privlib='/usr/lib/perl5/5.31.7'
+privlibexp='/usr/lib/perl5/5.31.7'
procselfexe='"/proc/self/exe"'
prototype='define'
ptrsize='4'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0'
sig_size='68'
signal_t='void'
-sitearch='/usr/lib/perl5/site_perl/5.31.6/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.31.6/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.31.7/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.31.7/armv4l-linux'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.31.6'
+sitelib='/usr/lib/perl5/site_perl/5.31.7'
sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.31.6'
+sitelibexp='/usr/lib/perl5/site_perl/5.31.7'
siteman1dir='/usr/share/man/man1'
siteman1direxp='/usr/share/man/man1'
siteman3dir='/usr/share/man/man3'
strerror_r_proto='0'
strings='/usr/include/string.h'
submit=''
-subversion='6'
+subversion='7'
sysman='/usr/share/man/man1'
tail=''
tar=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.31.6'
-version_patchlevel_string='version 31 subversion 6'
+version='5.31.7'
+version_patchlevel_string='version 31 subversion 7'
versiononly='undef'
vi=''
xlibpth='/usr/lib/386 /lib/386'
config_argc=0
PERL_REVISION=5
PERL_VERSION=31
-PERL_SUBVERSION=6
+PERL_SUBVERSION=7
PERL_API_REVISION=5
PERL_API_VERSION=31
-PERL_API_SUBVERSION=6
+PERL_API_SUBVERSION=7
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
=item Directories for the perl distribution
-By default, Configure will use the following directories for 5.31.6.
+By default, Configure will use the following directories for 5.31.7.
$version is the full perl version number, including subversion, e.g.
5.12.3, and $archname is a string like sun4-sunos,
determined by Configure. The full definitions of all Configure
=head1 Coexistence with earlier versions of perl 5
-Perl 5.31.6 is not binary compatible with earlier versions of Perl.
+Perl 5.31.7 is not binary compatible with earlier versions of Perl.
In other words, you will have to recompile your XS modules.
In general, you can usually safely upgrade from one stable version of Perl
libraries after 5.6.0, but not for executables. TODO?) One convenient
way to do this is by using a separate prefix for each version, such as
- sh Configure -Dprefix=/opt/perl5.31.6
+ sh Configure -Dprefix=/opt/perl5.31.7
-and adding /opt/perl5.31.6/bin to the shell PATH variable. Such users
+and adding /opt/perl5.31.7/bin to the shell PATH variable. Such users
may also wish to add a symbolic link /usr/local/bin/perl so that
scripts can still start with #!/usr/local/bin/perl.
subversions may not have all the compatibility wrinkles ironed out
yet.
-=head2 Upgrading from 5.31.5 or earlier
+=head2 Upgrading from 5.31.6 or earlier
-B<Perl 5.31.6 may not be binary compatible with Perl 5.31.5 or
+B<Perl 5.31.7 may not be binary compatible with Perl 5.31.6 or
earlier Perl releases.> Perl modules having binary parts
(meaning that a C compiler is used) will have to be recompiled to be
-used with 5.31.6. If you find you do need to rebuild an extension with
-5.31.6, you may safely do so without disturbing the older
+used with 5.31.7. If you find you do need to rebuild an extension with
+5.31.7, you may safely do so without disturbing the older
installations. (See L<"Coexistence with earlier versions of perl 5">
above.)
print("$f\n");
}
-in Linux with perl-5.31.6 is as follows (under $Config{prefix}):
+in Linux with perl-5.31.7 is as follows (under $Config{prefix}):
./bin/perl
- ./lib/perl5/5.31.6/strict.pm
- ./lib/perl5/5.31.6/warnings.pm
- ./lib/perl5/5.31.6/i686-linux/File/Glob.pm
- ./lib/perl5/5.31.6/feature.pm
- ./lib/perl5/5.31.6/XSLoader.pm
- ./lib/perl5/5.31.6/i686-linux/auto/File/Glob/Glob.so
+ ./lib/perl5/5.31.7/strict.pm
+ ./lib/perl5/5.31.7/warnings.pm
+ ./lib/perl5/5.31.7/i686-linux/File/Glob.pm
+ ./lib/perl5/5.31.7/feature.pm
+ ./lib/perl5/5.31.7/XSLoader.pm
+ ./lib/perl5/5.31.7/i686-linux/auto/File/Glob/Glob.so
Secondly, for perl-5.10.1, the Debian perl-base package contains 591
files, (of which 510 are for lib/unicore) totaling about 3.5MB in its
cpan/ExtUtils-MakeMaker/t/testdata/reallylongdirectoryname/arch1/Config.pm test data for MakeMaker
cpan/ExtUtils-MakeMaker/t/testdata/reallylongdirectoryname/arch2/Config.pm test data for MakeMaker
cpan/ExtUtils-MakeMaker/t/testlib.t See if ExtUtils::testlib works
+cpan/ExtUtils-MakeMaker/t/testrules.yml
cpan/ExtUtils-MakeMaker/t/unicode.t
cpan/ExtUtils-MakeMaker/t/VERSION_FROM.t See if MakeMaker's VERSION_FROM works
cpan/ExtUtils-MakeMaker/t/vstrings.t
dist/Filter-Simple/t/filter_only.t See if Filter::Simple works
dist/Filter-Simple/t/import.t See if Filter::Simple works
dist/Filter-Simple/t/lib/Filter/Simple/CodeNoComments.pm Helper file for Filter::Simple tests
+dist/Filter-Simple/t/lib/Filter/Simple/ExeNoComments.pm Helper file for Filter::Simple tests
dist/Filter-Simple/t/lib/Filter/Simple/ExportTest.pm Helper file for Filter::Simple tests
dist/Filter-Simple/t/lib/Filter/Simple/FilterOnlyTest.pm Helper file for Filter::Simple tests
dist/Filter-Simple/t/lib/Filter/Simple/FilterTest.pm Helper file for Filter::Simple tests
dist/Filter-Simple/t/lib/Filter/Simple/ImportTest.pm Helper file for Filter::Simple tests
dist/Filter-Simple/t/no.t See if Filter::Simple works
+dist/FindBin/lib/FindBin.pm Find name of currently executing program
+dist/FindBin/t/FindBin.t See if FindBin works
dist/I18N-Collate/lib/I18N/Collate.pm Routines to do strxfrm-based collation
dist/I18N-Collate/t/I18N-Collate.t See if I18N::Collate works
dist/I18N-LangTags/ChangeLog I18N::LangTags
ext/Sys-Hostname/Hostname.xs Sys::Hostname extension external subroutines
ext/Sys-Hostname/t/Hostname.t See if Sys::Hostname works
ext/Tie-Hash-NamedCapture/NamedCapture.pm Implements %- and %+ behaviour
-ext/Tie-Hash-NamedCapture/NamedCapture.xs Implements %- and %+ behaviour
ext/Tie-Hash-NamedCapture/t/tiehash.t Tests TIEHASH
ext/Tie-Memoize/lib/Tie/Memoize.pm Base class for memoized tied hashes
ext/Tie-Memoize/t/Tie-Memoize.t Test for Tie::Memoize
lib/FileHandle.t See if FileHandle works
lib/filetest.pm For "use filetest"
lib/filetest.t See if filetest works
-lib/FindBin.pm Find name of currently executing program
-lib/FindBin.t See if FindBin works
lib/Getopt/Std.pm Fetch command options (getopt, getopts)
lib/Getopt/Std.t See if Getopt::Std and Getopt::Long work
lib/h2ph.t See if h2ph works like it should
pod/perl5313delta.pod Perl changes in version 5.31.3
pod/perl5314delta.pod Perl changes in version 5.31.4
pod/perl5315delta.pod Perl changes in version 5.31.5
+pod/perl5316delta.pod Perl changes in version 5.31.6
pod/perl561delta.pod Perl changes in version 5.6.1
pod/perl56delta.pod Perl changes in version 5.6
pod/perl581delta.pod Perl changes in version 5.8.1
t/base/term.t See if various terms work
t/base/translate.t See if character set translation works
t/base/while.t See if while work
-t/benchmark/rt26188-speed-up-keys-on-empty-hash.t Benchmark if keys on empty hashes is fast enough
+t/benchmark/gh7094-speed-up-keys-on-empty-hash.t Benchmark if keys on empty hashes is fast enough
t/bigmem/hash.t Check hashing too large strings throws an exception
t/bigmem/index.t Check that index() handles large offsets
t/bigmem/pos.t Check that pos() handles large offsets
t/lib/Devel/switchd.pm Module for t/run/switchd.t
t/lib/Devel/switchd_empty.pm Module for t/run/switchd.t
t/lib/Devel/switchd_goto.pm Module for t/run/switchd.t
+t/lib/feature/bits Tests for feature bit handling
t/lib/feature/bundle Tests for feature bundles
t/lib/feature/implicit Tests for implicit loading of feature.pm
t/lib/feature/nonesuch Tests for enabling/disabling nonexistent feature
t/lib/feature/removed Tests for enabling/disabling removed feature
t/lib/feature/say Tests for enabling/disabling say feature
t/lib/feature/switch Tests for enabling/disabling switch feature
+t/lib/GH_15109/Apack.pm test Module for caller.t
+t/lib/GH_15109/Bpack.pm test Module for caller.t
+t/lib/GH_15109/Cpack.pm test Module for caller.t
t/lib/h2ph.h Test header file for h2ph
t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison
t/lib/locale/latin1 Part of locale.t in Latin 1
t/op/exists_sub.t See if exists(&sub) works
t/op/exp.t See if math functions work
t/op/fh.t See if filehandles work
-t/op/filehandle.t Tests for https://rt.perl.org/rt3/Ticket/Display.html?id=72586
+t/op/filehandle.t Tests for https://github.com/Perl/perl5/issues/10133
t/op/filetest.t See if file tests work
t/op/filetest_stack_ok.t See if file tests leave their argument on the stack
t/op/filetest_t.t See if -t file test works
t/op/index_thr.t See if index works in another thread
t/op/infnan.t See if inf/nan work
t/op/int.t See if int works
+t/op/isa.t See if isa works
t/op/join.t See if join works
t/op/kill0.t See if kill works
t/op/kill0_child Process tree script that is kill()ed
"dist/ExtUtils-CBuilder",
"dist/ExtUtils-ParseXS",
"dist/Filter-Simple",
+ "dist/FindBin",
"dist/I18N-Collate",
"dist/if",
"dist/IO/",
"url" : "https://github.com/Perl/perl5"
}
},
- "version" : "5.031006",
+ "version" : "5.031007",
"x_serialization_backend" : "JSON::PP version 4.04"
}
- dist/ExtUtils-CBuilder
- dist/ExtUtils-ParseXS
- dist/Filter-Simple
+ - dist/FindBin
- dist/I18N-Collate
- dist/if
- dist/IO/
homepage: https://www.perl.org/
license: https://dev.perl.org/licenses/
repository: https://github.com/Perl/perl5
-version: '5.031006'
+version: '5.031007'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
$spitshell >>$Makefile <<'!NO!SUBS!'
-perltoc_pod_prereqs = extra.pods pod/perl5316delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod
+perltoc_pod_prereqs = extra.pods pod/perl5317delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod
generated_pods = pod/perltoc.pod $(perltoc_pod_prereqs)
generated_headers = uudmap.h bitcount.h mg_data.h
pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST
$(MINIPERL) pod/perlmodlib.PL -q
-pod/perl5316delta.pod: pod/perldelta.pod
- $(RMS) pod/perl5316delta.pod
- $(LNS) perldelta.pod pod/perl5316delta.pod
+pod/perl5317delta.pod: pod/perldelta.pod
+ $(RMS) pod/perl5317delta.pod
+ $(LNS) perldelta.pod pod/perl5317delta.pod
extra.pods: $(MINIPERL_EXE)
-@test ! -f extra.pods || rm -f `cat extra.pods`
# Here comes the CW tools - TO BE FILLED TO BUILD WITH CW -
-MODULE_DESC = "Perl 5.31.6 for NetWare"
+MODULE_DESC = "Perl 5.31.7 for NetWare"
CCTYPE = CodeWarrior
C_COMPILER = mwccnlm -c
CPP_COMPILER = mwccnlm
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-INST_VER = \5.31.6
+INST_VER = \5.31.7
#
# Comment this out if you DON'T want your perl installation to have
d_atanh='undef'
d_atolf='undef'
d_atoll='undef'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='undef'
d_wait4='undef'
d_waitpid='define'
+d_wcrtomb='undef'
d_wcscmp='undef'
d_wcstombs='define'
d_wcsxfrm='undef'
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "c:\\perl\\5.31.6\\lib\\NetWare-x86-multi-thread" /**/
+#define ARCHLIB "c:\\perl\\5.31.7\\lib\\NetWare-x86-multi-thread" /**/
/*#define ARCHLIB_EXP "" /**/
/* ARCHNAME:
* This symbol is the filename expanded version of the BIN symbol, for
* programs that do not want to deal with that at run-time.
*/
-#define BIN "c:\\perl\\5.31.6\\bin\\NetWare-x86-multi-thread" /**/
-#define BIN_EXP "c:\\perl\\5.31.6\\bin\\NetWare-x86-multi-thread" /**/
+#define BIN "c:\\perl\\5.31.7\\bin\\NetWare-x86-multi-thread" /**/
+#define BIN_EXP "c:\\perl\\5.31.7\\bin\\NetWare-x86-multi-thread" /**/
/* BYTEORDER:
* This symbol holds the hexadecimal constant defined in byteorder,
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "c:\\perl\\site\\5.31.6\\lib\\NetWare-x86-multi-thread" /**/
+#define SITEARCH "c:\\perl\\site\\5.31.7\\lib\\NetWare-x86-multi-thread" /**/
/*#define SITEARCH_EXP "" /**/
/* SITELIB:
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-#define SITELIB "c:\\perl\\site\\5.31.6\\lib" /**/
+#define SITELIB "c:\\perl\\site\\5.31.7\\lib" /**/
/*#define SITELIB_EXP "" /**/
#define SITELIB_STEM "" /**/
d_re_comp (d_regcmp.U):
This variable conditionally defines the HAS_RECOMP symbol, which
indicates to the C program that the re_comp() routine is available
- for regular patern matching (usally on BSD). If so, it is likely that
+ for regular pattern matching (usually on BSD). If so, it is likely that
re_exec() exists.
d_readdir (d_readdir.U):
d_regcmp (d_regcmp.U):
This variable conditionally defines the HAS_REGCMP symbol, which
indicates to the C program that the regcmp() routine is available
- for regular patern matching (usally on System V).
+ for regular pattern matching (usually on System V).
d_regcomp (d_regcmp.U):
This variable conditionally defines the HAS_REGCOMP symbol, which
indicates to the C program that the regcomp() routine is available
- for regular patern matching (usally on POSIX.2 conforming systems).
+ for regular pattern matching (usually on POSIX.2 conforming systems).
d_remainder (d_remainder.U):
This variable conditionally defines the HAS_REMAINDER symbol, which
},
'Compress::Raw::Bzip2' => {
- 'DISTRIBUTION' => 'PMQS/Compress-Raw-Bzip2-2.090.tar.gz',
+ 'DISTRIBUTION' => 'PMQS/Compress-Raw-Bzip2-2.093.tar.gz',
'FILES' => q[cpan/Compress-Raw-Bzip2],
'EXCLUDED' => [
qr{^t/Test/},
},
'Compress::Raw::Zlib' => {
- 'DISTRIBUTION' => 'PMQS/Compress-Raw-Zlib-2.090.tar.gz',
+ 'DISTRIBUTION' => 'PMQS/Compress-Raw-Zlib-2.093.tar.gz',
'FILES' => q[cpan/Compress-Raw-Zlib],
'EXCLUDED' => [
qr{^examples/},
},
'CPAN' => {
- 'DISTRIBUTION' => 'ANDK/CPAN-2.27-TRIAL2.tar.gz',
+ 'DISTRIBUTION' => 'ANDK/CPAN-2.27.tar.gz',
'FILES' => q[cpan/CPAN],
'EXCLUDED' => [
qr{^distroprefs/},
},
'Devel::PPPort' => {
- 'DISTRIBUTION' => 'ATOOMIC/Devel-PPPort-3.55.tar.gz',
+ 'DISTRIBUTION' => 'ATOOMIC/Devel-PPPort-3.56.tar.gz',
'FILES' => q[dist/Devel-PPPort],
'EXCLUDED' => [
'PPPort.pm', # we use PPPort_pm.PL instead
},
'ExtUtils::MakeMaker' => {
- 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.38.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.42.tar.gz',
'FILES' => q[cpan/ExtUtils-MakeMaker],
'EXCLUDED' => [
qr{^t/lib/Test/},
],
},
+ 'FindBin' => {
+ 'DISTRIBUTION' => 'XSAWYERX/FindBin-0.000.tar.gz',
+ 'FILES' => q[dist/FindBin],
+ },
+
'Getopt::Long' => {
'DISTRIBUTION' => 'JV/Getopt-Long-2.51.tar.gz',
'FILES' => q[cpan/Getopt-Long],
},
'IO-Compress' => {
- 'DISTRIBUTION' => 'PMQS/IO-Compress-2.090.tar.gz',
+ 'DISTRIBUTION' => 'PMQS/IO-Compress-2.093.tar.gz',
'FILES' => q[cpan/IO-Compress],
'EXCLUDED' => [
qr{^examples/},
},
'Module::CoreList' => {
- 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20191110.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20191120.tar.gz',
'FILES' => q[dist/Module-CoreList],
},
},
'Net::Ping' => {
- 'DISTRIBUTION' => 'RURBAN/Net-Ping-2.71.tar.gz',
+ 'DISTRIBUTION' => 'RURBAN/Net-Ping-2.72.tar.gz',
'FILES' => q[dist/Net-Ping],
'EXCLUDED' => [
qw(README.md.PL),
},
'Test::Simple' => {
- 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302169.tar.gz',
+ 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302170.tar.gz',
'FILES' => q[cpan/Test-Simple],
'EXCLUDED' => [
qr{^examples/},
lib/File/Copy.{pm,t}
lib/File/stat{.pm,.t,-7896.t}
lib/FileHandle.{pm,t}
- lib/FindBin.{pm,t}
lib/Getopt/Std.{pm,t}
lib/Internals.pod
lib/Internals.t
next
if $uri =~ m{^https?://rt.perl.org/(?:rt3/)?Ticket/Display.html?id=\d+$};
+ # no need to hit github
+ next
+ if $uri =~ m{^https?://(?:www\.)?github\.com/[pP]erl/perl5/issues/\d+$};
+
# no need to hit rt.cpan.org
next
if $uri =~ m{^https?://rt.cpan.org/Public/Bug/Display.html?id=\d+$};
alignbytes='8'
aphostname=''
api_revision='5'
-api_subversion='6'
+api_subversion='7'
api_version='31'
-api_versionstring='5.31.6'
+api_versionstring='5.31.7'
ar='ar'
-archlib='/opt/perl/lib/5.31.6/x86_64-linux'
-archlibexp='/opt/perl/lib/5.31.6/x86_64-linux'
+archlib='/opt/perl/lib/5.31.7/x86_64-linux'
+archlibexp='/opt/perl/lib/5.31.7/x86_64-linux'
archname64=''
archname='x86_64-linux'
archobjs=''
d_atanh='define'
d_atolf='undef'
d_atoll='define'
+d_attribute_always_inline='undef'
d_attribute_deprecated='define'
d_attribute_format='define'
d_attribute_malloc='define'
d_vsnprintf='define'
d_wait4='define'
d_waitpid='define'
+d_wcrtomb='undef'
d_wcscmp='define'
d_wcstombs='define'
d_wcsxfrm='define'
incpth='/usr/lib/gcc/x86_64-linux-gnu/4.9/include /usr/local/include /usr/lib/gcc/x86_64-linux-gnu/4.9/include-fixed /usr/include/x86_64-linux-gnu /usr/include'
inews=''
initialinstalllocation='/opt/perl/bin'
-installarchlib='/opt/perl/lib/5.31.6/x86_64-linux'
+installarchlib='/opt/perl/lib/5.31.7/x86_64-linux'
installbin='/opt/perl/bin'
installhtml1dir=''
installhtml3dir=''
installman3dir='/opt/perl/man/man3'
installprefix='/opt/perl'
installprefixexp='/opt/perl'
-installprivlib='/opt/perl/lib/5.31.6'
+installprivlib='/opt/perl/lib/5.31.7'
installscript='/opt/perl/bin'
-installsitearch='/opt/perl/lib/site_perl/5.31.6/x86_64-linux'
+installsitearch='/opt/perl/lib/site_perl/5.31.7/x86_64-linux'
installsitebin='/opt/perl/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='/opt/perl/lib/site_perl/5.31.6'
+installsitelib='/opt/perl/lib/site_perl/5.31.7'
installsiteman1dir='/opt/perl/man/man1'
installsiteman3dir='/opt/perl/man/man3'
installsitescript='/opt/perl/bin'
perl_static_inline='static __inline__'
perladmin='yourname@yourhost.yourplace.com'
perllibs='-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc'
-perlpath='/opt/perl/bin/perl5.31.6'
+perlpath='/opt/perl/bin/perl5.31.7'
pg='pg'
phostname=''
pidtype='pid_t'
pr=''
prefix='/opt/perl'
prefixexp='/opt/perl'
-privlib='/opt/perl/lib/5.31.6'
-privlibexp='/opt/perl/lib/5.31.6'
+privlib='/opt/perl/lib/5.31.7'
+privlibexp='/opt/perl/lib/5.31.7'
procselfexe='"/proc/self/exe"'
ptrsize='8'
quadkind='2'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 6, 17, 29, 31, 0'
sig_size='69'
signal_t='void'
-sitearch='/opt/perl/lib/site_perl/5.31.6/x86_64-linux'
-sitearchexp='/opt/perl/lib/site_perl/5.31.6/x86_64-linux'
+sitearch='/opt/perl/lib/site_perl/5.31.7/x86_64-linux'
+sitearchexp='/opt/perl/lib/site_perl/5.31.7/x86_64-linux'
sitebin='/opt/perl/bin'
sitebinexp='/opt/perl/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/opt/perl/lib/site_perl/5.31.6'
+sitelib='/opt/perl/lib/site_perl/5.31.7'
sitelib_stem='/opt/perl/lib/site_perl'
-sitelibexp='/opt/perl/lib/site_perl/5.31.6'
+sitelibexp='/opt/perl/lib/site_perl/5.31.7'
siteman1dir='/opt/perl/man/man1'
siteman1direxp='/opt/perl/man/man1'
siteman3dir='/opt/perl/man/man3'
ssizetype='ssize_t'
st_ino_sign='1'
st_ino_size='8'
-startperl='#!/opt/perl/bin/perl5.31.6'
+startperl='#!/opt/perl/bin/perl5.31.7'
startsh='#!/bin/sh'
static_ext=' '
stdchar='char'
stdio_stream_array=''
strerror_r_proto='0'
submit=''
-subversion='6'
+subversion='7'
sysman='/usr/share/man/man1'
sysroot=''
tail=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.31.6'
-version_patchlevel_string='version 31 subversion 6'
+version='5.31.7'
+version_patchlevel_string='version 31 subversion 7'
versiononly='define'
vi=''
xlibpth='/usr/lib/386 /lib/386'
zip='zip'
PERL_REVISION=5
PERL_VERSION=31
-PERL_SUBVERSION=6
+PERL_SUBVERSION=7
PERL_API_REVISION=5
PERL_API_VERSION=31
-PERL_API_SUBVERSION=6
+PERL_API_SUBVERSION=7
PERL_PATCHLEVEL=''
PERL_CONFIG_SH=true
: Variables propagated from previous config.sh file.
/* HAS_REGCOMP:
* This symbol, if defined, indicates that the regcomp() routine is
- * available to do some regular patern matching (usually on POSIX.2
+ * available to do some regular pattern matching (usually on POSIX.2
* conforming systems).
*/
#define HAS_REGCOMP /* POSIX.2 */
* This symbol contains the ~name expanded version of ARCHLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define ARCHLIB "/opt/perl/lib/5.31.6/x86_64-linux" /**/
-#define ARCHLIB_EXP "/opt/perl/lib/5.31.6/x86_64-linux" /**/
+#define ARCHLIB "/opt/perl/lib/5.31.7/x86_64-linux" /**/
+#define ARCHLIB_EXP "/opt/perl/lib/5.31.7/x86_64-linux" /**/
/* BIN:
* This symbol holds the path of the bin directory where the package will
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "/opt/perl/lib/5.31.6" /**/
-#define PRIVLIB_EXP "/opt/perl/lib/5.31.6" /**/
+#define PRIVLIB "/opt/perl/lib/5.31.7" /**/
+#define PRIVLIB_EXP "/opt/perl/lib/5.31.7" /**/
/* SITEARCH:
* This symbol contains the name of the private library for this package.
* This symbol contains the ~name expanded version of SITEARCH, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define SITEARCH "/opt/perl/lib/site_perl/5.31.6/x86_64-linux" /**/
-#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.31.6/x86_64-linux" /**/
+#define SITEARCH "/opt/perl/lib/site_perl/5.31.7/x86_64-linux" /**/
+#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.31.7/x86_64-linux" /**/
/* SITELIB:
* This symbol contains the name of the private library for this package.
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-#define SITELIB "/opt/perl/lib/site_perl/5.31.6" /**/
-#define SITELIB_EXP "/opt/perl/lib/site_perl/5.31.6" /**/
+#define SITELIB "/opt/perl/lib/site_perl/5.31.7" /**/
+#define SITELIB_EXP "/opt/perl/lib/site_perl/5.31.7" /**/
#define SITELIB_STEM "/opt/perl/lib/site_perl" /**/
/* PERL_VENDORARCH:
* script to make sure (one hopes) that it runs with perl and not
* some shell.
*/
-#define STARTPERL "#!/opt/perl/bin/perl5.31.6" /**/
+#define STARTPERL "#!/opt/perl/bin/perl5.31.7" /**/
/* HAS_STDIO_STREAM_ARRAY:
* This symbol, if defined, tells that there is an array
=head1 EPIGRAPHS
+=head2 v5.31.6 - Neal Stephenson, "Quicksilver"
+
+L<Announced on 2019-11-20 by Chris 'BinGOs' Williams|https://www.nntp.perl.org/group/perl.perl5.porters/2019/11/msg256646.html>
+
+ Invocation
+
+ State your intentions, Muse. I know you're there.
+ Dead bards who pined for you have said
+ You're bright as flame, but fickle as the air.
+ My pen and I, submerged in liquid shade,
+ Much dark can spread, on days and over reams
+ But without you, no radiance can shed.
+ Why rustle in the dark, when fledged with fire?
+ Craze the night with flails of light. Reave
+ Your turbid shroud. Bestow what I require.
+
+ But you're not in the dark. I do believe
+ I swim, like squid, in clouds of my own make,
+ To you, offensive. To us both, opaque.
+ What's constituted so, only a pen
+ Can penetrate. I have one here; let's go.
+
=head2 v5.31.5 - Edward Lear, ed. Vivien Noakes, "The Complete Nonsense and Other Verse": The Daddy Long-legs and the Fly
L<Announced on 2019-10-20 by Steve Hay|https://www.nntp.perl.org/group/perl.perl5.porters/2019/10/msg256478.html>
XXX Generate this with:
- perl Porting/acknowledgements.pl v5.31.6..HEAD
+ perl Porting/acknowledgements.pl v5.31.7..HEAD
=head1 Reporting Bugs
If you find what you think is a bug, you might check the perl bug database
-at L<https://rt.perl.org/>. There may also be information at
+at L<https://github.com/Perl/perl5/issues>. There may also be information at
L<http://www.perl.org/>, the Perl Home Page.
If you believe you have an unreported bug, please run the L<perlbug> program
https://pause.perl.org/pause/query?ACTION=pause_04imprint
-=head3 rt.perl.org update access
+=head3 GitHub issue management access
-Make sure you have permission to close tickets on L<https://rt.perl.org/>
+Make sure you have permission to close tickets on L<https://github.com/Perl/perl5/issues>
so you can respond to bug reports as necessary during your stint. If you
-don't, make an account (if you don't have one) and contact the pumpking
+don't, make a GitHub account (if you don't have one) and contact the pumpking
with your username to get ticket-closing permission.
=head3 git checkout and commit bit
L<http://analysis.cpantesters.org/beforemaintrelease?pair=5.20.2:5.22.0%20RC1>
+=head3 Monitor Continuous Integration smokers
+
+Currently both "Travis CI" and "GitHub Actions" smokers are setup.
+Their current status is available at:
+
+L<https://github.com/Perl/perl5/actions>
+L<https://travis-ci.org/Perl/perl5>
+
=head3 update perldelta
Get perldelta in a mostly finished state.
$ ./perl -Ilib ext/Pod-Html/bin/pod2html pod/perldelta.pod > \
~/perldelta.html
-You can add pod links for RT references thusly:
+You can add pod links for GitHub issue references thusly:
- $ perl -p -i -e'BEGIN{undef $/}; s{(\[perl\s+#)(\d+)\]}{L<$1$2\]|https://rt.perl.org/Ticket/Display.html?id=$2>}mg' pod/perldelta.pod
+ $ perl -p -i -e'BEGIN{undef $/}; s{(GH\s+#)(\d+)}{L<$1$2|https://github.com/Perl/perl5/issues/$2>}mg' pod/perldelta.pod
If you make changes, be sure to commit them.
2019-08-20 5.31.3 ✓ Tom Hukins
2019-09-20 5.31.4 ✓ Max Maischein
2019-10-20 5.31.5 ✓ Steve Hay
- 2019-11-20 5.31.6 BinGOs
- 2019-12-18 5.31.7
- 2020-01-20 5.31.8
+ 2019-11-20 5.31.6 ✓ BinGOs
+ 2019-12-18 5.31.7 Atoomic
+ 2020-01-20 5.31.8 Matthew Horsfall
2020-02-20 5.31.9 Renee Backer
- 2020-03-20 5.31.10
+ 2020-03-20 5.31.10 Sawyer X
(RC0 for 5.32.0 will be released once we think that all the blockers have been
addressed. This typically means some time in April or May.)
=head1 Tasks that only need Perl knowledge
-=head2 Classify bug tickets by type
+=head2 Label bug tickets by type
-Known bugs in Perl are tracked by L<https://rt.perl.org/> (which also
-includes Perl 6). A summary can be found at
-L<https://rt.perl.org/NoAuth/perl5/Overview.html>.
-It shows bugs classified by "type". However, the type of many of the
-bugs is "unknown". This greatly lowers the chances of them getting
+Known bugs in Perl are tracked by L<https://github.com/Perl/perl5/issues>.
+It shows bugs and can be filtered by assigned labels. However, many are
+L<unlabeled|https://github.com/Perl/perl5/issues?q=is%3Aopen+is%3Aissue+no%3Alabel>
+or have the label L<"Needs Triage"|https://github.com/Perl/perl5/issues?q=is%3Aopen+is%3Aissue+label%3A%22Needs+Triage%22>.
+This greatly lowers the chances of them getting
fixed, as the number of open bugs is overwhelming -- too many to wade
through for someone to try to find the bugs in the parts of
Perl that s/he knows well enough to try to fix. This task involves
-going through these bugs and classifying them into one or more types.
+going through these bugs and assigning one or more labels, and removing the
+"Needs Triage" label if present.
=head2 Ongoing: investigate new bug reports
the poster about it, asking for example code that reproduces the
problem. Such code should be added to the test suite as TODO tests, and
the ticket should be classified by type. To get started on this task,
-look at the tickets that are marked as "New Issues" in
-L<https://rt.perl.org/NoAuth/perl5/Overview.html>.
+look at the issues with no comments at
+L<https://github.com/Perl/perl5/issues?q=is%3Aopen+is%3Aissue+comments%3A0>.
=head2 Migrate t/ from custom TAP generation
Make perl executable and create a symlink for libperl:
chmod a+x /boot/common/bin/perl
- cd /boot/common/lib; ln -s perl5/5.31.6/BePC-haiku/CORE/libperl.so .
+ cd /boot/common/lib; ln -s perl5/5.31.7/BePC-haiku/CORE/libperl.so .
-Replace C<5.31.6> with your respective version of Perl.
+Replace C<5.31.7> with your respective version of Perl.
=head1 KNOWN PROBLEMS
This document briefly describes Perl under Mac OS X.
- curl -O https://www.cpan.org/src/perl-5.31.6.tar.gz
- tar -xzf perl-5.31.6.tar.gz
- cd perl-5.31.6
+ curl -O https://www.cpan.org/src/perl-5.31.7.tar.gz
+ tar -xzf perl-5.31.7.tar.gz
+ cd perl-5.31.7
./Configure -des -Dprefix=/usr/local/
make
make test
=head1 DESCRIPTION
-The latest Perl release (5.31.6 as of this writing) builds without changes
+The latest Perl release (5.31.7 as of this writing) builds without changes
under all versions of Mac OS X from 10.3 "Panther" onwards.
In order to build your own version of Perl you will need 'make',
=item Additional Perl modules
- unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.31.6/
+ unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.31.7/
Same remark as above applies. Additionally, if this directory is not
one of directories on @INC (and @INC is influenced by C<PERLLIB_PREFIX>), you
Updated 28 November 2001 for broken URLs.
-Updated 03 October 2019 for perl-5.31.6+
+Updated 03 October 2019 for perl-5.31.7+
=cut
choice. Once you have done so, use a command like the following to
unpack the archive:
- vmstar -xvf perl-5^.31^.6.tar
+ vmstar -xvf perl-5^.31^.7.tar
Then set default to the top-level source directory like so:
- set default [.perl-5^.31^.6]
+ set default [.perl-5^.31^.7]
and proceed with configuration as described in the next section.
for (s = cmd; *s; s++)
{
if (*s != ' ' && !isALPHA(*s) &&
- strchr("$&*(){}[]'\";\\|?<>~`\n", *s))
+ memCHRs("$&*(){}[]'\";\\|?<>~`\n", *s))
{
if (*s == '\n' && !s[1])
{
#
my %docs;
+my %seen;
my %funcflags;
my %missing;
}
next FUNC;
}
- if ($in =~ /^=for\s+apidoc\s+(.*?)\s*\n/) {
- my $proto_in_file = $1;
+
+ # Parentheses are used to accept anything that looks like 'for
+ # apidoc', and later verify that things are the actual correct syntax.
+ my $apidoc_re = qr/^(\s*)(=?)(\s*)for(\s*)apidoc(\s*)(.*?)\s*\n/;
+
+ if ($in =~ /^=for comment/) {
+ $in = $get_next_line->();
+ if ($in =~ /skip apidoc/) { # Skips the next apidoc-like line
+ while (defined($in = $get_next_line->())) {
+ last if $in =~ $apidoc_re;
+ }
+ }
+ next FUNC;
+ }
+
+ if ($in =~ $apidoc_re) {
+ my $is_in_proper_form = length $1 == 0
+ && length $2 > 0
+ && length $3 == 0
+ && length $4 > 0
+ && length $5 > 0
+ && length $6 > 0;
+ my $proto_in_file = $6;
my $proto = $proto_in_file;
$proto = "||$proto" unless $proto =~ /\|/;
my($flags, $ret, $name, @args) = split /\s*\|\s*/, $proto;
- $name or die <<EOS;
+ $name && $is_in_proper_form or die <<EOS;
Bad apidoc at $file line $.:
$in
Expected:
die "'u' flag must also have 'm' flag' for $name" if $flags =~ /u/ && $flags !~ /m/;
warn ("'$name' not \\w+ in '$proto_in_file' in $file")
if $flags !~ /N/ && $name !~ / ^ [_[:alpha:]] \w* $ /x;
+
+ if (exists $seen{$name}) {
+ die ("'$name' in $file was already documented in $seen{$name}");
+ }
+ else {
+ $seen{$name} = $file;
+ }
+
my $docs = "";
DOC:
while (defined($doc = $get_next_line->())) {
# -std=c89 before -ansi
# -pedantic* before -Werror=d-a-s
#
-*) for opt in -std=c89 -ansi $pedantic \
- -Werror=declaration-after-statement \
- -Werror=pointer-arith \
- -Wextra -W \
- -Wc++-compat -Wwrite-strings
+*) warns=-std=c89 -ansi $pedantic \
+ -Werror=pointer-arith \
+ -Wextra -W \
+ -Wc++-compat -Wwrite-strings
+ # declaration after statement is normal in C++ rather than an
+ # extension and compilers complain if we try to warn about it
+ case "$d_cplusplus" in
+ define) ;;
+ *) warns="$warns -Werror=declaration-after-statement" ;;
+ esac
+ for opt in $warns
do
case " $ccflags " in
*" $opt "*) ;; # Skip if already there.
/* See the generating file for comments */
+/* This gives the number of code points that can be in the bitmap of an ANYOF
+ * node. The shift number must currently be one of: 8..12. It can't be less
+ * than 8 (256) because some code relies on it being at least that. Above 12
+ * (4096), and you start running into warnings that some data structure widths
+ * have been exceeded, though the test suite as of this writing still passes
+ * for up through 16, which is as high as anyone would ever want to go,
+ * encompassing all of the Unicode BMP, and thus including all the economically
+ * important world scripts. At 12 most of them are: including Arabic,
+ * Cyrillic, Greek, Hebrew, Indian subcontinent, Latin, and Thai; but not Han,
+ * Japanese, nor Korean. (The regarglen structure in regnodes.h is a U8, and
+ * the trie types TRIEC and AHOCORASICKC are larger than U8 for shift values
+ * above 12.) Be sure to benchmark before changing, as larger sizes do
+ * significantly slow down the test suite */
+
+#define NUM_ANYOF_CODE_POINTS (1 << 8)
+
#if (defined(PERL_IN_REGCOMP_C) && ! defined(PERL_IN_XSUB_RE))
0x100
};
+static const UV * const InBitmap_invlist = Latin1_invlist;
+
#endif /* (defined(PERL_IN_REGCOMP_C) && ! defined(PERL_IN_XSUB_RE)) */
#if (defined(PERL_IN_REGCOMP_C) && ! defined(PERL_IN_XSUB_RE))
* 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
* 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
* 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
- * 08071cd168b1ac72bf01f13a82c4d0470a391e2bdd0b706e9fe20ab17cc861c8 lib/unicore/mktables
+ * 498da0b9ef6a52bfd71bda5771005bbe4cfc37b456d9d350cd840991eb80c8b1 lib/unicore/mktables
* a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
* 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
* e9283c761c5a95e3379384ca47c13a284f08d743c2be6e5091f1152b1b6b7a37 regen/mk_PL_charclass.pl
- * 74442760b048f85cf5e9e87c3baffc94e861ba397dda0d33f4c22b40ef7efbe6 regen/mk_invlists.pl
+ * bddfa92837a1e11b3c74c80512e0492dc325a15ee9e2d768f246ddb3ef3bcef9 regen/mk_invlists.pl
* ex: set ro: */
#
# See Porting/config_h.pl
+#!/bin/sh
+#
+# THIS IS A GENERATED FILE
+# DO NOT HAND-EDIT
+#
+# See Porting/config_h.pl
+
: Set up for generating config_h.SH
case "$CONFIG_SH" in
'') CONFIG_SH=config.sh;;
case "$CONFIG_H" in
already-done) echo "Not re-extracting config.h" ;;
*)
+case "$CONFIG_H" in
+already-done) echo "Not re-extracting config.h" ;;
+*)
echo "Extracting $CONFIG_H (with variable substitutions)"
sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-def!#undef!'
/* This file was produced by running the config_h.SH script, which
/* HAS_REGCOMP:
* This symbol, if defined, indicates that the regcomp() routine is
- * available to do some regular patern matching (usually on POSIX.2
+ * available to do some regular pattern matching (usually on POSIX.2
* conforming systems).
*/
#$d_regcomp HAS_REGCOMP /* POSIX.2 */
#$d_attribute_pure HASATTRIBUTE_PURE /**/
#$d_attribute_unused HASATTRIBUTE_UNUSED /**/
#$d_attribute_warn_unused_result HASATTRIBUTE_WARN_UNUSED_RESULT /**/
+#$d_attribute_always_inline HASATTRIBUTE_ALWAYS_INLINE /**/
/* HAS_BACKTRACE:
* This symbol, if defined, indicates that the backtrace() routine is
#$d_ttyname_r HAS_TTYNAME_R /**/
#define TTYNAME_R_PROTO $ttyname_r_proto /**/
+/* HAS_WCRTOMB:
+ * This symbol, if defined, indicates that the wcrtomb routine is
+ * available to convert a wide character into a multi-byte character.
+ */
+#$d_wcrtomb HAS_WCRTOMB /**/
+
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
!GROK!THIS!
;;
esac
+;;
+esac
$ WC "d_atanh='" + d_atanh + "'"
$ WC "d_atolf='" + d_atolf + "'"
$ WC "d_atoll='" + d_atoll + "'"
+$ WC "d_attribute_always_inline='undef'"
$ WC "d_attribute_format='" + d_attribut + "'"
$ WC "d_attribute_deprecated='undef'"
$ WC "d_attribute_malloc='undef'"
$ WC "d_vsnprintf='" + d_vsnprintf + "'"
$ WC "d_wait4='" + d_wait4 + "'"
$ WC "d_waitpid='define'"
+$ WC "d_wcrtomb='define'"
$ WC "d_wcscmp='define'"
$ WC "d_wcstombs='define'"
$ WC "d_wcsxfrm='define'"
associated with the key, or C<&PL_sv_placeholder> if there is no value
associated with the key.
+=for apidoc Amnh||COPHH_KEY_UTF8
+
=cut
*/
void* default_bzalloc ( void* opaque, Int32 items, Int32 size )
{
void* v = malloc ( items * size );
+ ((void)opaque); /* Silence unused parameter warning */
+
return v;
}
static
void default_bzfree ( void* opaque, void* addr )
{
+ ((void)opaque); /* Silence unused parameter warning */
+
if (addr != NULL) free ( addr );
}
UInt16* mtfv = s->mtfv;
+ ((void)nBytes); /* Silence variable ‘nBytes’ set but not used warning */
if (s->verbosity >= 3)
VPrintf3( " %d in block, %d after MTF & 1-2 coding, "
"%d+2 syms in use\n",
{ retVal = rrr; goto save_state_and_return; };
#define GET_BITS(lll,vvv,nnn) \
+ /* FALLTHROUGH */ \
case lll: s->state = lll; \
while (True) { \
if (s->bsLive >= nnn) { \
use bytes ;
our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD);
-$VERSION = '2.090';
+$VERSION = '2.093';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- my $VERSION = '2.090';
+ my $VERSION = '2.093';
my @NAMES = qw(
);
use bytes ;
our ($VERSION, $XS_VERSION, @ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %DEFLATE_CONSTANTS, @DEFLATE_CONSTANTS);
-$VERSION = '2.090';
+$VERSION = '2.093';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
* prev[] will be initialized on the fly.
*/
#define CLEAR_HASH(s) \
- s->head[s->hash_size-1] = NIL; \
- zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head));
+ do { \
+ s->head[s->hash_size-1] = NIL; \
+ zmemzero((Bytef *)s->head, \
+ (unsigned)(s->hash_size-1)*sizeof(*s->head)); \
+ } while (0)
/* ===========================================================================
* Slide the hash table when sliding the window down (could be avoided with 32
@ISA = qw(Exporter);
@EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod
dos2unix);
-$VERSION = '7.38';
+$VERSION = '7.42';
$VERSION =~ tr/_//d;
my $Is_VMS = $^O eq 'VMS';
our @EXPORT = qw(test_harness pod2man perllocal_install uninstall
warn_if_old_packlist test_s cp_nonempty);
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
my $Is_VMS = $^O eq 'VMS';
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
use File::Spec;
use strict;
use warnings;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
use ExtUtils::MakeMaker::Config;
# Now update library lists
# what do we know about this library...
- my $is_dyna = ( $fullname !~ /\Q$Config_libext\E\z/ );
+ # "Sounds like we should always assume it's a dynamic library on AIX."
+ my $is_dyna = $^O eq 'aix' ? 1 : ( $fullname !~ /\Q$Config_libext\E\z/ );
my $in_perl = ( $libs =~ /\B-l:?\Q${thislib}\E\b/s );
# include the path to the lib once in the dynamic linker path
use strict;
use ExtUtils::MakeMaker::Config;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::Liblist;
B<FOR INTERNAL USE ONLY>
-ExtUtils::MM is a subclass of ExtUtils::MakeMaker which automatically
+ExtUtils::MM is a subclass of L<ExtUtils::MakeMaker> which automatically
chooses the appropriate OS specific subclass for you
-(ie. ExtUils::MM_Unix, etc...).
+(ie. L<ExtUtils::MM_Unix>, etc...).
It also provides a convenient alias via the MM class (I didn't want
MakeMaker modules outside of ExtUtils/).
package ExtUtils::MM_AIX;
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
use ExtUtils::MakeMaker::Config;
=head1 DESCRIPTION
-This is a subclass of ExtUtils::MM_Unix which contains functionality for
+This is a subclass of L<ExtUtils::MM_Unix> which contains functionality for
AIX.
-Unless otherwise stated it works just like ExtUtils::MM_Unix
+Unless otherwise stated it works just like ExtUtils::MM_Unix.
=head2 Overridden methods
package ExtUtils::MM_Any;
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
use Carp;
modules. It contains methods which are either inherently
cross-platform or are written in a cross-platform manner.
-Subclass off of ExtUtils::MM_Any I<and> ExtUtils::MM_Unix. This is a
+Subclass off of ExtUtils::MM_Any I<and> L<ExtUtils::MM_Unix>. This is a
temporary solution.
B<THIS MAY BE TEMPORARY!>
$mm->_fix_metadata_before_conversion( \%metadata );
-Fixes errors in the metadata before it's handed off to CPAN::Meta for
+Fixes errors in the metadata before it's handed off to L<CPAN::Meta> for
conversion. This hopefully results in something that can be used further
on, no guarantee is made though.
linking used by tools_other() and places them in the $MM object.
If there is no description, its the same as the parameter to
-WriteMakefile() documented in ExtUtils::MakeMaker.
+WriteMakefile() documented in L<ExtUtils::MakeMaker>.
=cut
=head2 File::Spec wrappers
-ExtUtils::MM_Any is a subclass of File::Spec. The methods noted here
+ExtUtils::MM_Any is a subclass of L<File::Spec>. The methods noted here
override File::Spec.
my($self,$path) = @_;
if ($path =~ m<^README\.pod$>i) {
- warn "WARNING: Older versions of ExtUtils::MakeMaker may errantly install $path as part of this distribution. It is recommended to avoid using this path in CPAN modules.\n"
- unless $ENV{PERL_CORE};
+ warn "WARNING: Older versions of ExtUtils::MakeMaker may errantly install $path as part of this distribution. It is recommended to avoid using this path in CPAN modules.\n";
return '';
}
=head1 DESCRIPTION
-See ExtUtils::MM_Unix for a documentation of the methods provided
+See L<ExtUtils::MM_Unix> for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
require ExtUtils::MM_Unix;
our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Win32;
our @ISA = qw( ExtUtils::MM_Unix );
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
=head1 DESCRIPTION
-See ExtUtils::MM_Unix for a documentation of the methods provided there.
+See L<ExtUtils::MM_Unix> for a documentation of the methods provided there.
=over 4
Determine whether a file is native to Cygwin by checking whether it
resides inside the Cygwin installation (using Windows paths). If so,
-use C<ExtUtils::MM_Unix> to determine if it may be a command.
-Otherwise use the tests from C<ExtUtils::MM_Win32>.
+use L<ExtUtils::MM_Unix> to determine if it may be a command.
+Otherwise use the tests from L<ExtUtils::MM_Win32>.
=cut
$s;
}
-=item all_target
-
-Build man pages, too
-
-=cut
-
-sub all_target {
- ExtUtils::MM_Unix::all_target(shift);
-}
-
=back
=cut
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Any;
=head1 DESCRIPTION
-This is a subclass of ExtUtils::MM_Unix which contains functionality
+This is a subclass of L<ExtUtils::MM_Unix> which contains functionality
for DOS.
-Unless otherwise stated, it works just like ExtUtils::MM_Unix
+Unless otherwise stated, it works just like ExtUtils::MM_Unix.
=head2 Overridden methods
our @ISA = qw( ExtUtils::MM_Unix );
}
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
=head1 DESCRIPTION
-See L<ExtUtils::MM_Unix> for L<ExtUtils::MM_Any> for documentation on the
+See L<ExtUtils::MM_Unix> or L<ExtUtils::MM_Any> for documentation on the
methods overridden here.
=head2 Overridden Methods
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
sub new {
=head1 DESCRIPTION
-See ExtUtils::MM_Unix for a documentation of the methods provided
+See L<ExtUtils::MM_Unix> for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
use ExtUtils::MakeMaker::Config;
use File::Basename;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Win32;
use ExtUtils::MakeMaker qw(neatvalue);
use File::Spec;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Any;
=head1 DESCRIPTION
-See ExtUtils::MM_Unix for a documentation of the methods provided
+See L<ExtUtils::MM_Unix> for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
package ExtUtils::MM_QNX;
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Unix;
=head1 DESCRIPTION
-This is a subclass of ExtUtils::MM_Unix which contains functionality for
+This is a subclass of L<ExtUtils::MM_Unix> which contains functionality for
QNX.
-Unless otherwise stated it works just like ExtUtils::MM_Unix
+Unless otherwise stated it works just like ExtUtils::MM_Unix.
=head2 Overridden methods
package ExtUtils::MM_UWIN;
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Unix;
=head1 DESCRIPTION
-This is a subclass of ExtUtils::MM_Unix which contains functionality for
+This is a subclass of L<ExtUtils::MM_Unix> which contains functionality for
the AT&T U/WIN UNIX on Windows environment.
-Unless otherwise stated it works just like ExtUtils::MM_Unix
+Unless otherwise stated it works just like ExtUtils::MM_Unix.
=head2 Overridden methods
# If we make $VERSION an our variable parse_version() breaks
use vars qw($VERSION);
-$VERSION = '7.38';
+$VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Any;
=head1 DESCRIPTION
The methods provided by this package are designed to be used in
-conjunction with ExtUtils::MakeMaker. When MakeMaker writes a
+conjunction with L<ExtUtils::MakeMaker>. When MakeMaker writes a
Makefile, it creates one or more objects that inherit their methods
-from a package C<MM>. MM itself doesn't provide any methods, but it
-ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating
+from a package L<MM|ExtUtils::MM>. MM itself doesn't provide any methods, but
+it ISA ExtUtils::MM_Unix class. The inheritance tree of MM lets operating
specific packages take the responsibility for all the methods provided
by MM_Unix. We are trying to reduce the number of the necessary
overrides by defining rather primitive operations within
Makefile.PL. Overridable methods are marked as (o). All methods are
overridable by a platform specific MM_*.pm file.
-Cross-platform methods are being moved into MM_Any. If you can't find
-something that used to be in here, look in MM_Any.
+Cross-platform methods are being moved into L<MM_Any|ExtUtils::MM_Any>.
+If you can't find something that used to be in here, look in MM_Any.
=cut
=item max_exec_len
-Using POSIX::ARG_MAX. Otherwise falling back to 4096.
+Using L<POSIX>::ARG_MAX. Otherwise falling back to 4096.
=cut
use File::Basename;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Any;
=head1 DESCRIPTION
-See ExtUtils::MM_Unix for a documentation of the methods provided
+See L<ExtUtils::MM_Unix> for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
Those methods which override default MM_Unix methods are marked
"(override)", while methods unique to MM_VMS are marked "(specific)".
For overridden methods, documentation is limited to an explanation
-of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
+of why this method overrides the MM_Unix method; see the L<ExtUtils::MM_Unix>
documentation for more details.
=over 4
=item _fixin_replace_shebang (override)
-Helper routine for MM->fixin(), overridden because there's no such thing as an
+Helper routine for L<< MM->fixin()|ExtUtils::MM_Unix/fixin >>, overridden
+because there's no such thing as an
actual shebang line that will be interpreted by the shell, so we just prepend
$Config{startperl} and preserve the shebang line argument for any switches it
may contain.
=item perldepend (override)
Use VMS-style syntax for files; it's cheaper to just do it directly here
-than to have the MM_Unix method call C<catfile> repeatedly. Also, if
-we have to rebuild Config.pm, use MM[SK] to do it.
+than to have the L<MM_Unix|ExtUtils::MM_Unix> method call C<catfile>
+repeatedly. Also, if we have to rebuild Config.pm, use MM[SK] to do it.
=cut
Eliminate the macros in the output to the MMS/MMK file.
-(File::Spec::VMS used to do this for us, but it's being removed)
+(L<File::Spec::VMS> used to do this for us, but it's being removed)
=cut
as a file specification in Unix syntax.
NOTE: This is the canonical version of the method. The version in
-File::Spec::VMS is deprecated.
+L<File::Spec::VMS> is deprecated.
=cut
it to be a file.
NOTE: This is the canonical version of the method. The version in
-File::Spec::VMS is deprecated.
+L<File::Spec::VMS> is deprecated.
=cut
package ExtUtils::MM_VOS;
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Unix;
=head1 DESCRIPTION
-This is a subclass of ExtUtils::MM_Unix which contains functionality for
+This is a subclass of L<ExtUtils::MM_Unix> which contains functionality for
VOS.
-Unless otherwise stated it works just like ExtUtils::MM_Unix
+Unless otherwise stated it works just like ExtUtils::MM_Unix.
=head2 Overridden methods
=head1 DESCRIPTION
-See ExtUtils::MM_Unix for a documentation of the methods provided
+See L<ExtUtils::MM_Unix> for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.
require ExtUtils::MM_Any;
require ExtUtils::MM_Unix;
our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
$ENV{EMXSHELL} = 'sh'; # to run `commands`
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require ExtUtils::MM_Win32;
=head1 DESCRIPTION
-This is a subclass of ExtUtils::MM_Win32 containing changes necessary
+This is a subclass of L<ExtUtils::MM_Win32> containing changes necessary
to get MakeMaker playing nice with command.com and other Win9Xisms.
=head2 Overridden methods
use strict;
require ExtUtils::MM;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
our @ISA = qw(ExtUtils::MM);
B<FOR INTERNAL USE ONLY>
-ExtUtils::MY is a subclass of ExtUtils::MM. Its provided in your
+ExtUtils::MY is a subclass of L<ExtUtils::MM>. Its provided in your
Makefile.PL for you to add and override MakeMaker functionality.
It also provides a convenient alias via the MY class.
our %macro_fsentity; # whether a macro is a filesystem name
our %macro_dep; # whether a macro is a dependency
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
# Emulate something resembling CVS $Revision$
to portably use Unicode characters in module names, because this requires
Perl to handle Unicode filenames, which is not yet the case on Windows.
+See L<ExtUtils::MakeMaker::FAQ> for details of the design and usage.
+
=head2 How To Write A Makefile.PL
See L<ExtUtils::MakeMaker::Tutorial>.
=item postamble
-Anything put here will be passed to MY::postamble() if you have one.
+Anything put here will be passed to
+L<MY::postamble()|ExtUtils::MM_Any/postamble (o)> if you have one.
=item realclean
If you are running experiments with embedding perl as a library into
other applications, you might find MakeMaker is not sufficient. You'd
-better have a look at ExtUtils::Embed which is a collection of utilities
+better have a look at L<ExtUtils::Embed> which is a collection of utilities
for embedding.
If you still need a different solution, try to develop another
=head2 Distribution Support
For authors of extensions MakeMaker provides several Makefile
-targets. Most of the support comes from the ExtUtils::Manifest module,
+targets. Most of the support comes from the L<ExtUtils::Manifest> module,
where additional documentation can be found.
=over 4
=item make distcheck
reports which files are below the build directory but not in the
-MANIFEST file and vice versa. (See ExtUtils::Manifest::fullcheck() for
+MANIFEST file and vice versa. (See L<ExtUtils::Manifest/fullcheck> for
details)
=item make skipcheck
reports which files are skipped due to the entries in the
-C<MANIFEST.SKIP> file (See ExtUtils::Manifest::skipcheck() for
+C<MANIFEST.SKIP> file (See L<ExtUtils::Manifest/skipcheck> for
details)
=item make distclean
=item make manifest
rewrites the MANIFEST file, adding all remaining files found (See
-ExtUtils::Manifest::mkmanifest() for details)
+L<ExtUtils::Manifest/mkmanifest> for details)
=item make distdir
=head1 SEE ALSO
L<Module::Build> is a pure-Perl alternative to MakeMaker which does
-not rely on make or any other external utility. It is easier to
+not rely on make or any other external utility. It may be easier to
extend to suit your needs.
-L<Module::Install> is a wrapper around MakeMaker which adds features
-not normally available.
+L<Module::Build::Tiny> is a minimal pure-Perl alternative to MakeMaker
+that follows the Build.PL protocol of Module::Build but without its
+complexity and cruft, implementing only the installation of the module
+and leaving authoring to L<mbtiny> or other authoring tools.
+
+L<Module::Install> is a (now discouraged) wrapper around MakeMaker which
+adds features not normally available.
L<ExtUtils::ModuleMaker> and L<Module::Starter> are both modules to
help you setup your distribution.
L<File::ShareDir::Install> makes it easy to install static, sometimes
also referred to as 'shared' files. L<File::ShareDir> helps accessing
-the shared files after installation.
+the shared files after installation. L<Test::File::ShareDir> helps when
+writing tests to use the shared files both before and after installation.
+
+L<Dist::Zilla> is an authoring tool which allows great customization and
+extensibility of the author experience, relying on the existing install
+tools like ExtUtils::MakeMaker only for installation.
+
+L<Dist::Milla> is a Dist::Zilla bundle that greatly simplifies common
+usage.
-L<Dist::Zilla> makes it easy for the module author to create MakeMaker-based
-distributions with lots of bells and whistles.
+L<Minilla> is a minimal authoring tool that does the same things as
+Dist::Milla without the overhead of Dist::Zilla.
=head1 AUTHORS
use strict;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
use Config ();
package ExtUtils::MakeMaker::FAQ;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
1;
=head1 DESCRIPTION
-FAQs, tricks and tips for C<ExtUtils::MakeMaker>.
+FAQs, tricks and tips for L<ExtUtils::MakeMaker>.
=head2 Module Installation
|
MY
-The object actually used is of the class MY which allows you to
+The object actually used is of the class L<MY|ExtUtils::MY> which allows you to
override bits of MakeMaker inside your Makefile.PL by declaring
MY::foo() methods.
L<http://archive.develooper.com/makemaker@perl.org/msg00134.html>
for some history.
-NOTE: When ExtUtils::MM is loaded it chooses a superclass for MM from
+NOTE: When L<ExtUtils::MM> is loaded it chooses a superclass for MM from
amongst the ExtUtils::MM_* modules based on the current operating
system.
NOTE: ExtUtils::MM_{Current OS} represents one of the ExtUtils::MM_*
-modules except ExtUtils::MM_Any chosen based on your operating system.
+modules except L<ExtUtils::MM_Any> chosen based on your operating system.
NOTE: The main object used by MakeMaker is a PACK### object, *not*
-ExtUtils::MakeMaker. It is, effectively, a subclass of MY,
-ExtUtils::Makemaker, ExtUtils::Liblist and ExtUtils::MM_{Current OS}
+L<ExtUtils::MakeMaker>. It is, effectively, a subclass of L<MY|ExtUtils::MY>,
+L<ExtUtils::MakeMaker>, L<ExtUtils::Liblist> and ExtUtils::MM_{Current OS}
-NOTE: The methods in MY are simply copied into PACK### rather than
-MY being a superclass of PACK###. I don't remember the rationale.
+NOTE: The methods in L<MY|ExtUtils::MY> are simply copied into PACK### rather
+than MY being a superclass of PACK###. I don't remember the rationale.
-NOTE: ExtUtils::Liblist should be removed from the inheritance hiearchy
+NOTE: L<ExtUtils::Liblist> should be removed from the inheritance hiearchy
and simply be called as functions.
-NOTE: Modules like File::Spec and Exporter have been omitted for clarity.
+NOTE: Modules like L<File::Spec> and L<Exporter> have been omitted for clarity.
=head2 The MM_* hierarchy
| |
MM_Any
-NOTE: Each direct MM_Unix subclass is also an MM_Any subclass. This
+NOTE: Each direct L<MM_Unix|ExtUtils::MM_Unix> subclass is also an
+L<MM_Any|ExtUtils::MM_Any> subclass. This
is a temporary hack because MM_Unix overrides some MM_Any methods with
Unix specific code. It allows the non-Unix modules to see the
original MM_Any implementations.
-NOTE: Modules like File::Spec and Exporter have been omitted for clarity.
+NOTE: Modules like L<File::Spec> and L<Exporter> have been omitted for clarity.
=head1 PATCHING
package ExtUtils::MakeMaker::Locale;
use strict;
-our $VERSION = "7.38";
+our $VERSION = "7.42";
$VERSION =~ tr/_//d;
use base 'Exporter';
package ExtUtils::MakeMaker::Tutorial;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
L<perlnewmod> gives more information about how to write a module.
There are modules to help you through the process of writing a module:
-L<ExtUtils::ModuleMaker>, L<Module::Install>, L<PAR>
+L<ExtUtils::ModuleMaker>, L<Module::Starter>, L<Minilla::Tutorial>,
+L<Dist::Milla::Tutorial>, L<Dist::Zilla::Starter>
=cut
use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
-$VERSION = '7.38';
+$VERSION = '7.42';
$VERSION =~ tr/_//d;
$CLASS = 'version';
use vars qw($VERSION $CLASS $STRICT $LAX);
-$VERSION = '7.38';
+$VERSION = '7.42';
$VERSION =~ tr/_//d;
#--------------------------------------------------------------------------#
# There's just too much Dynaloader incest here to turn on strict vars.
use strict 'refs';
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(&Mksymlists);
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
sub Mksymlists {
use strict;
use warnings;
-our $VERSION = '7.38';
+our $VERSION = '7.42';
$VERSION =~ tr/_//d;
use Cwd;
plan skip_all => 'Non-Unix platform';
}
else {
- plan tests => 113;
+ plan tests => 114;
}
}
###############################################################################
# libscan
-is ($t->libscan('Readme.pod'), '', 'libscan excludes base Readme.pod');
-is ($t->libscan('README.pod'), '', 'libscan excludes base README.pod');
+{
+ # suppress noisy & unnecessary "WARNING: Older versions of ExtUtils::MakeMaker may errantly install README.pod..."
+ my @warnings = ();
+ local $SIG{__WARN__} = sub { push @warnings, shift; };
+ is ($t->libscan('Readme.pod'), '', 'libscan excludes base Readme.pod');
+ is ($t->libscan('README.pod'), '', 'libscan excludes base README.pod');
+ # verify that suppressed warnings are present
+ isnt (scalar(@warnings), 0);
+ if (scalar(@warnings)) {
+ note (sprintf('suppressed warnings: [ "%s" ]', do { my $s = join(q/" , "/, @warnings); $s =~ s/([^[:print:]])/sprintf('\x{%x}', ord($1))/egmsx; $s; }));
+ }
+}
is ($t->libscan('lib/Foo/README.pod'), 'lib/Foo/README.pod', 'libscan accepts README.pod in a subdirectory');
is ($t->libscan('foo/RCS/bar'), '', 'libscan on RCS');
is ($t->libscan('CVS/bar/car'), '', 'libscan on CVS');
}
use strict;
-use Test::More tests => 46;
+use Test::More tests => 50;
use File::Spec;
use File::Temp qw[tempdir];
{
local $Config{installman3dir} = File::Spec->catdir(qw(t lib));
- my $mm = WriteMakefile(
- NAME => 'Big::Dummy',
- VERSION_FROM => 'lib/Big/Dummy.pm',
- );
+ my $mm;
+ {
+ # suppress noisy & unnecessary "WARNING: Older versions of ExtUtils::MakeMaker may errantly install README.pod..."
+ my @warnings = ();
+ local $SIG{__WARN__} = sub { push @warnings, shift; };
+ $mm = WriteMakefile(
+ NAME => 'Big::Dummy',
+ VERSION_FROM => 'lib/Big/Dummy.pm',
+ );
+ # verify that suppressed warnings are present
+ isnt (scalar(@warnings), 0);
+ if (scalar(@warnings)) {
+ note (sprintf('suppressed warnings: [ "%s" ]', do { my $s = join(q/" , "/, @warnings); $s =~ s/([^[:print:]])/sprintf('\x{%x}', ord($1))/egmsx; $s; }));
+ }
+ }
my %got = %{ $mm->{MAN3PODS} };
# because value too OS-specific
my $delete_key = $^O eq 'VMS' ? '[.lib.Big]Dummy.pm' : 'lib/Big/Dummy.pm';
}
{
- my $mm = WriteMakefile(
- NAME => 'Big::Dummy',
- VERSION_FROM => 'lib/Big/Dummy.pm',
- INSTALLMAN3DIR => 'none'
- );
+ my $mm;
+ {
+ # suppress noisy & unnecessary "WARNING: Older versions of ExtUtils::MakeMaker may errantly install README.pod..."
+ my @warnings = ();
+ local $SIG{__WARN__} = sub { push @warnings, shift; };
+ $mm = WriteMakefile(
+ NAME => 'Big::Dummy',
+ VERSION_FROM => 'lib/Big/Dummy.pm',
+ INSTALLMAN3DIR => 'none'
+ );
+ # verify that suppressed warnings are present
+ isnt (scalar(@warnings), 0);
+ if (scalar(@warnings)) {
+ note (sprintf('suppressed warnings: [ "%s" ]', do { my $s = join(q/" , "/, @warnings); $s =~ s/([^[:print:]])/sprintf('\x{%x}', ord($1))/egmsx; $s; }));
+ }
+ }
is_deeply $mm->{MAN3PODS}, {}, 'suppress man3pod with "none"';
}
{
- my $mm = WriteMakefile(
- NAME => 'Big::Dummy',
- VERSION_FROM => 'lib/Big/Dummy.pm',
- MAN3PODS => {}
- );
+ my $mm;
+ {
+ # suppress noisy & unnecessary "WARNING: Older versions of ExtUtils::MakeMaker may errantly install README.pod..."
+ my @warnings = ();
+ local $SIG{__WARN__} = sub { push @warnings, shift; };
+ $mm = WriteMakefile(
+ NAME => 'Big::Dummy',
+ VERSION_FROM => 'lib/Big/Dummy.pm',
+ MAN3PODS => {}
+ );
+ # verify that suppressed warnings are present
+ isnt (scalar(@warnings), 0);
+ if (scalar(@warnings)) {
+ note (sprintf('suppressed warnings: [ "%s" ]', do { my $s = join(q/" , "/, @warnings); $s =~ s/([^[:print:]])/sprintf('\x{%x}', ord($1))/egmsx; $s; }));
+ }
+ }
is_deeply $mm->{MAN3PODS}, {}, 'suppress man3pod with {}';
}
{
- my $mm = WriteMakefile(
- NAME => 'Big::Dummy',
- VERSION_FROM => 'lib/Big/Dummy.pm',
- MAN3PODS => { "Foo.pm" => "Foo.1" }
- );
+ my $mm;
+ {
+ # suppress noisy & unnecessary "WARNING: Older versions of ExtUtils::MakeMaker may errantly install README.pod..."
+ my @warnings = ();
+ local $SIG{__WARN__} = sub { push @warnings, shift; };
+ $mm = WriteMakefile(
+ NAME => 'Big::Dummy',
+ VERSION_FROM => 'lib/Big/Dummy.pm',
+ MAN3PODS => { "Foo.pm" => "Foo.1" }
+ );
+ # verify that suppressed warnings are present
+ isnt (scalar(@warnings), 0);
+ if (scalar(@warnings)) {
+ note (sprintf('suppressed warnings: [ "%s" ]', do { my $s = join(q/" , "/, @warnings); $s =~ s/([^[:print:]])/sprintf('\x{%x}', ord($1))/egmsx; $s; }));
+ }
+ }
is_deeply $mm->{MAN3PODS}, { "Foo.pm" => "Foo.1" }, 'override man3pod';
}
"Set POD2MAN section to \$(MAN3SECTION)";
}
}
-
SKIP: {
eval { chmod(0755, "usrbin/interp") }
or skip "no chmod", 8;
- skip "Not relevant on VMS or MSWin32", 8 if $^O eq 'VMS' || $^O eq 'MSWin32';
+ skip "Not relevant on VMS or MSWin32", 8 if $^O eq 'VMS' || $^O eq 'MSWin32' || $^O eq 'cygwin';
my $dir = getcwd();
local $ENV{PATH} = join $Config{path_sep}, map "$dir/$_", qw(usrbin bin);
--- /dev/null
+---
+# TAP::Harness test rules
+# "t\02-xsdynamic.t" (and possibly "t\03-xsstatic.t") should *not* be run in parallel
+# ... allowing overlap of these tests causes race conditions which lead to intermittent failures
+seq:
+ - seq:
+ # serialize all tests in files matching "t/0*.t"
+ - t{\\,/}0*.t
+ - par:
+ # run all other tests in parallel
+ - **
use strict ;
require 5.006 ;
-$::VERSION = '2.090' ;
+$::VERSION = '2.093' ;
use lib '.';
use private::MakeUtil;
use IO::Handle ;
use Scalar::Util qw(dualvar);
-use IO::Compress::Base::Common 2.090 ;
-use Compress::Raw::Zlib 2.090 ;
-use IO::Compress::Gzip 2.090 ;
-use IO::Uncompress::Gunzip 2.090 ;
+use IO::Compress::Base::Common 2.093 ;
+use Compress::Raw::Zlib 2.093 ;
+use IO::Compress::Gzip 2.093 ;
+use IO::Uncompress::Gunzip 2.093 ;
use strict ;
use warnings ;
use bytes ;
our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = '2.090';
+$VERSION = '2.093';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
package Compress::Zlib ;
-use IO::Compress::Gzip::Constants 2.090 ;
+use IO::Compress::Gzip::Constants 2.093 ;
sub memGzip($)
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status);
+use IO::Compress::Base::Common 2.093 qw(:Status);
-use Compress::Raw::Bzip2 2.090 ;
+use Compress::Raw::Bzip2 2.093 ;
our ($VERSION);
-$VERSION = '2.090';
+$VERSION = '2.093';
sub mkCompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status);
-use Compress::Raw::Zlib 2.090 qw( !crc32 !adler32 ) ;
+use IO::Compress::Base::Common 2.093 qw(:Status);
+use Compress::Raw::Zlib 2.093 qw( !crc32 !adler32 ) ;
require Exporter;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);
-$VERSION = '2.090';
+$VERSION = '2.093';
@ISA = qw(Exporter);
@EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS;
%EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS;
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status);
+use IO::Compress::Base::Common 2.093 qw(:Status);
our ($VERSION);
-$VERSION = '2.090';
+$VERSION = '2.093';
sub mkCompObject
{
use strict ;
use warnings;
-use IO::Compress::Base::Common 2.090 ;
+use IO::Compress::Base::Common 2.093 ;
use IO::File (); ;
use Scalar::Util ();
our (@ISA, $VERSION);
@ISA = qw(IO::File Exporter);
-$VERSION = '2.090';
+$VERSION = '2.093';
#Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16.
require Exporter;
our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
@ISA = qw(Exporter);
-$VERSION = '2.090';
+$VERSION = '2.093';
@EXPORT = qw( isaFilehandle isaFilename isaScalar
whatIsInput whatIsOutput
use bytes;
require Exporter ;
-use IO::Compress::Base 2.090 ;
+use IO::Compress::Base 2.093 ;
-use IO::Compress::Base::Common 2.090 qw();
-use IO::Compress::Adapter::Bzip2 2.090 ;
+use IO::Compress::Base::Common 2.093 qw();
+use IO::Compress::Adapter::Bzip2 2.093 ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);
-$VERSION = '2.090';
+$VERSION = '2.093';
$Bzip2Error = '';
@ISA = qw(IO::Compress::Base Exporter);
{
my $self = shift ;
- use IO::Compress::Base::Common 2.090 qw(:Parse);
+ use IO::Compress::Base::Common 2.093 qw(:Parse);
return (
'blocksize100k' => [IO::Compress::Base::Common::Parse_unsigned, 1],
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
require Exporter ;
-use IO::Compress::RawDeflate 2.090 ();
-use IO::Compress::Adapter::Deflate 2.090 ;
+use IO::Compress::RawDeflate 2.093 ();
+use IO::Compress::Adapter::Deflate 2.093 ;
-use IO::Compress::Zlib::Constants 2.090 ;
-use IO::Compress::Base::Common 2.090 qw();
+use IO::Compress::Zlib::Constants 2.093 ;
+use IO::Compress::Base::Common 2.093 qw();
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$DeflateError = '';
@ISA = qw(IO::Compress::RawDeflate Exporter);
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
require Exporter ;
-use IO::Compress::RawDeflate 2.090 () ;
-use IO::Compress::Adapter::Deflate 2.090 ;
+use IO::Compress::RawDeflate 2.093 () ;
+use IO::Compress::Adapter::Deflate 2.093 ;
-use IO::Compress::Base::Common 2.090 qw(:Status );
-use IO::Compress::Gzip::Constants 2.090 ;
-use IO::Compress::Zlib::Extra 2.090 ;
+use IO::Compress::Base::Common 2.093 qw(:Status );
+use IO::Compress::Gzip::Constants 2.093 ;
+use IO::Compress::Zlib::Extra 2.093 ;
BEGIN
{
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$GzipError = '' ;
@ISA = qw(IO::Compress::RawDeflate Exporter);
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);
-$VERSION = '2.090';
+$VERSION = '2.093';
@ISA = qw(Exporter);
use warnings;
use bytes;
-use IO::Compress::Base 2.090 ;
-use IO::Compress::Base::Common 2.090 qw(:Status );
-use IO::Compress::Adapter::Deflate 2.090 ;
+use IO::Compress::Base 2.093 ;
+use IO::Compress::Base::Common 2.093 qw(:Status );
+use IO::Compress::Adapter::Deflate 2.093 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$RawDeflateError = '';
@ISA = qw(IO::Compress::Base Exporter);
return getZlibParams();
}
-use IO::Compress::Base::Common 2.090 qw(:Parse);
-use Compress::Raw::Zlib 2.090 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
+use IO::Compress::Base::Common 2.093 qw(:Parse);
+use Compress::Raw::Zlib 2.093 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY);
our %PARAMS = (
#'method' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED],
'level' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_COMPRESSION],
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status );
-use IO::Compress::RawDeflate 2.090 ();
-use IO::Compress::Adapter::Deflate 2.090 ;
-use IO::Compress::Adapter::Identity 2.090 ;
-use IO::Compress::Zlib::Extra 2.090 ;
-use IO::Compress::Zip::Constants 2.090 ;
+use IO::Compress::Base::Common 2.093 qw(:Status );
+use IO::Compress::RawDeflate 2.093 ();
+use IO::Compress::Adapter::Deflate 2.093 ;
+use IO::Compress::Adapter::Identity 2.093 ;
+use IO::Compress::Zlib::Extra 2.093 ;
+use IO::Compress::Zip::Constants 2.093 ;
use File::Spec();
use Config;
-use Compress::Raw::Zlib 2.090 ();
+use Compress::Raw::Zlib 2.093 ();
BEGIN
{
eval { require IO::Compress::Adapter::Bzip2 ;
- import IO::Compress::Adapter::Bzip2 2.090 ;
+ import IO::Compress::Adapter::Bzip2 2.093 ;
require IO::Compress::Bzip2 ;
- import IO::Compress::Bzip2 2.090 ;
+ import IO::Compress::Bzip2 2.093 ;
} ;
eval { require IO::Compress::Adapter::Lzma ;
- import IO::Compress::Adapter::Lzma 2.090 ;
+ import IO::Compress::Adapter::Lzma 2.093 ;
require IO::Compress::Lzma ;
- import IO::Compress::Lzma 2.090 ;
+ import IO::Compress::Lzma 2.093 ;
} ;
}
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$ZipError = '';
@ISA = qw(IO::Compress::RawDeflate Exporter);
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);
-$VERSION = '2.090';
+$VERSION = '2.093';
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT);
-$VERSION = '2.090';
+$VERSION = '2.093';
@ISA = qw(Exporter);
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
-$VERSION = '2.090';
+$VERSION = '2.093';
-use IO::Compress::Gzip::Constants 2.090 ;
+use IO::Compress::Gzip::Constants 2.093 ;
sub ExtraFieldError
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status);
+use IO::Compress::Base::Common 2.093 qw(:Status);
-use Compress::Raw::Bzip2 2.090 ;
+use Compress::Raw::Bzip2 2.093 ;
our ($VERSION, @ISA);
-$VERSION = '2.090';
+$VERSION = '2.093';
sub mkUncompObject
{
use strict;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status);
+use IO::Compress::Base::Common 2.093 qw(:Status);
use IO::Compress::Zip::Constants ;
our ($VERSION);
-$VERSION = '2.090';
+$VERSION = '2.093';
-use Compress::Raw::Zlib 2.090 ();
+use Compress::Raw::Zlib 2.093 ();
sub mkUncompObject
{
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status);
-use Compress::Raw::Zlib 2.090 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
+use IO::Compress::Base::Common 2.093 qw(:Status);
+use Compress::Raw::Zlib 2.093 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
our ($VERSION);
-$VERSION = '2.090';
+$VERSION = '2.093';
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 ();
+use IO::Compress::Base::Common 2.093 ();
-use IO::Uncompress::Adapter::Inflate 2.090 ();
+use IO::Uncompress::Adapter::Inflate 2.093 ();
-use IO::Uncompress::Base 2.090 ;
-use IO::Uncompress::Gunzip 2.090 ;
-use IO::Uncompress::Inflate 2.090 ;
-use IO::Uncompress::RawInflate 2.090 ;
-use IO::Uncompress::Unzip 2.090 ;
+use IO::Uncompress::Base 2.093 ;
+use IO::Uncompress::Gunzip 2.093 ;
+use IO::Uncompress::Inflate 2.093 ;
+use IO::Uncompress::RawInflate 2.093 ;
+use IO::Uncompress::Unzip 2.093 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$AnyInflateError = '';
@ISA = qw(IO::Uncompress::Base Exporter);
sub getExtraParams
{
- use IO::Compress::Base::Common 2.090 qw(:Parse);
+ use IO::Compress::Base::Common 2.093 qw(:Parse);
return ( 'rawinflate' => [Parse_boolean, 0] ) ;
}
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 ();
+use IO::Compress::Base::Common 2.093 ();
-use IO::Uncompress::Base 2.090 ;
+use IO::Uncompress::Base 2.093 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$AnyUncompressError = '';
@ISA = qw(IO::Uncompress::Base Exporter);
# Don't trigger any __DIE__ Hooks.
local $SIG{__DIE__};
- eval ' use IO::Uncompress::Adapter::Inflate 2.090 ;';
- eval ' use IO::Uncompress::Adapter::Bunzip2 2.090 ;';
- eval ' use IO::Uncompress::Adapter::LZO 2.090 ;';
- eval ' use IO::Uncompress::Adapter::Lzf 2.090 ;';
- eval ' use IO::Uncompress::Adapter::UnLzma 2.090 ;';
- eval ' use IO::Uncompress::Adapter::UnXz 2.090 ;';
+ eval ' use IO::Uncompress::Adapter::Inflate 2.093 ;';
+ eval ' use IO::Uncompress::Adapter::Bunzip2 2.093 ;';
+ eval ' use IO::Uncompress::Adapter::LZO 2.093 ;';
+ eval ' use IO::Uncompress::Adapter::Lzf 2.093 ;';
+ eval ' use IO::Uncompress::Adapter::UnLzma 2.093 ;';
+ eval ' use IO::Uncompress::Adapter::UnXz 2.093 ;';
eval ' use IO::Uncompress::Adapter::UnZstd 2.083 ;';
- eval ' use IO::Uncompress::Adapter::UnLzip 2.090 ;';
-
- eval ' use IO::Uncompress::Bunzip2 2.090 ;';
- eval ' use IO::Uncompress::UnLzop 2.090 ;';
- eval ' use IO::Uncompress::Gunzip 2.090 ;';
- eval ' use IO::Uncompress::Inflate 2.090 ;';
- eval ' use IO::Uncompress::RawInflate 2.090 ;';
- eval ' use IO::Uncompress::Unzip 2.090 ;';
- eval ' use IO::Uncompress::UnLzf 2.090 ;';
- eval ' use IO::Uncompress::UnLzma 2.090 ;';
- eval ' use IO::Uncompress::UnXz 2.090 ;';
- eval ' use IO::Uncompress::UnZstd 2.090 ;';
- eval ' use IO::Uncompress::UnLzip 2.090 ;';
+ eval ' use IO::Uncompress::Adapter::UnLzip 2.093 ;';
+
+ eval ' use IO::Uncompress::Bunzip2 2.093 ;';
+ eval ' use IO::Uncompress::UnLzop 2.093 ;';
+ eval ' use IO::Uncompress::Gunzip 2.093 ;';
+ eval ' use IO::Uncompress::Inflate 2.093 ;';
+ eval ' use IO::Uncompress::RawInflate 2.093 ;';
+ eval ' use IO::Uncompress::Unzip 2.093 ;';
+ eval ' use IO::Uncompress::UnLzf 2.093 ;';
+ eval ' use IO::Uncompress::UnLzma 2.093 ;';
+ eval ' use IO::Uncompress::UnXz 2.093 ;';
+ eval ' use IO::Uncompress::UnZstd 2.093 ;';
+ eval ' use IO::Uncompress::UnLzip 2.093 ;';
}
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
@ISA = qw(IO::File Exporter);
-$VERSION = '2.090';
+$VERSION = '2.093';
use constant G_EOF => 0 ;
use constant G_ERR => -1 ;
-use IO::Compress::Base::Common 2.090 ;
+use IO::Compress::Base::Common 2.093 ;
use IO::File ;
use Symbol;
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status );
+use IO::Compress::Base::Common 2.093 qw(:Status );
-use IO::Uncompress::Base 2.090 ;
-use IO::Uncompress::Adapter::Bunzip2 2.090 ;
+use IO::Uncompress::Base 2.093 ;
+use IO::Uncompress::Adapter::Bunzip2 2.093 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error);
-$VERSION = '2.090';
+$VERSION = '2.093';
$Bunzip2Error = '';
@ISA = qw(IO::Uncompress::Base Exporter);
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
use warnings;
use bytes;
-use IO::Uncompress::RawInflate 2.090 ;
+use IO::Uncompress::RawInflate 2.093 ;
-use Compress::Raw::Zlib 2.090 () ;
-use IO::Compress::Base::Common 2.090 qw(:Status );
-use IO::Compress::Gzip::Constants 2.090 ;
-use IO::Compress::Zlib::Extra 2.090 ;
+use Compress::Raw::Zlib 2.093 () ;
+use IO::Compress::Base::Common 2.093 qw(:Status );
+use IO::Compress::Gzip::Constants 2.093 ;
+use IO::Compress::Zlib::Extra 2.093 ;
require Exporter ;
$GunzipError = '';
-$VERSION = '2.090';
+$VERSION = '2.093';
sub new
{
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
use warnings;
use bytes;
-use IO::Compress::Base::Common 2.090 qw(:Status );
-use IO::Compress::Zlib::Constants 2.090 ;
+use IO::Compress::Base::Common 2.093 qw(:Status );
+use IO::Compress::Zlib::Constants 2.093 ;
-use IO::Uncompress::RawInflate 2.090 ;
+use IO::Uncompress::RawInflate 2.093 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$InflateError = '';
@ISA = qw(IO::Uncompress::RawInflate Exporter);
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
use warnings;
use bytes;
-use Compress::Raw::Zlib 2.090 ;
-use IO::Compress::Base::Common 2.090 qw(:Status );
+use Compress::Raw::Zlib 2.093 ;
+use IO::Compress::Base::Common 2.093 qw(:Status );
-use IO::Uncompress::Base 2.090 ;
-use IO::Uncompress::Adapter::Inflate 2.090 ;
+use IO::Uncompress::Base 2.093 ;
+use IO::Uncompress::Adapter::Inflate 2.093 ;
require Exporter ;
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError);
-$VERSION = '2.090';
+$VERSION = '2.093';
$RawInflateError = '';
@ISA = qw(IO::Uncompress::Base Exporter);
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
use bytes;
use IO::File;
-use IO::Uncompress::RawInflate 2.090 ;
-use IO::Compress::Base::Common 2.090 qw(:Status );
-use IO::Uncompress::Adapter::Inflate 2.090 ;
-use IO::Uncompress::Adapter::Identity 2.090 ;
-use IO::Compress::Zlib::Extra 2.090 ;
-use IO::Compress::Zip::Constants 2.090 ;
+use IO::Uncompress::RawInflate 2.093 ;
+use IO::Compress::Base::Common 2.093 qw(:Status );
+use IO::Uncompress::Adapter::Inflate 2.093 ;
+use IO::Uncompress::Adapter::Identity 2.093 ;
+use IO::Compress::Zlib::Extra 2.093 ;
+use IO::Compress::Zip::Constants 2.093 ;
-use Compress::Raw::Zlib 2.090 () ;
+use Compress::Raw::Zlib 2.093 () ;
BEGIN
{
our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);
-$VERSION = '2.090';
+$VERSION = '2.093';
$UnzipError = '';
@ISA = qw(IO::Uncompress::RawInflate Exporter);
=item A filename
-If the <$input_filename_or_reference> parameter is a simple scalar, it is
+If the C<$input_filename_or_reference> parameter is a simple scalar, it is
assumed to be a filename. This file will be opened for reading and the
input data will be read from it.
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- my $VERSION = '2.090';
+ my $VERSION = '2.093';
my @NAMES = qw(
Compress::Raw::Bzip2
Compress::Raw::Zlib
);
- my @OPT = qw(
-
+ my @OPT = qw(
);
plan tests => 1 + 2 + @NAMES + @OPT + $extra ;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN {
if( $] < 5.008 ) {
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) }
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
=head1 NAME
package Test::Builder::Tester;
use strict;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test::Builder;
use Symbol;
package Test::Builder::Tester::Color;
use strict;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
require Test::Builder::Tester;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) }
return warn @_, " at $file line $line\n";
}
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test::Builder::Module;
our @ISA = qw(Test::Builder::Module);
use strict;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test::Builder::Module;
our @ISA = qw(Test::Builder::Module);
use vars qw( @ISA @EXPORT );
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
@EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
@ISA = qw( Exporter );
package Test::Tester::Capture;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test::Builder;
package Test::Tester::CaptureRunner;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test::Tester::Capture;
package Test::Tester::Delegate;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Scalar::Util();
package Test::use::ok;
use 5.005;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
__END__
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
1;
$ENV{TEST2_ACTIVE} = 1;
}
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
my $INST;
my $stack = $INST->stack or return;
my $root = $stack->root or return;
+ return unless $root->count;
+
return unless $$ == $INST->pid;
return unless get_tid() == $INST->tid;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::Util qw/pkg_to_file/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/confess croak/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
use Carp qw/confess carp/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::Hub();
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Scalar::Util qw/blessed reftype/;
use Carp qw/croak/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/croak/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::EventFacet::Info;
use Carp qw/croak/;
use Scalar::Util qw/reftype/;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::EventFacet::Info;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
use Test2::Util::HashBase qw{subevents buffered subtest_id subtest_uuid};
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/croak/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Scalar::Util qw/reftype/;
use Carp qw/croak/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::Util::HashBase qw/-details/;
use Carp qw/croak/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
use Test2::Util::HashBase qw{ -package -no_display -uuid -eid };
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
sub is_list { 1 }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
use Test2::Util::HashBase qw{ -pass -no_debug -number };
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
use Test2::Util::HashBase qw{ -global -terminate -halt -has_callback -encoding -phase };
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
sub facet_key { 'errors' }
sub is_list { 1 }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
sub is_list { 1 }
sub facet_key { 'hubs' }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
sub is_list { 1 }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/confess/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
use vars qw/$AUTOLOAD/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/confess/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
use Test2::Util::HashBase qw{ -count -skip -none };
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
sub is_list { 1 }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) }
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
my %ADDED;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::Util qw/clone_io/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/carp croak confess/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::Hub::Interceptor::Terminator();
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
1;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
use Test2::Util::HashBase qw/nested exit_code manual_skip_all/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Test2::API::Instance;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/confess/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
use Test2::Hub::Interceptor();
use Test2::Hub::Interceptor::Terminator();
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
BEGIN { require Exporter; our @ISA = qw(Exporter) }
our @EXPORT = qw{
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use POSIX();
use Config qw/%Config/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/croak/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use Carp qw/croak confess/;
use Scalar::Util qw/blessed/;
use strict;
use warnings;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
#################################################################
# #
require Test2::EventFacet::Trace;
@ISA = ('Test2::EventFacet::Trace');
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
1;
package ok;
-our $VERSION = '1.302169';
+our $VERSION = '1.302170';
use strict;
use Test::More ();
dXSARGS;
char *cwd;
- /* See https://rt.perl.org/rt3/Ticket/Display.html?id=38628
+ /* See https://github.com/Perl/perl5/issues/8345
There is Cwd->cwd() usage in the wild, and previous versions didn't die.
*/
if(items > 1)
=back
-You can use C<ok()> to report success or failure:
-
- ok($got, $expected, 'name');
- ok($got == 42); # Doesn't give good runtime diagnostics
-
- ok($got, eval "qr/foo/", 'name') # But don't execute this statement
- # on perls earlier than 5.005
-
-Unfortunately, the test name C<'name'> is output only on failure, so it can be
-awkward finding which of many tests executed at the same point in a loop is the
-one failing. Even though C<'name'> is optional, you will end up regretting not
-specifying it.
+As of version 3.56 of Devel::PPPort, the old Test style tests have been
+replaced with the more modern Test::More style, with some limitations. This
+means, for example, that C<is> is finally available, as well as
+C<done_testing>. You can pass the number of tests to C<skip>, instead of
+having to have your own C<for> loop.
+
+There is no C<like> nor C<unlike> (as those require C<qr> which didn't exist in
+the earliest perls that Devel::PPPort runs on).
+
+C<skip> doesn't do a S<C<last SKIP>>. (Perhaps it could, but that would mean
+converting all the skips in the existing tests.)
+
+The existing tests have been changed only as much as necessary so as to get
+things to work. But feel free to use the full functionality for any new tests
+you write.
+
+Here's a list of the supported functions:
+
+ cmp_ok
+ curr_test
+ diag
+ display
+ done_testing
+ eq_array
+ eq_hash
+ fail
+ is
+ isnt
+ next_test
+ note
+ ok
+ pass
+ plan
+ skip
+ skip_all
+ within
+
+These are copied from F<t/test.pl> in the perl distribution. Not all of them
+have been tested back as far as Devel::PPPort supports. Bug reports welcome.
It's fine to backport an element only as far as convenient and necessary. But
remember that your test file will end up being called on all perl versions
version. The recommended way to do this is like:
if (ivers($]) < ivers(5.6.2)) {
- skip "reason", 0;
+ skip "reason", $count;
}
elsif (if (ivers($]) > ivers(5.5) {
- skip "other reason", 0;
+ skip "other reason", $count;
}
-C<skip> doesn't work quite like the modern C<skip()> in, say, C<Test::More>.
-But you can pretend it pretty much does, by using it like the above. (And you
-really don't want to know the now-discarded API elements in it.) The C<"0">
-parameter is just to make it look like you know what you're doing.
-
C<ivers()> is a function automatically made available to all F<.t> files. It
converts any reasonble expression of a version number into an integer, which
can reliably be compared using numeric comparison operators, with the output of
#define bat baz
/* Replace: 0 */
-These replace C<foo> with C<bar>; C<bat> with C<baz>.
+These replace C<bar> with C<foo>; C<baz> with C<bat>. NOT the other way
+around.
=back
use strict;
use vars qw($VERSION $data);
-$VERSION = '3.55';
+$VERSION = '3.56';
sub _init_data
{
}
if (! $opt{'yes'}) {
- ask_or_quit("Are you SURE you have:\n1) updated parts/embed.fnc to latest blead?\n2) run devel/mkapidoc.sh to update parts/apidoc.fnc?\n3) run devel/mkppport_fnc.pl to update parts/ppport.fnc?\n");
+ ask_or_quit("Are you SURE you have:\n1) updated parts/embed.fnc to latest blead?\n2) run devel/mkapidoc.pl to update parts/apidoc.fnc?\n3) run devel/mkppport_fnc.pl to update parts/ppport.fnc?\n");
}
my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo );
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
Amnhd||G_METHOD
Amnhd||G_METHOD_NAMED
AmnUd||G_NOARGS
+Amnhd||G_RETHROW
AmdR|bool|GROK_NUMERIC_RADIX|NN const char **sp|NN const char *send
AmnUd||G_SCALAR
Amnhd||GV_ADD
Amd|STRLEN|SvCUR|SV* sv
Amd|void|SvCUR_set|SV* sv|STRLEN len
Amd|char*|SvEND|SV* sv
+Amnhd||SVf
+Amhd||SVfARG|SV *sv
Amnhd||SVf_UTF8
Amd|U32|SvGAMAGIC|SV* sv
Amd|void|SvGETMAGIC|SV* sv
isPUNCT # E
isPUNCT_LC # E
is_utf8_char # U
-is_utf8_mark # E
isXDIGIT # E
IVdf # E
IVSIZE # E
init_i18nl10n # F added by devel/scanprov
init_i18nl14n # F added by devel/scanprov
is_handle_constructor # F added by devel/scanprov
-is_uni_alnum # F added by devel/scanprov
-is_uni_alnum_lc # F added by devel/scanprov
-is_uni_alpha # F added by devel/scanprov
-is_uni_alpha_lc # F added by devel/scanprov
-is_uni_ascii # F added by devel/scanprov
-is_uni_ascii_lc # F added by devel/scanprov
-is_uni_cntrl # F added by devel/scanprov
-is_uni_cntrl_lc # F added by devel/scanprov
-is_uni_digit # F added by devel/scanprov
-is_uni_digit_lc # F added by devel/scanprov
-is_uni_graph # F added by devel/scanprov
-is_uni_graph_lc # F added by devel/scanprov
-is_uni_idfirst # F added by devel/scanprov
-is_uni_idfirst_lc # F added by devel/scanprov
-is_uni_lower # F added by devel/scanprov
-is_uni_lower_lc # F added by devel/scanprov
-is_uni_print # F added by devel/scanprov
-is_uni_print_lc # F added by devel/scanprov
-is_uni_punct # F added by devel/scanprov
-is_uni_punct_lc # F added by devel/scanprov
-is_uni_space # F added by devel/scanprov
-is_uni_space_lc # F added by devel/scanprov
-is_uni_upper # F added by devel/scanprov
-is_uni_upper_lc # F added by devel/scanprov
-is_uni_xdigit # F added by devel/scanprov
-is_uni_xdigit_lc # F added by devel/scanprov
load_module_nocontext # F added by devel/scanprov
magic_killbackrefs # F added by devel/scanprov
magic_regdata_cnt # F added by devel/scanprov
sv_catpvf_nocontext # F added by devel/scanprov
sv_del_backref # F added by devel/scanprov
sv_setpvf_nocontext # F added by devel/scanprov
-swash_fetch # F added by devel/scanprov
-swash_init # F added by devel/scanprov
sys_intern_dup # F added by devel/scanprov
to_uni_lower # F added by devel/scanprov
-to_uni_lower_lc # F added by devel/scanprov
to_uni_title # F added by devel/scanprov
-to_uni_title_lc # F added by devel/scanprov
to_uni_upper # F added by devel/scanprov
-to_uni_upper_lc # F added by devel/scanprov
utf16_to_utf8 # F added by devel/scanprov
utf16_to_utf8_reversed # F added by devel/scanprov
warner_nocontext # F added by devel/scanprov
SvGAMAGIC # U
utf8_to_bytes # U
do_trans_complex # F added by devel/scanprov
-do_trans_complex_utf8 # F added by devel/scanprov
do_trans_count # F added by devel/scanprov
-do_trans_count_utf8 # F added by devel/scanprov
do_trans_simple # F added by devel/scanprov
-do_trans_simple_utf8 # F added by devel/scanprov
find_in_my_stash # F added by devel/scanprov
magic_regdatum_set # F added by devel/scanprov
report_evil_fh # F added by devel/scanprov
av_arylen_p # U
ckwarn # U
ckwarn_d # U
-csighandler # E (Perl_csighandler)
dAXMARK # E
dMULTICALL # E
doref # U
invlist_set_len # F added by devel/scanprov
invlist_trim # F added by devel/scanprov
_new_invlist # F added by devel/scanprov
-Perl_feature_is_enabled # F added by devel/scanprov
regcurly # F added by devel/scanprov
5.015007
-swatch_get # F added by devel/scanprov
find_runcv_where # F added by devel/scanprov
grok_bslash_x # F added by devel/scanprov
invlist_highest # F added by devel/scanprov
-is_uni_blank # F added by devel/scanprov
magic_cleararylen_p # F added by devel/scanprov
opslab_force_free # F added by devel/scanprov
opslab_free # F added by devel/scanprov
SvREFCNT_dec_NN # U
forget_pmop # F added by devel/scanprov
isFOO_lc # F added by devel/scanprov
-is_uni_alnumc # F added by devel/scanprov
-is_uni_alnumc_lc # F added by devel/scanprov
-is_uni_blank_lc # F added by devel/scanprov
_is_uni_perl_idstart # F added by devel/scanprov
isFOO_utf8_lc # F added by devel/scanprov
_is_uni_FOO # F added by devel/scanprov
_is_uni_perl_idcont # F added by devel/scanprov
-_is_utf8_mark # F added by devel/scanprov
get_c_backtrace_dump # F added by devel/scanprov
_is_cur_LC_category_utf8 # F added by devel/scanprov
_is_in_locale_category # F added by devel/scanprov
-_is_utf8_idcont # F added by devel/scanprov
-_is_utf8_idstart # F added by devel/scanprov
-_is_utf8_xidcont # F added by devel/scanprov
-_is_utf8_xidstart # F added by devel/scanprov
my_strerror # F added by devel/scanprov
should_warn_nl # F added by devel/scanprov
-swash_scan_list_line # F added by devel/scanprov
put_charclass_bitmap_innards # F added by devel/scanprov
put_code_point # F added by devel/scanprov
quadmath_format_needed # F added by devel/scanprov
-quadmath_format_single # F added by devel/scanprov
PadnameREFCNT # U
PadnameREFCNT_dec # U
gv_fetchmeth_internal # F added by devel/scanprov
-_make_exactf_invlist # F added by devel/scanprov
opmethod_stash # F added by devel/scanprov
pad_add_weakref # F added by devel/scanprov
padname_dup # F added by devel/scanprov
toUPPER_utf8_safe # U
_force_out_malformed_utf8_message # F added by devel/scanprov
_is_grapheme # F added by devel/scanprov
-is_utf8_common_with_len # F added by devel/scanprov
-_is_utf8_FOO_with_len # F added by devel/scanprov
-_is_utf8_perl_idcont_with_len # F added by devel/scanprov
-_is_utf8_perl_idstart_with_len # F added by devel/scanprov
warn_on_first_deprecated_use # F added by devel/scanprov
5.031006
UTF8_CHK_SKIP # U
+do_trans_count_invmap # F added by devel/scanprov
+do_trans_invmap # F added by devel/scanprov
+invmap_dump # F added by devel/scanprov
+_is_utf8_FOO # F added by devel/scanprov
+_is_utf8_perl_idcont # F added by devel/scanprov
+_is_utf8_perl_idstart # F added by devel/scanprov
+make_exactf_invlist # F added by devel/scanprov
+sv_derived_from_svpvn # F added by devel/scanprov
5.031007
-my_lstat # U (Perl_my_lstat)
-my_stat # U (Perl_my_stat)
-pack_cat # U (Perl_pack_cat)
-pad_compname_type # U (Perl_pad_compname_type)
+csighandler # E (Perl_csighandler)
+csighandler1 # U
+csighandler3 # E
+perly_sighandler # E
+find_first_differing_byte_pos # F added by devel/scanprov
+invlist_lowest # F added by devel/scanprov
+quadmath_format_valid # F added by devel/scanprov
+sighandler1 # F added by devel/scanprov
+sighandler3 # F added by devel/scanprov
p |void |gv_setref |NN SV *const dstr|NN SV *const sstr
Apd |HV* |gv_stashpv |NN const char* name|I32 flags
Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags
+#if defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C)
+EpG |HV* |gv_stashsvpvn_cached |NULLOK SV *namesv|NULLOK const char* name|U32 namelen|I32 flags
+#endif
#if defined(PERL_IN_GV_C)
i |HV* |gv_stashpvn_internal |NN const char* name|U32 namelen|I32 flags
-iG |HV* |gv_stashsvpvn_cached |NULLOK SV *namesv|NULLOK const char* name|U32 namelen|I32 flags
i |GV* |gv_fetchmeth_internal |NULLOK HV* stash|NULLOK SV* meth|NULLOK const char* name \
|STRLEN len|I32 level|U32 flags
#endif
: Used in cop.h
XopR |I32 |was_lvalue_sub
CpRTP |STRLEN |is_utf8_char_helper|NN const U8 * const s|NN const U8 * e|const U32 flags
-CbDpR |U32 |to_uni_upper_lc|U32 c
-CbDpR |U32 |to_uni_title_lc|U32 c
-CbDpR |U32 |to_uni_lower_lc|U32 c
-CbDpR |bool |is_uni_alnum |UV c
-CbDpR |bool |is_uni_alnumc |UV c
-CbDpR |bool |is_uni_idfirst |UV c
-CbDpR |bool |is_uni_alpha |UV c
-CbDpPR |bool |is_uni_ascii |UV c
-CbDpPR |bool |is_uni_blank |UV c
-CbDpPR |bool |is_uni_space |UV c
-CbDpPR |bool |is_uni_cntrl |UV c
-CbDpR |bool |is_uni_graph |UV c
-CbDpR |bool |is_uni_digit |UV c
-CbDpR |bool |is_uni_upper |UV c
-CbDpR |bool |is_uni_lower |UV c
-CbDpR |bool |is_uni_print |UV c
-CbDpR |bool |is_uni_punct |UV c
-CbDpPR |bool |is_uni_xdigit |UV c
Cp |UV |to_uni_upper |UV c|NN U8 *p|NN STRLEN *lenp
Cp |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp
p |void |init_uniprops
Cp |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp
Cm |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp
Cp |UV |_to_uni_fold_flags|UV c|NN U8 *p|NN STRLEN *lenp|U8 flags
-CbDpR |bool |is_uni_alnum_lc|UV c
-CbDpR |bool |is_uni_alnumc_lc|UV c
-CbDpR |bool |is_uni_idfirst_lc|UV c
CpR |bool |_is_uni_perl_idcont|UV c
CpR |bool |_is_uni_perl_idstart|UV c
-CbDpR |bool |is_uni_alpha_lc|UV c
-CbDpPR |bool |is_uni_ascii_lc|UV c
-CbDpPR |bool |is_uni_space_lc|UV c
-CbDpPR |bool |is_uni_blank_lc|UV c
-CbDpPR |bool |is_uni_cntrl_lc|UV c
-CbDpR |bool |is_uni_graph_lc|UV c
-CbDpR |bool |is_uni_digit_lc|UV c
-CbDpR |bool |is_uni_upper_lc|UV c
-CbDpR |bool |is_uni_lower_lc|UV c
-CbDpR |bool |is_uni_print_lc|UV c
-CbDpR |bool |is_uni_punct_lc|UV c
-CbDpPR |bool |is_uni_xdigit_lc|UV c
ATdmoR |bool |is_utf8_invariant_string|NN const U8* const s \
|STRLEN len
ATidRp |bool |is_utf8_invariant_string_loc|NN const U8* const s \
|NN const U8 * const s|NN const U8 * const e
ATidRp |bool |is_utf8_valid_partial_char_flags \
|NN const U8 * const s|NN const U8 * const e|const U32 flags
-CpR |bool |_is_uni_FOO|const U8 classnum|const UV c
-CpR |bool |_is_utf8_FOO_with_len|const U8 classnum|NN const U8 *p \
- |NN const U8 * const e
-CpR |bool |_is_utf8_idcont|NN const U8 *p
-CpR |bool |_is_utf8_idstart|NN const U8 *p
-CpR |bool |_is_utf8_xidcont|NN const U8 *p
-CpR |bool |_is_utf8_xidstart|NN const U8 *p
-CpR |bool |_is_utf8_perl_idcont_with_len|NN const U8 *p \
+CpR |bool |_is_uni_FOO|const U8 classnum|const UV c
+CpR |bool |_is_utf8_FOO|const U8 classnum|NN const U8 *p \
|NN const U8 * const e
-CpR |bool |_is_utf8_perl_idstart_with_len|NN const U8 *p \
- |NN const U8 * const e
-CpR |bool |_is_utf8_mark |NN const U8 *p
-AbDxpR |bool |is_utf8_mark |NN const U8 *p
+CpR |bool |_is_utf8_perl_idcont|NN const U8 *p|NN const U8 * const e
+CpR |bool |_is_utf8_perl_idstart|NN const U8 *p|NN const U8 * const e
+
#if defined(PERL_CORE) || defined(PERL_EXT)
EXdpR |bool |isSCRIPT_RUN |NN const U8 *s|NN const U8 *send \
|const bool utf8_target
#if defined(PERL_IN_OP_C)
S |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl
#endif
+p |void |invmap_dump |NN SV* invlist|NN UV * map
Ap |void |pop_scope
Ap |void |push_scope
#if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_TOKE_C)
pe |void |set_caret_X
Apd |void |setdefout |NN GV* gv
Ap |HEK* |share_hek |NN const char* str|SSize_t len|U32 hash
-#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+#ifdef PERL_USE_3ARG_SIGHANDLER
: Used in perl.c
-Tp |Signal_t |sighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap
-ATp |Signal_t |csighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap
+Tp |Signal_t |sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
+ATp |Signal_t |csighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
#else
Tp |Signal_t |sighandler |int sig
ATp |Signal_t |csighandler |int sig
#endif
+Tp |Signal_t |sighandler1 |int sig
+ATp |Signal_t |csighandler1 |int sig
+Tp |Signal_t |sighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
+ATp |Signal_t |csighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap
+ATp |Signal_t |perly_sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap|bool safe
Ap |SV** |stack_grow |NN SV** sp|NN SV** p|SSize_t n
Ap |I32 |start_subparse |I32 is_format|U32 flags
Xp |void |init_named_cv |NN CV *cv|NN OP *nameop
|NULLOK va_list *const args|NULLOK SV **const svargs \
|const Size_t sv_count|NULLOK bool *const maybe_tainted
ApR |NV |str_to_version |NN SV *sv
-EXpR |SV* |swash_init |NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits|I32 none
-EXp |UV |swash_fetch |NN SV *swash|NN const U8 *ptr|bool do_utf8
-#ifdef PERL_IN_REGCOMP_C
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
EiR |SV* |add_cp_to_invlist |NULLOK SV* invlist|const UV cp
+Ei |void |invlist_extend |NN SV* const invlist|const UV len
+Ei |void |invlist_set_len|NN SV* const invlist|const UV len|const bool offset
+EiRT |UV |invlist_highest|NN SV* const invlist
+EiRT |STRLEN*|get_invlist_iter_addr |NN SV* invlist
+EiT |void |invlist_iterinit|NN SV* invlist
+EiRT |bool |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
+EiT |void |invlist_iterfinish|NN SV* invlist
+#endif
+#if defined(PERL_IN_REGCOMP_C)
EiRT |bool |invlist_is_iterating|NN SV* const invlist
+EiR |SV* |invlist_contents|NN SV* const invlist \
+ |const bool traditional_style
+EixRT |UV |invlist_lowest|NN SV* const invlist
#ifndef PERL_EXT_RE_BUILD
EiRT |UV* |_invlist_array_init |NN SV* const invlist|const bool will_have_0
EiRT |UV |invlist_max |NN SV* const invlist
-ES |void |_append_range_to_invlist |NN SV* const invlist|const UV start|const UV end
-ES |void |invlist_extend |NN SV* const invlist|const UV len
-ES |void |invlist_replace_list_destroys_src|NN SV *dest|NN SV *src
EiRT |IV* |get_invlist_previous_index_addr|NN SV* invlist
-Ei |void |invlist_set_len|NN SV* const invlist|const UV len|const bool offset
EiT |void |invlist_set_previous_index|NN SV* const invlist|const IV index
EiRT |IV |invlist_previous_index|NN SV* const invlist
EiT |void |invlist_trim |NN SV* invlist
Ei |void |invlist_clear |NN SV* invlist
-S |void |initialize_invlist_guts|NN SV* invlist|const Size_t initial_size
#endif
-EiRT |STRLEN*|get_invlist_iter_addr |NN SV* invlist
-EiT |void |invlist_iterinit|NN SV* invlist
-ESRT |bool |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
-EiT |void |invlist_iterfinish|NN SV* invlist
-EiRT |UV |invlist_highest|NN SV* const invlist
-ERS |SV* |_make_exactf_invlist |NN RExC_state_t *pRExC_state \
- |NN regnode *node
-ESR |SV* |invlist_contents|NN SV* const invlist \
- |const bool traditional_style
ESRT |bool |new_regcurly |NN const char *s|NN const char *e
+ERS |SV* |make_exactf_invlist |NN RExC_state_t *pRExC_state \
+ |NN regnode *node
+#ifndef PERL_EXT_RE_BUILD
+ES |void |_append_range_to_invlist |NN SV* const invlist|const UV start|const UV end
+ES |void |invlist_replace_list_destroys_src|NN SV *dest|NN SV *src
+S |void |initialize_invlist_guts|NN SV* invlist|const Size_t initial_size
+#endif
#endif
-#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
m |void |_invlist_intersection |NN SV* const a|NN SV* const b|NN SV** i
EXp |void |_invlist_intersection_maybe_complement_2nd \
|NULLOK SV* const a|NN SV* const b \
#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_SV_C)
EpX |SV* |invlist_clone |NN SV* const invlist|NULLOK SV* newlist
#endif
-#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C)
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) \
+ || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UTF8_C) \
+ || defined(PERL_IN_PP_C) || defined(PERL_IN_OP_C) \
+ || defined(PERL_IN_DOOP_C)
EiRT |UV* |invlist_array |NN SV* const invlist
EiRT |bool |is_invlist |NULLOK SV* const invlist
EiRT |bool* |get_invlist_offset_addr|NN SV* invlist
|NULLOK SV **lonly_utf8_locale \
|NULLOK SV **output_invlist
#endif
-#if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C)
+#if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C) || defined(PERL_IN_OP_C)
EXp |void |_invlist_dump |NN PerlIO *file|I32 level \
|NN const char* const indent \
|NN SV* const invlist
#endif
Ap |void |taint_env
Ap |void |taint_proper |NULLOK const char* f|NN const char *const s
-Ep |char * |_byte_dump_string \
+EXp |char * |_byte_dump_string \
|NN const U8 * const start \
|const STRLEN len \
|const bool format
p |void |init_constants
#if defined(PERL_IN_DOOP_C)
-SR |Size_t |do_trans_simple |NN SV * const sv
-SR |Size_t |do_trans_count |NN SV * const sv
-SR |Size_t |do_trans_complex |NN SV * const sv
-SR |Size_t |do_trans_simple_utf8 |NN SV * const sv
-SR |Size_t |do_trans_count_utf8 |NN SV * const sv
-SR |Size_t |do_trans_complex_utf8 |NN SV * const sv
+SR |Size_t |do_trans_simple |NN SV * const sv|NN const OPtrans_map * const tbl
+SR |Size_t |do_trans_count |NN SV * const sv|NN const OPtrans_map * const tbl
+SR |Size_t |do_trans_complex |NN SV * const sv|NN const OPtrans_map * const tbl
+SR |Size_t |do_trans_invmap |NN SV * const sv|NN AV * const map
+SR |Size_t |do_trans_count_invmap |NN SV * const sv|NN AV * const map
#endif
#if defined(PERL_IN_GV_C)
ES |void |output_posix_warnings \
|NN RExC_state_t *pRExC_state \
|NN AV* posix_warnings
+EiT |Size_t |find_first_differing_byte_pos|NN const U8 * s1|NN const U8 * s2| const Size_t max
ES |AV* |add_multi_match|NULLOK AV* multi_char_matches \
|NN SV* multi_string \
|const STRLEN cp_count
|NULLOK SV* nonbitmap_invlist \
|NULLOK SV* only_utf8_locale_invlist\
|NULLOK const regnode * const node \
+ |const U8 flags \
|const bool force_as_is_display
ES |SV* |put_charclass_bitmap_innards_common \
|NN SV* invlist \
|bool curstash
#if defined(PERL_IN_UNIVERSAL_C)
-S |bool |isa_lookup |NN HV *stash|NN const char * const name \
+SG |bool |isa_lookup |NULLOK HV *stash|NULLOK SV *namesv|NULLOK const char * name \
|STRLEN len|U32 flags
+SG |bool |sv_derived_from_svpvn |NULLOK SV *sv \
+ |NULLOK SV *namesv \
+ |NULLOK const char * name \
+ |const STRLEN len \
+ |U32 flags
#endif
#if defined(PERL_IN_LOCALE_C)
|NN U8* const ustrp \
|NN STRLEN *lenp
iR |bool |is_utf8_common |NN const U8 *const p \
+ |NN const U8 *const e \
|NULLOK SV* const invlist
-iR |bool |is_utf8_common_with_len|NN const U8 *const p \
- |NN const U8 *const e \
- |NULLOK SV* const invlist
-SR |SV* |swatch_get |NN SV* swash|UV start|UV span
-SR |U8* |swash_scan_list_line|NN U8* l|NN U8* const lend|NN UV* min \
- |NN UV* max|NN UV* val|const bool wants_value \
- |NN const U8* const typestr
#endif
EXiTp |void |append_utf8_from_native_byte|const U8 byte|NN U8** dest
ApT |int |my_socketpair |int family|int type|int protocol|int fd[2]
ApT |int |my_dirfd |NULLOK DIR* dir
#ifdef PERL_ANY_COW
-: Used in pp_hot.c and regexec.c
+: Used in regexec.c
pxXE |SV* |sv_setsv_cow |NULLOK SV* dstr|NN SV* sstr
#endif
AMpTdf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|...
AMpTd |int |my_vsnprintf |NN char *buffer|const Size_t len|NN const char *format|va_list ap
#ifdef USE_QUADMATH
-ApTd |const char* |quadmath_format_single|NN const char* format
-ApTd |bool|quadmath_format_needed|NN const char* format
+pTd |bool |quadmath_format_valid|NN const char* format
+pTd |bool|quadmath_format_needed|NN const char* format
#endif
: Used in mg.c, sv.c
: Used in perl.c and toke.c
op |void |populate_isa |NN const char *name|STRLEN len|...
-: Used in keywords.c and toke.c
-Xop |bool |feature_is_enabled|NN const char *const name \
- |STRLEN namelen
-
: Some static inline functions need predeclaration because they are used
: inside other static inline functions.
#if defined(PERL_CORE) || defined (PERL_EXT)
=tests plan => 4
-ok(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
+is(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
ok(!defined Devel::PPPort::HvNAME_get({}));
-ok(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
-ok(Devel::PPPort::HvNAMELEN_get({}), 0);
+is(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
+is(Devel::PPPort::HvNAMELEN_get({}), 0);
my $mhx = "mhx";
-ok(&Devel::PPPort::SvPVbyte($mhx), 3);
+is(&Devel::PPPort::SvPVbyte($mhx), 3);
my $i = 42;
-ok(&Devel::PPPort::SvPV_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
+is(&Devel::PPPort::SvPV_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_force($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
my $str = "";
&Devel::PPPort::SvPV_force($str);
my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80);
-ok($str, "x"x80);
-ok($s2, "x"x80);
+is($str, "x"x80);
+is($s2, "x"x80);
ok($before < 81);
-ok($after, 81);
+is($after, 81);
$str = "x"x400;
&Devel::PPPort::SvPV_force($str);
($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40);
-ok($str, "x"x40);
-ok($s2, "x"x40);
+is($str, "x"x40);
+is($s2, "x"x40);
ok($before > 41);
-ok($after, 41);
+is($after, 41);
=tests plan => 15
my $foo = 5;
-ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
-ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
-ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
+is(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
+is(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
+is(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
my $bar = [];
bless $bar, 'foo';
-ok($bar->x(), 'foobar');
+is($bar->x(), 'foobar');
Devel::PPPort::TestSvSTASH_set($bar, 'bar');
-ok($bar->x(), 'hacker');
+is($bar->x(), 'hacker');
if ( "$]" < '5.007003' ) {
- for (1..10) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 10;
} else {
ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL());
tie my $scalar, 'TieScalarCounter', 'string';
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $copy = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $copy2 = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok $copy2, 'string';
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is $copy2, 'string';
}
package TieScalarCounter;
=tests plan => 86
-sub eq_array
-{
- my($a, $b) = @_;
- join(':', @$a) eq join(':', @$b);
-}
-
sub f
{
shift;
ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected));
};
-ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
-ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
+is(&Devel::PPPort::eval_pv('f()', 0), 'y');
+is(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
-ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
+is(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
Devel::PPPort::load_module(0, "less", undef);
-ok(defined $::{'less::'}, 1, "Have now loaded less");
+is(defined $::{'less::'}, 1, "Have now loaded less");
ok(eval { Devel::PPPort::eval_pv('die', 0); 1 });
ok(!eval { Devel::PPPort::eval_pv('die', 1); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
ok(eval { Devel::PPPort::eval_sv('die', 0); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
{
#endif /* 5.6.0 */
-=tests plan => 28
+=tests plan => 8
my $package;
{
$package = &Devel::PPPort::CopSTASHPV();
}
print "# $package\n";
-ok($package, "MyPackage");
+is($package, "MyPackage");
my $file = &Devel::PPPort::CopFILE();
print "# $file\n";
BEGIN {
if ("$]" < 5.006000) {
- # Skip
- for (1..28) {
- ok(1, 1);
- }
+ skip("Perl version too early", 8);
exit;
}
}
) {
my ($sub, $arg, @want) = @$_;
my @got = $sub->($arg);
- ok(@got, @want);
- for (0..$#want) {
- ok($got[$_], $want[$_]);
- }
+ ok(eq_array(\@got, \@want));
}
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(0) };
-ok($@, '');
+is($@, '');
ok(defined $rv);
-ok($rv, 42);
-ok($Devel::PPPort::exception_caught, 0);
+is($rv, 42);
+is($Devel::PPPort::exception_caught, 0);
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(1) };
-ok($@, "boo\n");
+is($@, "boo\n");
ok(not defined $rv);
-ok($Devel::PPPort::exception_caught, 1);
+is($Devel::PPPort::exception_caught, 1);
use Config;
if ("$]" < '5.004') {
- for (1..5) {
- skip 'skip: No newSVpvf support', 0;
- }
+ skip 'skip: No newSVpvf support', 5;
exit;
}
eval { Devel::PPPort::croak_NVgf($num) };
ok($@ =~ /^1.1234567890/);
-ok(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
-ok(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
+is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
+is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
my $ivsize = $Config::Config{ivsize};
my $ivmax = ($ivsize == 4) ? '2147483647' : ($ivsize == 8) ? '9223372036854775807' : 0;
my $uvmax = ($ivsize == 4) ? '4294967295' : ($ivsize == 8) ? '18446744073709551615' : 0;
if ($ivmax == 0) {
- for (1..2) {
- skip 'skip: unknown ivsize', 0;
- }
+ skip 'skip: unknown ivsize', 2;
} else {
- ok(Devel::PPPort::sprintf_ivmax(), $ivmax);
- ok(Devel::PPPort::sprintf_uvmax(), $uvmax);
+ is(Devel::PPPort::sprintf_ivmax(), $ivmax);
+ is(Devel::PPPort::sprintf_uvmax(), $uvmax);
}
=tests plan => 10
-ok(&Devel::PPPort::grok_number("42"), 42);
+is(&Devel::PPPort::grok_number("42"), 42);
ok(!defined(&Devel::PPPort::grok_number("A")));
-ok(&Devel::PPPort::grok_bin("10000001"), 129);
-ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::grok_oct("377"), 255);
+is(&Devel::PPPort::grok_bin("10000001"), 129);
+is(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::grok_oct("377"), 255);
-ok(&Devel::PPPort::Perl_grok_number("42"), 42);
+is(&Devel::PPPort::Perl_grok_number("42"), 42);
ok(!defined(&Devel::PPPort::Perl_grok_number("A")));
-ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
-ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::Perl_grok_oct("377"), 255);
+is(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
+is(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::Perl_grok_oct("377"), 255);
=tests plan => 7
-ok(Devel::PPPort::GvSVn(), 1);
+is(Devel::PPPort::GvSVn(), 1);
-ok(Devel::PPPort::isGV_with_GP(), 2);
+is(Devel::PPPort::isGV_with_GP(), 2);
-ok(Devel::PPPort::get_cvn_flags(), 3);
+is(Devel::PPPort::get_cvn_flags(), 3);
-ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
+is(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
ok($::{sanity_check});
# if { VERSION >= 5.21.3 }
# undef sync_locale
# define sync_locale() (Perl_sync_locale(aTHX), 1)
+# elif defined(sync_locale) /* These should be the 5.20 maints*/
+# undef sync_locale /* Just copy their defn and return 1 */
+# define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), \
+ new_collate(setlocale(LC_COLLATE, NULL)), \
+ set_numeric_local(), \
+ new_numeric(setlocale(LC_NUMERIC, NULL)), \
+ 1)
# elif defined(new_ctype) && defined(LC_CTYPE)
# define sync_locale() (new_ctype(setlocale(LC_CTYPE, NULL)), 1)
-# else
-# undef sync_locale
# endif
# endif
#endif
=tests plan => 10
-ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
-
-ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
+is(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
+
+is(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
# Find proper magic
ok(my $obj1 = Devel::PPPort->new_with_mg());
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Find with no magic
my $obj = bless {}, 'Fake::Class';
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Find with other magic (not the magic we are looking for)
ok($obj = Devel::PPPort->new_with_other_mg());
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Okay, attempt to remove magic that isn't there
Devel::PPPort::remove_other_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Remove magic that IS there
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
# Removing when no magic present
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
use Tie::Hash;
my %h;
$h{bar} = '';
&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
-ok($h{foo}, 'foobar');
+is($h{foo}, 'foobar');
&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
-ok($h{bar}, 'baz');
+is($h{bar}, 'baz');
&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
-ok($h{foo}, 'foobar42');
+is($h{foo}, 'foobar42');
&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
-ok($h{bar}, 42);
+is($h{bar}, 42);
&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
ok(abs($h{PI} - 3.14159) < 0.01);
&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
-ok($h{mhx}, 'mhx');
+is($h{mhx}, 'mhx');
&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
-ok($h{mhx}, 'Marcus');
+is($h{mhx}, 'Marcus');
&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
-ok($h{sv}, 'SV');
+is($h{sv}, 'SV');
&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
-ok($h{sv}, 4711);
+is($h{sv}, 4711);
&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
-ok($h{sv}, 'Perl');
+is($h{sv}, 'Perl');
# v1 is treated as a bareword in older perls...
my $ver = do { local $SIG{'__WARN__'} = sub {}; eval qq[v1.2.0] };
ok($foo eq 'bar');
if ( "$]" < '5.007003' ) {
- for (1..22) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 22;
} else {
tie my $scalar, 'TieScalarCounter', 10;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvIV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvUV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvNV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvIV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvUV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvNV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
ok Devel::PPPort::magic_SvTRUE_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $object = OverloadedObject->new('string', 5.5, 0);
- ok Devel::PPPort::magic_SvIV_nomg($object), 5;
- ok Devel::PPPort::magic_SvUV_nomg($object), 5;
- ok Devel::PPPort::magic_SvNV_nomg($object), 5.5;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
+ is Devel::PPPort::magic_SvIV_nomg($object), 5;
+ is Devel::PPPort::magic_SvUV_nomg($object), 5;
+ is Devel::PPPort::magic_SvNV_nomg($object), 5.5;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
ok !Devel::PPPort::magic_SvTRUE_nomg($object);
}
=tests plan => 1
-ok(Devel::PPPort::checkmem(), 6);
+is(Devel::PPPort::checkmem(), 6);
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1\n") };
-ok $@, "\xE1\n";
-ok $die, "\xE1\n";
+is $@, "\xE1\n";
+is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(10) };
-ok $@ =~ /^10 at $0 line /;
-ok $die =~ /^10 at $0 line /;
+ok $@ =~ /^10 at \Q$0\E line /;
+ok $die =~ /^10 at \Q$0\E line /;
undef $die;
$@ = 'should not be visible (1)';
$@ = 'should not be visible (2)';
Devel::PPPort::croak_sv('');
};
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv($@)
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv($@)
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv_errsv()
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv_errsv()
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv_with_counter("message\n") };
-ok $@, "message\n";
-ok Devel::PPPort::get_counter(), 1;
+is $@, "message\n";
+is Devel::PPPort::get_counter(), 1;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv('') };
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1") };
-ok $@ =~ /^\xE1 at $0 line /;
-ok $die =~ /^\xE1 at $0 line /;
+ok $@ =~ /^\xE1 at \Q$0\E line /;
+ok $die =~ /^\xE1 at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
-ok $@ =~ /^\xC3\xA1 at $0 line /;
-ok $die =~ /^\xC3\xA1 at $0 line /;
+ok $@ =~ /^\xC3\xA1 at \Q$0\E line /;
+ok $die =~ /^\xC3\xA1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1\n");
-ok $warn, "\xE1\n";
+is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(10);
-ok $warn =~ /^10 at $0 line /;
+ok $warn =~ /^10 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv('');
-ok $warn =~ /^ at $0 line /;
+ok $warn =~ /^ at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1");
-ok $warn =~ /^\xE1 at $0 line /;
+ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
-ok $warn =~ /^\xC3\xA1 at $0 line /;
+ok $warn =~ /^\xC3\xA1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
+is Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
+is Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
-ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at $0 line /;
+ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv('', 0) =~ /^ at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at $0 line /;
+ok Devel::PPPort::mess_sv('', 0) =~ /^ at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at \Q$0\E line /;
if ("$]" >= '5.006') {
BEGIN { if ("$]" >= '5.006' && "$]" < '5.008') { require utf8; utf8->import(); } }
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}\n") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@, "\x{100}\n";
+ is $@, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die, "\x{100}\n";
+ is $die, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@ =~ /^\x{100} at $0 line /;
+ ok $@ =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die =~ /^\x{100} at $0 line /;
+ ok $die =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
undef $warn;
Devel::PPPort::warn_sv("\x{100}\n");
- ok $warn, "\x{100}\n";
+ is $warn, "\x{100}\n";
undef $warn;
Devel::PPPort::warn_sv("\x{100}");
- ok (my $tmp = $warn) =~ /^\x{100} at $0 line /;
+ ok (my $tmp = $warn) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..2) {
- skip 'skip: broken utf8 support in warn hook', 0;
- }
+ skip 'skip: broken utf8 support in warn hook', 2;
}
- ok Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
+ is Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
+ is Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
- ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at $0 line /;
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at $0 line /;
+ ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at \Q$0\E line /;
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..12) {
- skip 'skip: no utf8 support', 0;
- }
+ skip 'skip: no utf8 support', 12;
}
if (ord('A') != 65) {
- for (1..24) {
- skip 'skip: no ASCII support', 0;
- }
+ skip 'skip: no ASCII support', 24;
} elsif ( "$]" >= '5.008'
&& "$]" != '5.013000' # Broken in these ranges
&& ! ("$]" >= '5.011005' && "$]" <= '5.012000'))
{
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}\n"') };
- ok $@, "\xE1\n";
- ok $die, "\xE1\n";
+ is $@, "\xE1\n";
+ is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}"') };
- ok $@ =~ /^\xE1 at $0 line /;
- ok $die =~ /^\xE1 at $0 line /;
+ ok $@ =~ /^\xE1 at \Q$0\E line /;
+ ok $die =~ /^\xE1 at \Q$0\E line /;
{
undef $die;
my $expect = eval '"\N{U+C3}\N{U+A1}\n"';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1\n") };
- ok $@, $expect;
- ok $die, $expect;
+ is $@, $expect;
+ is $die, $expect;
}
{
undef $die;
- my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
ok $@ =~ $expect;
ok $die =~ $expect;
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}\n"');
- ok $warn, "\xE1\n";
+ is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}"');
- ok $warn =~ /^\xE1 at $0 line /;
+ ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1\n");
- ok $warn, eval '"\N{U+C3}\N{U+A1}\n"';
+ is $warn, eval '"\N{U+C3}\N{U+A1}\n"';
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
- ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
if ("$]" < '5.004') {
- for (1..8) {
- skip 'skip: no support for mess_sv', 0;
- }
+ skip 'skip: no support for mess_sv', 8;
}
else {
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at $0 line /';
+ ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
- ok Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
}
} else {
- for (1..24) {
- skip 'skip: no support for \N{U+..} syntax', 0;
- }
+ skip 'skip: no support for \N{U+..} syntax', 24;
}
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
ok $@ == $obj;
ok $die == $obj;
} else {
- for (1..12) {
- skip 'skip: no support for exceptions', 0;
- }
+ skip 'skip: no support for exceptions', 12;
}
ok !defined eval { Devel::PPPort::croak_no_modify() };
-ok $@ =~ /^Modification of a read-only value attempted at $0 line /;
+ok $@ =~ /^Modification of a read-only value attempted at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_memory_wrap() };
-ok $@ =~ /^panic: memory wrap at $0 line /;
+ok $@ =~ /^panic: memory wrap at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_xs_usage("params") };
-ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at $0 line /;
+ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at \Q$0\E line /;
ok(!&Devel::PPPort::boolSV(0));
$_ = "Fred";
-ok(&Devel::PPPort::DEFSV(), "Fred");
-ok(&Devel::PPPort::UNDERBAR(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::UNDERBAR(), "Fred");
if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) {
eval q{
no warnings "deprecated";
no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
my $_ = "Tony";
- ok(&Devel::PPPort::DEFSV(), "Fred");
- ok(&Devel::PPPort::UNDERBAR(), "Tony");
+ is(&Devel::PPPort::DEFSV(), "Fred");
+ is(&Devel::PPPort::UNDERBAR(), "Tony");
};
}
else {
my @r = &Devel::PPPort::DEFSV_modify();
ok(@r == 3);
-ok($r[0], 'Fred');
-ok($r[1], 'DEFSV');
-ok($r[2], 'Fred');
+is($r[0], 'Fred');
+is($r[1], 'DEFSV');
+is($r[2], 'Fred');
-ok(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
eval { 1 };
ok(!&Devel::PPPort::ERRSV());
ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
ok(&Devel::PPPort::get_cv('not_my_cv', 1));
-ok(Devel::PPPort::dXSTARG(42), 43);
-ok(Devel::PPPort::dAXMARK(4711), 4710);
+is(Devel::PPPort::dXSTARG(42), 43);
+is(Devel::PPPort::dAXMARK(4711), 4710);
-ok(Devel::PPPort::prepush(), 42);
+is(Devel::PPPort::prepush(), 42);
-ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
-ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
+is(join(':', Devel::PPPort::xsreturn(0)), 'test1');
+is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
-ok(Devel::PPPort::PERL_ABS(42), 42);
-ok(Devel::PPPort::PERL_ABS(-13), 13);
+is(Devel::PPPort::PERL_ABS(42), 42);
+is(Devel::PPPort::PERL_ABS(-13), 13);
-ok(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
-ok(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
+is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
+is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
-ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
+is(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
-ok(&Devel::PPPort::ptrtests(), 63);
+is(&Devel::PPPort::ptrtests(), 63);
-ok(&Devel::PPPort::OpSIBLING_tests(), 0);
+is(&Devel::PPPort::OpSIBLING_tests(), 0);
if (ivers($]) >= ivers(5.9)) {
eval q{
- ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
- ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
+ is(&Devel::PPPort::check_HeUTF8("hello"), "norm");
+ is(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
};
} else {
- ok(1, 1);
- ok(1, 1);
+ skip("Too early perl version", 2);
}
@r = &Devel::PPPort::check_c_array();
-ok($r[0], 4);
-ok($r[1], "13");
+is($r[0], 4);
+is($r[1], "13");
ok(!Devel::PPPort::SvRXOK(""));
ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
if (ivers($]) < ivers(5.5)) {
- skip 'no qr// objects in this perl', 0;
- skip 'no qr// objects in this perl', 0;
+ skip 'no qr// objects in this perl', 2;
} else {
my $qr = eval 'qr/./';
ok(Devel::PPPort::SvRXOK($qr));
? 0 # Fail on non-ASCII unless unicode
: ($types{"$native:$class"} || 0);
if (ivers($]) < ivers(5.6) && $suffix eq '_uvchr') {
- skip("No UTF-8 on this perl", 0);
+ skip("No UTF-8 on this perl", 1);
next;
}
my $eval_string = "Devel::PPPort::is${class}$suffix($hex)";
my $is = eval $eval_string || 0;
die "eval 'For $i: $eval_string' gave $@" if $@;
- ok($is, $should_be, "'$eval_string'");
+ is($is, $should_be, "'$eval_string'");
}
}
my $utf8;
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
else {
$utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i);
my $should_be = $types{"$native:$class"} || 0;
+ local $SIG{__WARN__} = sub {};
my $eval_string = "$fcn(\"$utf8\", 0)";
my $is = eval $eval_string || 0;
die "eval 'For $i, $eval_string' gave $@" if $@;
- ok($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
}
# And for the high code points, test that a too short malformation (the
# -1) causes it to fail
if ($i > 255) {
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
elsif (ivers($]) >= ivers(5.25.9)) {
- skip("Prints an annoying error message that khw doesn't know how to easily suppress", 0);
+ skip("Prints an annoying error message that khw doesn't know how to easily suppress", 1);
}
else {
my $eval_string = "$fcn(\"$utf8\", -1)";
my $is = eval "no warnings; $eval_string" || 0;
die "eval '$eval_string' gave $@" if $@;
- ok($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
}
}
}
$skip = "Can't do uvchr on a multi-char string";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
if ($is_cp) {
my $ret = eval "Devel::PPPort::$fcn($original)";
my $fail = $@; # Have to save $@, as it gets destroyed
- ok ($fail, "", "$fcn($original) didn't fail");
+ is ($fail, "", "$fcn($original) didn't fail");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
$skip = "Don't try to test shortened single bytes";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
my $fcn = "to${name}_utf8_safe";
my $ret = eval "no warnings; $eval_string" || 0;
my $fail = $@; # Have to save $@, as it gets destroyed
if ($truncate == 0) {
- ok ($fail, "", "Didn't fail on full length input");
+ is ($fail, "", "Didn't fail on full length input");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
else {
- ok ($fail, eval 'qr/Malformed UTF-8 character/',
+ is ($fail, eval 'qr/Malformed UTF-8 character/',
"Gave appropriate error for short char: $original");
- for (1..3) {
- skip("Expected failure means remaining tests for"
- . " this aren't relevant", 0);
- }
+ skip("Expected failure means remaining tests for"
+ . " this aren't relevant", 3);
}
}
}
}
}
-ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
-ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
+is(&Devel::PPPort::av_top_index([1,2,3]), 2);
+is(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
=tests plan => 3
&Devel::PPPort::call_newCONSTSUB_1();
-ok(&Devel::PPPort::test_value_1(), 1);
+is(&Devel::PPPort::test_value_1(), 1);
&Devel::PPPort::call_newCONSTSUB_2();
-ok(&Devel::PPPort::test_value_2(), 2);
+is(&Devel::PPPort::test_value_2(), 2);
&Devel::PPPort::call_newCONSTSUB_3();
-ok(&Devel::PPPort::test_value_3(), 3);
+is(&Devel::PPPort::test_value_3(), 3);
=tests plan => 2
-ok(&Devel::PPPort::newRV_inc_REFCNT, 1);
-ok(&Devel::PPPort::newRV_noinc_REFCNT, 1);
+is(&Devel::PPPort::newRV_inc_REFCNT, 1);
+is(&Devel::PPPort::newRV_noinc_REFCNT, 1);
=tests plan => 1
-ok(Devel::PPPort::newSV_type(), 4);
+is(Devel::PPPort::newSV_type(), 4);
my @s = &Devel::PPPort::newSVpvn();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_flags();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_utf8();
ok(@s == 1);
-ok($s[0], "test");
+is($s[0], "test");
if ("$]" >= 5.008001) {
require utf8;
ok(utf8::is_utf8($s[0]));
}
else {
- skip("skip: no is_utf8()", 0);
+ skip("skip: no is_utf8()", 1);
}
for (@pods) {
print "# checking $_\n";
if ($reason) {
- skip("skip: $reason", 0);
+ skip("skip: $reason", 1);
}
else {
pod_file_ok($_);
BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 238) {
- skip("skip: SKIP_SLOW_TESTS", 0);
- }
+ skip("skip: SKIP_SLOW_TESTS", 238);
exit 0;
}
}
ok(&Devel::PPPort::WriteFile("ppport.h"));
# Check GetFileContents()
-ok(-e "ppport.h", 1);
+is(-e "ppport.h", 1);
my $data;
}
close(F);
-ok(Devel::PPPort::GetFileContents("ppport.h"), $data);
-ok(Devel::PPPort::GetFileContents(), $data);
+is(Devel::PPPort::GetFileContents("ppport.h"), $data);
+is(Devel::PPPort::GetFileContents(), $data);
sub comment
{
$err =~ s/^/# *** /mg;
print "# *** ERROR ***\n$err\n";
}
- ok($@, '');
+ is($@, '');
for (keys %{$t->{files}}) {
unlink $_ or die "unlink('$_'): $!\n";
$o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*test\.xs/mi);
ok($o =~ /Analyzing.*test\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
ok($o =~ /Uses Perl_newSViv instead of newSViv/);
$o = ppport(qw(--quiet --nochanges));
my $o = ppport(qw(--copy=a));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
$o = ppport(qw(--copy=b --cplusplus));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*FooBar\.xs/mi);
ok($o =~ /Analyzing.*FooBar\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o !~ /^Looks good/m);
ok($o =~ /^Uses grok_bin/m);
ok($o =~ /^Scanning.*sub.*third\.c/mi);
ok($o =~ /Analyzing.*sub.*third\.c/mi);
ok($o !~ /^Scanning.*foobar/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
---------------------------- First.xs -----------------------------------------
ok($o =~ /^Scanning.*\Q$_\E/mi);
ok($o =~ /Analyzing.*\Q$_\E/i);
}
-ok(matches($o, '^Scanning', 'm'), 6);
+is(matches($o, '^Scanning', 'm'), 6);
-ok(matches($o, '^Writing copy of', 'm'), 5);
+is(matches($o, '^Writing copy of', 'm'), 5);
ok(!-e "mod5.cf");
for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
my $o = ppport(qw(--nochanges));
ok($o !~ /potentially required change/);
-ok(matches($o, '^Looks good', 'm'), 2);
+is(matches($o, '^Looks good', 'm'), 2);
---------------------------- FooBar.xs ----------------------------------------
my $o = ppport(qw(--api-info=INT2PTR));
my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{INT2PTR});
-ok(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
-ok(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
+is(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
+is(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
$o = ppport(qw(--api-info=Zero));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{Zero});
-ok(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
+is(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
$o = ppport(qw(--api-info=/Zero/));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 2, "found 2 keys");
+is(scalar keys %found, 2, "found 2 keys");
ok(exists $found{Zero});
ok(exists $found{ZeroD});
$p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : '';
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{call_pv});
ok(not ref $p{call_pv});
ok(exists $p{grok_bin});
-ok(ref $p{grok_bin}, 'HASH');
-ok(scalar keys %{$p{grok_bin}}, 2);
+is(ref $p{grok_bin}, 'HASH');
+is(scalar keys %{$p{grok_bin}}, 2);
ok($p{grok_bin}{explicit});
ok($p{grok_bin}{depend});
ok(exists $p{gv_stashpvn});
-ok(ref $p{gv_stashpvn}, 'HASH');
-ok(scalar keys %{$p{gv_stashpvn}}, 2);
+is(ref $p{gv_stashpvn}, 'HASH');
+is(scalar keys %{$p{gv_stashpvn}}, 2);
ok($p{gv_stashpvn}{depend});
ok($p{gv_stashpvn}{hint});
ok(exists $p{sv_catpvf_mg});
-ok(ref $p{sv_catpvf_mg}, 'HASH');
-ok(scalar keys %{$p{sv_catpvf_mg}}, 2);
+is(ref $p{sv_catpvf_mg}, 'HASH');
+is(scalar keys %{$p{sv_catpvf_mg}}, 2);
ok($p{sv_catpvf_mg}{explicit});
ok($p{sv_catpvf_mg}{depend});
ok(exists $p{PL_signals});
-ok(ref $p{PL_signals}, 'HASH');
-ok(scalar keys %{$p{PL_signals}}, 1);
+is(ref $p{PL_signals}, 'HASH');
+is(scalar keys %{$p{PL_signals}}, 1);
ok($p{PL_signals}{explicit});
===============================================================================
$p{$name} = $ver;
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{utf8_distance});
-ok($p{utf8_distance}, '5.6.0');
+is($p{utf8_distance}, '5.6.0');
ok(exists $p{save_generic_svref});
-ok($p{save_generic_svref}, '5.005_03');
+is($p{save_generic_svref}, '5.005_03');
===============================================================================
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL));
ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m);
-ok(matches($o, '^\|\s+foo\.o', 'mi'), 1);
-ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
+is(matches($o, '^\|\s+foo\.o', 'mi'), 1);
+is(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.o/mi);
ok($o =~ /^Scanning.*Makefile/mi);
ok($o =~ /Analyzing.*Makefile/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
-ok(matches($o, 'Analyzing', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, 'Analyzing', 'm'), 3);
---------------------------- foo.cpp ------------------------------------------
my @r;
@r = &Devel::PPPort::pv_pretty();
-ok($r[0], $r[1]);
-ok($r[0], "foobarbaz");
-ok($r[2], $r[3]);
-ok($r[2], '<leftpv_p\retty\nright>');
-ok($r[4], $r[5]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
-ok($r[6], $r[7]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+is($r[0], $r[1]);
+is($r[0], "foobarbaz");
+is($r[2], $r[3]);
+is($r[2], '<leftpv_p\retty\nright>');
+is($r[4], $r[5]);
+if(ord("A") == 65) {
+ is($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
+is($r[6], $r[7]);
+if(ord("A") == 65) {
+ is($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
@r = &Devel::PPPort::pv_display();
-ok($r[0], $r[1]);
-ok($r[0], '"foob\0rbaz"\0');
-ok($r[2], $r[3]);
+is($r[0], $r[1]);
+is($r[0], '"foob\0rbaz"\0');
+is($r[2], $r[3]);
ok($r[2] eq '"pv_di"...\0' ||
$r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :(
my $x = 'foo';
-ok(Devel::PPPort::newSVpvs(), "newSVpvs");
-ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
-ok(Devel::PPPort::newSVpvs_share(), 3);
+is(Devel::PPPort::newSVpvs(), "newSVpvs");
+is(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
+is(Devel::PPPort::newSVpvs_share(), 3);
Devel::PPPort::sv_catpvs($x);
-ok($x, "foosv_catpvs");
+is($x, "foosv_catpvs");
Devel::PPPort::sv_setpvs($x);
-ok($x, "sv_setpvs");
+is($x, "sv_setpvs");
my %h = ('hv_fetchs' => 42);
Devel::PPPort::hv_stores(\%h, 4711);
-ok(scalar keys %h, 2);
+is(scalar keys %h, 2);
ok(exists $h{'hv_stores'});
-ok($h{'hv_stores'}, 4711);
-ok(Devel::PPPort::hv_fetchs(\%h), 42);
-ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
+is($h{'hv_stores'}, 4711);
+is(Devel::PPPort::hv_fetchs(\%h), 42);
+is(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
-ok(Devel::PPPort::get_cvs(), 3);
+is(Devel::PPPort::get_cvs(), 3);
=tests plan => 1
-ok(&Devel::PPPort::newSVpvn_share(), 6);
+is(&Devel::PPPort::newSVpvn_share(), 6);
=tests plan => 2
my($l, $s) = Devel::PPPort::my_snprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
=tests plan => 2
my($l, $s) = Devel::PPPort::my_sprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
ok(@e == @r);
for (0 .. $#e) {
- ok($r[$_], $e[$_]);
+ is($r[$_], $e[$_]);
}
$h{foo} = 'foo-';
$h{bar} = '';
-ok(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
-ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
-ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
+is(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
&Devel::PPPort::sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
&Devel::PPPort::sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
+is($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
+is($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
+is($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
=tests plan => 2
-ok(&Devel::PPPort::no_THX_arg("42"), 43);
+is(&Devel::PPPort::no_THX_arg("42"), 43);
eval { &Devel::PPPort::with_THX_arg("yes\n"); };
ok($@ =~ /^yes/);
# skip tests on 5.6.0 and earlier, plus 7.0
if ("$]" <= '5.006' || "$]" == '5.007' ) {
- for (1..93) {
- skip 'skip: broken utf8 support', 0;
- }
+ skip 'skip: broken utf8 support', 93;
exit;
}
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
+is(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
-ok(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
+is(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0xb6));
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0x100));
if ("$]" < '5.006') {
- for (1 ..9) {
- ok(1, 1)
- }
+ skip("Perl version too early", 9);
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
- ok(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
- ok(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
+ is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
+ is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
+ is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
if (ord("A") != 65) {
- ok(1, 1)
+ skip("Test not valid on EBCDIC", 1)
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
+ is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
}
}
if ("$]" < '5.008') {
- for (1 ..3) {
- ok(1, 1)
- }
+ skip("Perl version too early", 3);
}
else {
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
}
my $ret = &Devel::PPPort::utf8_to_uvchr("A");
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr("\0");
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
if (ord("A") != 65) { # tests not valid for EBCDIC
- for (1 .. (2 + 4 + (7 * 5))) {
- ok(1, 1);
- }
+ skip("Perl version too early", 1 .. (2 + 4 + (7 * 5)));
}
else {
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
- ok($ret->[0], 0x100);
- ok($ret->[1], 2);
+ is($ret->[0], 0x100);
+ is($ret->[1], 2);
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_; };
{
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0);
- ok($ret->[1], -1);
+ is($ret->[0], 0);
+ is($ret->[1], -1);
BEGIN { 'warnings'->unimport() if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0xFFFD);
- ok($ret->[1], 1);
+ is($ret->[0], 0xFFFD);
+ is($ret->[1], 1);
}
my @buf_tests = (
use vars '%Config';
if ($Config{ccflags} =~ /-DDEBUGGING/) {
shift @buf_tests;
- for (1..5) {
- ok(1, 1);
- }
+ skip("Test not valid on DEBUGGING builds", 5);
}
my $test;
undef @warnings;
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0, "returned value $display; warnings enabled");
- ok($ret->[1], -1, "returned length $display; warnings enabled");
+ is($ret->[0], 0, "returned value $display; warnings enabled");
+ is($ret->[1], -1, "returned length $display; warnings enabled");
my $all_warnings = join "; ", @warnings;
my $contains = grep { $_ =~ $warning } $all_warnings;
- ok($contains, 1, $display
+ is($contains, 1, $display
. "; Got: '$all_warnings', which should contain '$warning'");
undef @warnings;
BEGIN { 'warnings'->unimport('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
- ok($ret->[1], $test->{'no_warnings_returned_length'},
+ is($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
+ is($ret->[1], $test->{'no_warnings_returned_length'},
"returned length $display; warnings disabled");
}
}
if ("$]" ge '5.008') {
BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } }
- ok(Devel::PPPort::sv_len_utf8("aščť"), 4);
- ok(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
my $str = "áíé";
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
tie my $scalar, 'TieScalarCounter', "é";
- ok(tied($scalar)->{fetch}, 0);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 2);
- ok(tied($scalar)->{fetch}, 1);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 3);
- ok(tied($scalar)->{fetch}, 2);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
+ is(tied($scalar)->{fetch}, 0);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 2);
+ is(tied($scalar)->{fetch}, 1);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 3);
+ is(tied($scalar)->{fetch}, 2);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
} else {
- for (1..23) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 23;
}
package TieScalarCounter;
BEGIN { require warnings if "$]" > '5.006' }
-ok(&Devel::PPPort::sv_setuv(42), 42);
-ok(&Devel::PPPort::newSVuv(123), 123);
-ok(&Devel::PPPort::sv_2uv("4711"), 4711);
-ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
-ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
-ok(&Devel::PPPort::XSRETURN_UV(), 42);
-ok(&Devel::PPPort::PUSHu(), 42);
-ok(&Devel::PPPort::XPUSHu(), 43);
-ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
+is(&Devel::PPPort::sv_setuv(42), 42);
+is(&Devel::PPPort::newSVuv(123), 123);
+is(&Devel::PPPort::sv_2uv("4711"), 4711);
+is(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx(1735928559), 1735928559);
+is(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
+is(&Devel::PPPort::XSRETURN_UV(), 42);
+is(&Devel::PPPort::PUSHu(), 42);
+is(&Devel::PPPort::XPUSHu(), 43);
+is(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
ok(!defined(&Devel::PPPort::PL_sv_undef()));
ok(&Devel::PPPort::PL_sv_yes());
ok(!&Devel::PPPort::PL_sv_no());
-ok(&Devel::PPPort::PL_na("abcd"), 4);
-ok(&Devel::PPPort::PL_Sv(), "mhx");
+is(&Devel::PPPort::PL_na("abcd"), 4);
+is(&Devel::PPPort::PL_Sv(), "mhx");
ok(defined &Devel::PPPort::PL_tokenbuf());
ok("$]" >= 5.009005 || &Devel::PPPort::PL_parser());
ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
ok(defined &Devel::PPPort::PL_hints());
-ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
+is(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
for (&Devel::PPPort::other_variables()) {
ok($_ != 0);
else {
ok(@w == 0);
}
- ok($fail, 0);
+ is($fail, 0);
}
ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));
eval { &Devel::PPPort::no_dummy_parser_vars(0) };
if ("$]" < 5.009005) {
- ok($@, '');
+ is($@, '');
}
else {
if ($@) {
$warning = '';
Devel::PPPort::ckWARN();
-ok($warning, '');
+is($warning, '');
$^W = 1;
G_NOARGS # T
gp_free # T
gp_ref # T
+G_RETHROW # T
grok_bin # T
grok_hex # T
grok_number # T
SvEND # T
sv_eq # T
SVf # T
+SVfARG # T
sv_free # T
SVf_UTF8 # T
SvGETMAGIC # T
isUPPER_utf8_safe # U
isUPPER_uvchr # U
is_utf8_char # U
-is_utf8_mark # U
isWORDCHAR_LC_utf8_safe # U
isWORDCHAR_utf8_safe # U
isWORDCHAR_uvchr # U
av_arylen_p # U
ckwarn # U
ckwarn_d # U
-csighandler # E (Perl_csighandler)
dMULTICALL # E
doref # U
gv_const_sv # U
5.031007
-dMY_CXT_SV # E
-my_lstat # U (Perl_my_lstat)
-my_stat # U (Perl_my_stat)
-pack_cat # U (Perl_pack_cat)
-pad_compname_type # U (Perl_pad_compname_type)
+csighandler # E (Perl_csighandler)
+csighandler1 # U
+csighandler3 # E
+perly_sighandler # E
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
+is(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort');
ok(!defined Devel::PPPort::HvNAME_get({}));
-ok(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
-ok(Devel::PPPort::HvNAMELEN_get({}), 0);
+is(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort'));
+is(Devel::PPPort::HvNAMELEN_get({}), 0);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my $mhx = "mhx";
-ok(&Devel::PPPort::SvPVbyte($mhx), 3);
+is(&Devel::PPPort::SvPVbyte($mhx), 3);
my $i = 42;
-ok(&Devel::PPPort::SvPV_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
-
-ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
-ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
-
-$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
-$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
+is(&Devel::PPPort::SvPV_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_const($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++);
+is(&Devel::PPPort::SvPV_force($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_force_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++);
+
+is(&Devel::PPPort::SvPV_nolen_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++);
+is(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_flags_mutable($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2);
+
+$mhx = 42; is(&Devel::PPPort::SvPV_nolen_const($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const($mhx), 2);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0);
+$mhx = 42; is(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0);
my $str = "";
&Devel::PPPort::SvPV_force($str);
my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80);
-ok($str, "x"x80);
-ok($s2, "x"x80);
+is($str, "x"x80);
+is($s2, "x"x80);
ok($before < 81);
-ok($after, 81);
+is($after, 81);
$str = "x"x400;
&Devel::PPPort::SvPV_force($str);
($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40);
-ok($str, "x"x40);
-ok($s2, "x"x40);
+is($str, "x"x40);
+is($s2, "x"x40);
ok($before > 41);
-ok($after, 41);
+is($after, 41);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
my $foo = 5;
-ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
-ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
-ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
+is(&Devel::PPPort::TestSvUV_set($foo, 12345), 42);
+is(&Devel::PPPort::TestSvPVX_const("mhx"), 43);
+is(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44);
my $bar = [];
bless $bar, 'foo';
-ok($bar->x(), 'foobar');
+is($bar->x(), 'foobar');
Devel::PPPort::TestSvSTASH_set($bar, 'bar');
-ok($bar->x(), 'hacker');
+is($bar->x(), 'hacker');
if ( "$]" < '5.007003' ) {
- for (1..10) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 10;
} else {
ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL());
tie my $scalar, 'TieScalarCounter', 'string';
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $copy = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 0;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 0;
+ is tied($scalar)->{store}, 0;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $copy2 = Devel::PPPort::newSVsv_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok $copy2, 'string';
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is $copy2, 'string';
}
package TieScalarCounter;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-sub eq_array
-{
- my($a, $b) = @_;
- join(':', @$a) eq join(':', @$b);
-}
-
sub f
{
shift;
ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected));
};
-ok(&Devel::PPPort::eval_pv('f()', 0), 'y');
-ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
+is(&Devel::PPPort::eval_pv('f()', 0), 'y');
+is(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y');
-ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
+is(!defined $::{'less::'}, 1, "Hadn't loaded less yet");
Devel::PPPort::load_module(0, "less", undef);
-ok(defined $::{'less::'}, 1, "Have now loaded less");
+is(defined $::{'less::'}, 1, "Have now loaded less");
ok(eval { Devel::PPPort::eval_pv('die', 0); 1 });
ok(!eval { Devel::PPPort::eval_pv('die', 1); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_pv('die $hashref', 1); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_pv('die $false', 1); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
ok(eval { Devel::PPPort::eval_sv('die', 0); 1 });
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
my $hashref = { key => 'value' };
- ok(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
- ok(ref($@), 'HASH', 'check $@ is hashref') and
- ok($@->{key}, 'value', 'check $@ hashref has correct value');
+ is(eval { Devel::PPPort::eval_sv('die $hashref', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check plain hashref is rethrown');
+ is(ref($@), 'HASH', 'check $@ is hashref') and
+ is($@->{key}, 'value', 'check $@ hashref has correct value');
my $false = False->new;
ok(!$false);
- ok(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
- ok(ref($@), 'False', 'check that $@ contains False object');
- ok("$@", "$false", 'check we got the expected object');
+ is(eval { Devel::PPPort::eval_sv('die $false', &Devel::PPPort::G_RETHROW); 1 }, undef, 'check false objects are rethrown');
+ is(ref($@), 'False', 'check that $@ contains False object');
+ is("$@", "$false", 'check we got the expected object');
} else {
- for (1..7) {
- skip 'skip: no support for references in $@', 0;
- }
+ skip 'skip: no support for references in $@', 7;
}
{
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
- if (28) {
+ if (8) {
load();
- plan(tests => 28);
+ plan(tests => 8);
}
}
$package = &Devel::PPPort::CopSTASHPV();
}
print "# $package\n";
-ok($package, "MyPackage");
+is($package, "MyPackage");
my $file = &Devel::PPPort::CopFILE();
print "# $file\n";
BEGIN {
if ("$]" < 5.006000) {
- # Skip
- for (1..28) {
- ok(1, 1);
- }
+ skip("Perl version too early", 8);
exit;
}
}
) {
my ($sub, $arg, @want) = @$_;
my @got = $sub->($arg);
- ok(@got, @want);
- for (0..$#want) {
- ok($got[$_], $want[$_]);
- }
+ ok(eq_array(\@got, \@want));
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(0) };
-ok($@, '');
+is($@, '');
ok(defined $rv);
-ok($rv, 42);
-ok($Devel::PPPort::exception_caught, 0);
+is($rv, 42);
+is($Devel::PPPort::exception_caught, 0);
$Devel::PPPort::exception_caught = undef;
$rv = eval { &Devel::PPPort::exception(1) };
-ok($@, "boo\n");
+is($@, "boo\n");
ok(not defined $rv);
-ok($Devel::PPPort::exception_caught, 1);
+is($Devel::PPPort::exception_caught, 1);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
use Config;
if ("$]" < '5.004') {
- for (1..5) {
- skip 'skip: No newSVpvf support', 0;
- }
+ skip 'skip: No newSVpvf support', 5;
exit;
}
eval { Devel::PPPort::croak_NVgf($num) };
ok($@ =~ /^1.1234567890/);
-ok(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
-ok(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
+is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX');
+is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX');
my $ivsize = $Config::Config{ivsize};
my $ivmax = ($ivsize == 4) ? '2147483647' : ($ivsize == 8) ? '9223372036854775807' : 0;
my $uvmax = ($ivsize == 4) ? '4294967295' : ($ivsize == 8) ? '18446744073709551615' : 0;
if ($ivmax == 0) {
- for (1..2) {
- skip 'skip: unknown ivsize', 0;
- }
+ skip 'skip: unknown ivsize', 2;
} else {
- ok(Devel::PPPort::sprintf_ivmax(), $ivmax);
- ok(Devel::PPPort::sprintf_uvmax(), $uvmax);
+ is(Devel::PPPort::sprintf_ivmax(), $ivmax);
+ is(Devel::PPPort::sprintf_uvmax(), $uvmax);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::grok_number("42"), 42);
+is(&Devel::PPPort::grok_number("42"), 42);
ok(!defined(&Devel::PPPort::grok_number("A")));
-ok(&Devel::PPPort::grok_bin("10000001"), 129);
-ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::grok_oct("377"), 255);
+is(&Devel::PPPort::grok_bin("10000001"), 129);
+is(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::grok_oct("377"), 255);
-ok(&Devel::PPPort::Perl_grok_number("42"), 42);
+is(&Devel::PPPort::Perl_grok_number("42"), 42);
ok(!defined(&Devel::PPPort::Perl_grok_number("A")));
-ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
-ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
-ok(&Devel::PPPort::Perl_grok_oct("377"), 255);
+is(&Devel::PPPort::Perl_grok_bin("10000001"), 129);
+is(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef);
+is(&Devel::PPPort::Perl_grok_oct("377"), 255);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::GvSVn(), 1);
+is(Devel::PPPort::GvSVn(), 1);
-ok(Devel::PPPort::isGV_with_GP(), 2);
+is(Devel::PPPort::isGV_with_GP(), 2);
-ok(Devel::PPPort::get_cvn_flags(), 3);
+is(Devel::PPPort::get_cvn_flags(), 3);
-ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
+is(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check");
ok($::{sanity_check});
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
+is(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mPUSHu()), "1:2:3");
-ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
-ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
-ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
-ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
-ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
+is(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42");
+is(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three");
+is(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125");
+is(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3");
+is(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3");
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
# Find proper magic
ok(my $obj1 = Devel::PPPort->new_with_mg());
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Find with no magic
my $obj = bless {}, 'Fake::Class';
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Find with other magic (not the magic we are looking for)
ok($obj = Devel::PPPort->new_with_other_mg());
-ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle.");
# Okay, attempt to remove magic that isn't there
Devel::PPPort::remove_other_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), 'hello');
+is(Devel::PPPort::as_string($obj1), 'hello');
# Remove magic that IS there
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
# Removing when no magic present
Devel::PPPort::remove_null_magic($obj1);
-ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
+is(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle.");
use Tie::Hash;
my %h;
$h{bar} = '';
&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar');
-ok($h{foo}, 'foobar');
+is($h{foo}, 'foobar');
&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz');
-ok($h{bar}, 'baz');
+is($h{bar}, 'baz');
&Devel::PPPort::sv_catsv_mg($h{foo}, '42');
-ok($h{foo}, 'foobar42');
+is($h{foo}, 'foobar42');
&Devel::PPPort::sv_setiv_mg($h{bar}, 42);
-ok($h{bar}, 42);
+is($h{bar}, 42);
&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159);
ok(abs($h{PI} - 3.14159) < 0.01);
&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx');
-ok($h{mhx}, 'mhx');
+is($h{mhx}, 'mhx');
&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus');
-ok($h{mhx}, 'Marcus');
+is($h{mhx}, 'Marcus');
&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV');
-ok($h{sv}, 'SV');
+is($h{sv}, 'SV');
&Devel::PPPort::sv_setuv_mg($h{sv}, 4711);
-ok($h{sv}, 4711);
+is($h{sv}, 4711);
&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl');
-ok($h{sv}, 'Perl');
+is($h{sv}, 'Perl');
# v1 is treated as a bareword in older perls...
my $ver = do { local $SIG{'__WARN__'} = sub {}; eval qq[v1.2.0] };
ok($foo eq 'bar');
if ( "$]" < '5.007003' ) {
- for (1..22) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 22;
} else {
tie my $scalar, 'TieScalarCounter', 10;
my $fetch = $scalar;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvIV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvUV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvNV_nomg($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvIV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvUV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvNV_nomg($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($scalar), 10;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
ok Devel::PPPort::magic_SvTRUE_nomg($scalar);
- ok tied($scalar)->{fetch}, 1;
- ok tied($scalar)->{store}, 0;
+ is tied($scalar)->{fetch}, 1;
+ is tied($scalar)->{store}, 0;
my $object = OverloadedObject->new('string', 5.5, 0);
- ok Devel::PPPort::magic_SvIV_nomg($object), 5;
- ok Devel::PPPort::magic_SvUV_nomg($object), 5;
- ok Devel::PPPort::magic_SvNV_nomg($object), 5.5;
- ok Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
+ is Devel::PPPort::magic_SvIV_nomg($object), 5;
+ is Devel::PPPort::magic_SvUV_nomg($object), 5;
+ is Devel::PPPort::magic_SvNV_nomg($object), 5.5;
+ is Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string';
ok !Devel::PPPort::magic_SvTRUE_nomg($object);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::checkmem(), 6);
+is(Devel::PPPort::checkmem(), 6);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1\n") };
-ok $@, "\xE1\n";
-ok $die, "\xE1\n";
+is $@, "\xE1\n";
+is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(10) };
-ok $@ =~ /^10 at $0 line /;
-ok $die =~ /^10 at $0 line /;
+ok $@ =~ /^10 at \Q$0\E line /;
+ok $die =~ /^10 at \Q$0\E line /;
undef $die;
$@ = 'should not be visible (1)';
$@ = 'should not be visible (2)';
Devel::PPPort::croak_sv('');
};
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv($@)
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv($@)
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
$@ = 'should not be visible';
$@ = 'this must be visible';
Devel::PPPort::croak_sv_errsv()
};
-ok $@ =~ /^this must be visible at $0 line /;
-ok $die =~ /^this must be visible at $0 line /;
+ok $@ =~ /^this must be visible at \Q$0\E line /;
+ok $die =~ /^this must be visible at \Q$0\E line /;
undef $die;
$@ = 'should not be visible';
$@ = "this must be visible\n";
Devel::PPPort::croak_sv_errsv()
};
-ok $@, "this must be visible\n";
-ok $die, "this must be visible\n";
+is $@, "this must be visible\n";
+is $die, "this must be visible\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv_with_counter("message\n") };
-ok $@, "message\n";
-ok Devel::PPPort::get_counter(), 1;
+is $@, "message\n";
+is Devel::PPPort::get_counter(), 1;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv('') };
-ok $@ =~ /^ at $0 line /;
-ok $die =~ /^ at $0 line /;
+ok $@ =~ /^ at \Q$0\E line /;
+ok $die =~ /^ at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xE1") };
-ok $@ =~ /^\xE1 at $0 line /;
-ok $die =~ /^\xE1 at $0 line /;
+ok $@ =~ /^\xE1 at \Q$0\E line /;
+ok $die =~ /^\xE1 at \Q$0\E line /;
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
-ok $@ =~ /^\xC3\xA1 at $0 line /;
-ok $die =~ /^\xC3\xA1 at $0 line /;
+ok $@ =~ /^\xC3\xA1 at \Q$0\E line /;
+ok $die =~ /^\xC3\xA1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1\n");
-ok $warn, "\xE1\n";
+is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(10);
-ok $warn =~ /^10 at $0 line /;
+ok $warn =~ /^10 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv('');
-ok $warn =~ /^ at $0 line /;
+ok $warn =~ /^ at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xE1");
-ok $warn =~ /^\xE1 at $0 line /;
+ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
-ok $warn =~ /^\xC3\xA1 at $0 line /;
+ok $warn =~ /^\xC3\xA1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
+is Devel::PPPort::mess_sv("\xE1\n", 0), "\xE1\n";
+is Devel::PPPort::mess_sv(do {my $tmp = "\xE1\n"}, 1), "\xE1\n";
-ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at $0 line /;
+ok Devel::PPPort::mess_sv(10, 0) =~ /^10 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = 10}, 1) =~ /^10 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv('', 0) =~ /^ at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at $0 line /;
+ok Devel::PPPort::mess_sv('', 0) =~ /^ at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = ''}, 1) =~ /^ at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xE1", 0) =~ /^\xE1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xE1"}, 1) =~ /^\xE1 at \Q$0\E line /;
-ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at $0 line /;
-ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at $0 line /;
+ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ /^\xC3\xA1 at \Q$0\E line /;
+ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ /^\xC3\xA1 at \Q$0\E line /;
if ("$]" >= '5.006') {
BEGIN { if ("$]" >= '5.006' && "$]" < '5.008') { require utf8; utf8->import(); } }
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}\n") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@, "\x{100}\n";
+ is $@, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die, "\x{100}\n";
+ is $die, "\x{100}\n";
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
undef $die;
ok !defined eval { Devel::PPPort::croak_sv("\x{100}") };
if ("$]" < '5.007001' || "$]" > '5.007003') {
- ok $@ =~ /^\x{100} at $0 line /;
+ ok $@ =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
- ok $die =~ /^\x{100} at $0 line /;
+ ok $die =~ /^\x{100} at \Q$0\E line /;
} else {
- skip 'skip: broken utf8 support in die hook', 0;
+ skip 'skip: broken utf8 support in die hook', 1;
}
if ("$]" < '5.007001' || "$]" > '5.008') {
undef $warn;
Devel::PPPort::warn_sv("\x{100}\n");
- ok $warn, "\x{100}\n";
+ is $warn, "\x{100}\n";
undef $warn;
Devel::PPPort::warn_sv("\x{100}");
- ok (my $tmp = $warn) =~ /^\x{100} at $0 line /;
+ ok (my $tmp = $warn) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..2) {
- skip 'skip: broken utf8 support in warn hook', 0;
- }
+ skip 'skip: broken utf8 support in warn hook', 2;
}
- ok Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
+ is Devel::PPPort::mess_sv("\x{100}\n", 0), "\x{100}\n";
+ is Devel::PPPort::mess_sv(do {my $tmp = "\x{100}\n"}, 1), "\x{100}\n";
- ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at $0 line /;
- ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at $0 line /;
+ ok Devel::PPPort::mess_sv("\x{100}", 0) =~ /^\x{100} at \Q$0\E line /;
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\x{100}"}, 1) =~ /^\x{100} at \Q$0\E line /;
} else {
- for (1..12) {
- skip 'skip: no utf8 support', 0;
- }
+ skip 'skip: no utf8 support', 12;
}
if (ord('A') != 65) {
- for (1..24) {
- skip 'skip: no ASCII support', 0;
- }
+ skip 'skip: no ASCII support', 24;
} elsif ( "$]" >= '5.008'
&& "$]" != '5.013000' # Broken in these ranges
&& ! ("$]" >= '5.011005' && "$]" <= '5.012000'))
{
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}\n"') };
- ok $@, "\xE1\n";
- ok $die, "\xE1\n";
+ is $@, "\xE1\n";
+ is $die, "\xE1\n";
undef $die;
ok !defined eval { Devel::PPPort::croak_sv(eval '"\N{U+E1}"') };
- ok $@ =~ /^\xE1 at $0 line /;
- ok $die =~ /^\xE1 at $0 line /;
+ ok $@ =~ /^\xE1 at \Q$0\E line /;
+ ok $die =~ /^\xE1 at \Q$0\E line /;
{
undef $die;
my $expect = eval '"\N{U+C3}\N{U+A1}\n"';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1\n") };
- ok $@, $expect;
- ok $die, $expect;
+ is $@, $expect;
+ is $die, $expect;
}
{
undef $die;
- my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ my $expect = eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
ok !defined eval { Devel::PPPort::croak_sv("\xC3\xA1") };
ok $@ =~ $expect;
ok $die =~ $expect;
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}\n"');
- ok $warn, "\xE1\n";
+ is $warn, "\xE1\n";
undef $warn;
Devel::PPPort::warn_sv(eval '"\N{U+E1}"');
- ok $warn =~ /^\xE1 at $0 line /;
+ ok $warn =~ /^\xE1 at \Q$0\E line /;
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1\n");
- ok $warn, eval '"\N{U+C3}\N{U+A1}\n"';
+ is $warn, eval '"\N{U+C3}\N{U+A1}\n"';
undef $warn;
Devel::PPPort::warn_sv("\xC3\xA1");
- ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok $warn =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
if ("$]" < '5.004') {
- for (1..8) {
- skip 'skip: no support for mess_sv', 0;
- }
+ skip 'skip: no support for mess_sv', 8;
}
else {
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(eval('"\N{U+E1}\n"'), 0), eval '"\N{U+E1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}\n"'}, 1), eval '"\N{U+E1}\n"';
- ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at $0 line /';
+ ok Devel::PPPort::mess_sv(eval('"\N{U+E1}"'), 0) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = eval '"\N{U+E1}"'}, 1) =~ eval 'qr/^\N{U+E1} at \Q$0\E line /';
- ok Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv("\xC3\xA1\n", 0), eval '"\N{U+C3}\N{U+A1}\n"';
+ is Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1\n"}, 1), eval '"\N{U+C3}\N{U+A1}\n"';
- ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
- ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at $0 line /';
+ ok Devel::PPPort::mess_sv("\xC3\xA1", 0) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
+ ok Devel::PPPort::mess_sv(do {my $tmp = "\xC3\xA1"}, 1) =~ eval 'qr/^\N{U+C3}\N{U+A1} at \Q$0\E line /';
}
} else {
- for (1..24) {
- skip 'skip: no support for \N{U+..} syntax', 0;
- }
+ skip 'skip: no support for \N{U+..} syntax', 24;
}
if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) {
ok $@ == $obj;
ok $die == $obj;
} else {
- for (1..12) {
- skip 'skip: no support for exceptions', 0;
- }
+ skip 'skip: no support for exceptions', 12;
}
ok !defined eval { Devel::PPPort::croak_no_modify() };
-ok $@ =~ /^Modification of a read-only value attempted at $0 line /;
+ok $@ =~ /^Modification of a read-only value attempted at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_memory_wrap() };
-ok $@ =~ /^panic: memory wrap at $0 line /;
+ok $@ =~ /^panic: memory wrap at \Q$0\E line /;
ok !defined eval { Devel::PPPort::croak_xs_usage("params") };
-ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at $0 line /;
+ok $@ =~ /^Usage: Devel::PPPort::croak_xs_usage\(params\) at \Q$0\E line /;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
ok(!&Devel::PPPort::boolSV(0));
$_ = "Fred";
-ok(&Devel::PPPort::DEFSV(), "Fred");
-ok(&Devel::PPPort::UNDERBAR(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::UNDERBAR(), "Fred");
if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) {
eval q{
no warnings "deprecated";
no if $^V > v5.17.9, warnings => "experimental::lexical_topic";
my $_ = "Tony";
- ok(&Devel::PPPort::DEFSV(), "Fred");
- ok(&Devel::PPPort::UNDERBAR(), "Tony");
+ is(&Devel::PPPort::DEFSV(), "Fred");
+ is(&Devel::PPPort::UNDERBAR(), "Tony");
};
}
else {
my @r = &Devel::PPPort::DEFSV_modify();
ok(@r == 3);
-ok($r[0], 'Fred');
-ok($r[1], 'DEFSV');
-ok($r[2], 'Fred');
+is($r[0], 'Fred');
+is($r[1], 'DEFSV');
+is($r[2], 'Fred');
-ok(&Devel::PPPort::DEFSV(), "Fred");
+is(&Devel::PPPort::DEFSV(), "Fred");
eval { 1 };
ok(!&Devel::PPPort::ERRSV());
ok(!&Devel::PPPort::get_cv('not_my_cv', 0));
ok(&Devel::PPPort::get_cv('not_my_cv', 1));
-ok(Devel::PPPort::dXSTARG(42), 43);
-ok(Devel::PPPort::dAXMARK(4711), 4710);
+is(Devel::PPPort::dXSTARG(42), 43);
+is(Devel::PPPort::dAXMARK(4711), 4710);
-ok(Devel::PPPort::prepush(), 42);
+is(Devel::PPPort::prepush(), 42);
-ok(join(':', Devel::PPPort::xsreturn(0)), 'test1');
-ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
+is(join(':', Devel::PPPort::xsreturn(0)), 'test1');
+is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2');
-ok(Devel::PPPort::PERL_ABS(42), 42);
-ok(Devel::PPPort::PERL_ABS(-13), 13);
+is(Devel::PPPort::PERL_ABS(42), 42);
+is(Devel::PPPort::PERL_ABS(-13), 13);
-ok(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
-ok(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
+is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42');
+is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc');
-ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
+is(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo");
-ok(&Devel::PPPort::ptrtests(), 63);
+is(&Devel::PPPort::ptrtests(), 63);
-ok(&Devel::PPPort::OpSIBLING_tests(), 0);
+is(&Devel::PPPort::OpSIBLING_tests(), 0);
if (ivers($]) >= ivers(5.9)) {
eval q{
- ok(&Devel::PPPort::check_HeUTF8("hello"), "norm");
- ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
+ is(&Devel::PPPort::check_HeUTF8("hello"), "norm");
+ is(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8");
};
} else {
- ok(1, 1);
- ok(1, 1);
+ skip("Too early perl version", 2);
}
@r = &Devel::PPPort::check_c_array();
-ok($r[0], 4);
-ok($r[1], "13");
+is($r[0], 4);
+is($r[1], "13");
ok(!Devel::PPPort::SvRXOK(""));
ok(!Devel::PPPort::SvRXOK(bless [], "Regexp"));
if (ivers($]) < ivers(5.5)) {
- skip 'no qr// objects in this perl', 0;
- skip 'no qr// objects in this perl', 0;
+ skip 'no qr// objects in this perl', 2;
} else {
my $qr = eval 'qr/./';
ok(Devel::PPPort::SvRXOK($qr));
? 0 # Fail on non-ASCII unless unicode
: ($types{"$native:$class"} || 0);
if (ivers($]) < ivers(5.6) && $suffix eq '_uvchr') {
- skip("No UTF-8 on this perl", 0);
+ skip("No UTF-8 on this perl", 1);
next;
}
my $eval_string = "Devel::PPPort::is${class}$suffix($hex)";
my $is = eval $eval_string || 0;
die "eval 'For $i: $eval_string' gave $@" if $@;
- ok($is, $should_be, "'$eval_string'");
+ is($is, $should_be, "'$eval_string'");
}
}
my $utf8;
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
else {
$utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i);
my $should_be = $types{"$native:$class"} || 0;
+ local $SIG{__WARN__} = sub {};
my $eval_string = "$fcn(\"$utf8\", 0)";
my $is = eval $eval_string || 0;
die "eval 'For $i, $eval_string' gave $@" if $@;
- ok($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string));
}
# And for the high code points, test that a too short malformation (the
# -1) causes it to fail
if ($i > 255) {
if ($skip) {
- skip $skip, 0;
+ skip $skip, 1;
}
elsif (ivers($]) >= ivers(5.25.9)) {
- skip("Prints an annoying error message that khw doesn't know how to easily suppress", 0);
+ skip("Prints an annoying error message that khw doesn't know how to easily suppress", 1);
}
else {
my $eval_string = "$fcn(\"$utf8\", -1)";
my $is = eval "no warnings; $eval_string" || 0;
die "eval '$eval_string' gave $@" if $@;
- ok($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
+ is($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string));
}
}
}
$skip = "Can't do uvchr on a multi-char string";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
if ($is_cp) {
my $ret = eval "Devel::PPPort::$fcn($original)";
my $fail = $@; # Have to save $@, as it gets destroyed
- ok ($fail, "", "$fcn($original) didn't fail");
+ is ($fail, "", "$fcn($original) didn't fail");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
$skip = "Don't try to test shortened single bytes";
}
if ($skip) {
- for (1..4) {
- skip $skip, 0;
- }
+ skip $skip, 4;
}
else {
my $fcn = "to${name}_utf8_safe";
my $ret = eval "no warnings; $eval_string" || 0;
my $fail = $@; # Have to save $@, as it gets destroyed
if ($truncate == 0) {
- ok ($fail, "", "Didn't fail on full length input");
+ is ($fail, "", "Didn't fail on full length input");
my $first = (ivers($]) != ivers(5.6))
? substr($utf8_changed, 0, 1)
: $utf8_changed, 0, 1;
- ok($ret->[0], ord $first,
+ is($ret->[0], ord $first,
"ord of $fcn($original) is $changed");
- ok($ret->[1], $utf8_changed,
+ is($ret->[1], $utf8_changed,
"UTF-8 of of $fcn($original) is correct");
- ok($ret->[2], $should_be_bytes,
+ is($ret->[2], $should_be_bytes,
"Length of $fcn($original) is $should_be_bytes");
}
else {
- ok ($fail, eval 'qr/Malformed UTF-8 character/',
+ is ($fail, eval 'qr/Malformed UTF-8 character/',
"Gave appropriate error for short char: $original");
- for (1..3) {
- skip("Expected failure means remaining tests for"
- . " this aren't relevant", 0);
- }
+ skip("Expected failure means remaining tests for"
+ . " this aren't relevant", 3);
}
}
}
}
}
-ok(&Devel::PPPort::av_top_index([1,2,3]), 2);
-ok(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
+is(&Devel::PPPort::av_top_index([1,2,3]), 2);
+is(&Devel::PPPort::av_tindex([1,2,3,4]), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
&Devel::PPPort::call_newCONSTSUB_1();
-ok(&Devel::PPPort::test_value_1(), 1);
+is(&Devel::PPPort::test_value_1(), 1);
&Devel::PPPort::call_newCONSTSUB_2();
-ok(&Devel::PPPort::test_value_2(), 2);
+is(&Devel::PPPort::test_value_2(), 2);
&Devel::PPPort::call_newCONSTSUB_3();
-ok(&Devel::PPPort::test_value_3(), 3);
+is(&Devel::PPPort::test_value_3(), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::newRV_inc_REFCNT, 1);
-ok(&Devel::PPPort::newRV_noinc_REFCNT, 1);
+is(&Devel::PPPort::newRV_inc_REFCNT, 1);
+is(&Devel::PPPort::newRV_noinc_REFCNT, 1);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(Devel::PPPort::newSV_type(), 4);
+is(Devel::PPPort::newSV_type(), 4);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my @s = &Devel::PPPort::newSVpvn();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_flags();
ok(@s == 5);
-ok($s[0], "test");
-ok($s[1], "te");
-ok($s[2], "");
+is($s[0], "test");
+is($s[1], "te");
+is($s[2], "");
ok(!defined($s[3]));
ok(!defined($s[4]));
@s = &Devel::PPPort::newSVpvn_utf8();
ok(@s == 1);
-ok($s[0], "test");
+is($s[0], "test");
if ("$]" >= 5.008001) {
require utf8;
ok(utf8::is_utf8($s[0]));
}
else {
- skip("skip: no is_utf8()", 0);
+ skip("skip: no is_utf8()", 1);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
for (@pods) {
print "# checking $_\n";
if ($reason) {
- skip("skip: $reason", 0);
+ skip("skip: $reason", 1);
}
else {
pod_file_ok($_);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
BEGIN {
if ($ENV{'SKIP_SLOW_TESTS'}) {
- for (1 .. 238) {
- skip("skip: SKIP_SLOW_TESTS", 0);
- }
+ skip("skip: SKIP_SLOW_TESTS", 238);
exit 0;
}
}
ok(&Devel::PPPort::WriteFile("ppport.h"));
# Check GetFileContents()
-ok(-e "ppport.h", 1);
+is(-e "ppport.h", 1);
my $data;
}
close(F);
-ok(Devel::PPPort::GetFileContents("ppport.h"), $data);
-ok(Devel::PPPort::GetFileContents(), $data);
+is(Devel::PPPort::GetFileContents("ppport.h"), $data);
+is(Devel::PPPort::GetFileContents(), $data);
sub comment
{
$err =~ s/^/# *** /mg;
print "# *** ERROR ***\n$err\n";
}
- ok($@, '');
+ is($@, '');
for (keys %{$t->{files}}) {
unlink $_ or die "unlink('$_'): $!\n";
$o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*test\.xs/mi);
ok($o =~ /Analyzing.*test\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
ok($o =~ /Uses Perl_newSViv instead of newSViv/);
$o = ppport(qw(--quiet --nochanges));
my $o = ppport(qw(--copy=a));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
$o = ppport(qw(--copy=b --cplusplus));
ok($o =~ /^Scanning.*MyExt\.xs/mi);
ok($o =~ /Analyzing.*MyExt\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o =~ /^Needs to include.*ppport\.h/m);
ok($o !~ /^Uses grok_bin/m);
ok($o !~ /^Uses newSVpv/m);
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*FooBar\.xs/mi);
ok($o =~ /Analyzing.*FooBar\.xs/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
ok($o !~ /^Looks good/m);
ok($o =~ /^Uses grok_bin/m);
ok($o =~ /^Scanning.*sub.*third\.c/mi);
ok($o =~ /Analyzing.*sub.*third\.c/mi);
ok($o !~ /^Scanning.*foobar/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
---------------------------- First.xs -----------------------------------------
ok($o =~ /^Scanning.*\Q$_\E/mi);
ok($o =~ /Analyzing.*\Q$_\E/i);
}
-ok(matches($o, '^Scanning', 'm'), 6);
+is(matches($o, '^Scanning', 'm'), 6);
-ok(matches($o, '^Writing copy of', 'm'), 5);
+is(matches($o, '^Writing copy of', 'm'), 5);
ok(!-e "mod5.cf");
for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) {
my $o = ppport(qw(--nochanges));
ok($o !~ /potentially required change/);
-ok(matches($o, '^Looks good', 'm'), 2);
+is(matches($o, '^Looks good', 'm'), 2);
---------------------------- FooBar.xs ----------------------------------------
my $o = ppport(qw(--api-info=INT2PTR));
my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{INT2PTR});
-ok(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
-ok(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
+is(matches($o, '^Supported at least since perl-5\.6\.0', 'm'), 1, "INT2PTR supported without ppport.h to 5.6.0");
+is(matches($o, '^ppport.h additionally provides support at least back to perl-5\.003', 'm'), 1, "INT2PTR supported with ppport.h to 5.003");
$o = ppport(qw(--api-info=Zero));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 1, "found 1 key");
+is(scalar keys %found, 1, "found 1 key");
ok(exists $found{Zero});
-ok(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
+is(matches($o, '^Supported at least since perl-5.003', 'm'), 1, "Zero supported to 5.003");
$o = ppport(qw(--api-info=/Zero/));
%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg;
-ok(scalar keys %found, 2, "found 2 keys");
+is(scalar keys %found, 2, "found 2 keys");
ok(exists $found{Zero});
ok(exists $found{ZeroD});
$p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : '';
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{call_pv});
ok(not ref $p{call_pv});
ok(exists $p{grok_bin});
-ok(ref $p{grok_bin}, 'HASH');
-ok(scalar keys %{$p{grok_bin}}, 2);
+is(ref $p{grok_bin}, 'HASH');
+is(scalar keys %{$p{grok_bin}}, 2);
ok($p{grok_bin}{explicit});
ok($p{grok_bin}{depend});
ok(exists $p{gv_stashpvn});
-ok(ref $p{gv_stashpvn}, 'HASH');
-ok(scalar keys %{$p{gv_stashpvn}}, 2);
+is(ref $p{gv_stashpvn}, 'HASH');
+is(scalar keys %{$p{gv_stashpvn}}, 2);
ok($p{gv_stashpvn}{depend});
ok($p{gv_stashpvn}{hint});
ok(exists $p{sv_catpvf_mg});
-ok(ref $p{sv_catpvf_mg}, 'HASH');
-ok(scalar keys %{$p{sv_catpvf_mg}}, 2);
+is(ref $p{sv_catpvf_mg}, 'HASH');
+is(scalar keys %{$p{sv_catpvf_mg}}, 2);
ok($p{sv_catpvf_mg}{explicit});
ok($p{sv_catpvf_mg}{depend});
ok(exists $p{PL_signals});
-ok(ref $p{PL_signals}, 'HASH');
-ok(scalar keys %{$p{PL_signals}}, 1);
+is(ref $p{PL_signals}, 'HASH');
+is(scalar keys %{$p{PL_signals}}, 1);
ok($p{PL_signals}{explicit});
===============================================================================
$p{$name} = $ver;
}
ok(@o > 100);
-ok($fail, 0);
+is($fail, 0);
ok(exists $p{utf8_distance});
-ok($p{utf8_distance}, '5.6.0');
+is($p{utf8_distance}, '5.6.0');
ok(exists $p{save_generic_svref});
-ok($p{save_generic_svref}, '5.005_03');
+is($p{save_generic_svref}, '5.005_03');
===============================================================================
my $o = ppport(qw(--nochanges));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL));
ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m);
-ok(matches($o, '^\|\s+foo\.o', 'mi'), 1);
-ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
+is(matches($o, '^\|\s+foo\.o', 'mi'), 1);
+is(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1);
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.cpp/mi);
-ok(matches($o, '^Scanning', 'm'), 1);
-ok(matches($o, 'Analyzing', 'm'), 1);
+is(matches($o, '^Scanning', 'm'), 1);
+is(matches($o, 'Analyzing', 'm'), 1);
$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL));
ok($o =~ /^Scanning.*foo\.cpp/mi);
ok($o =~ /Analyzing.*foo\.o/mi);
ok($o =~ /^Scanning.*Makefile/mi);
ok($o =~ /Analyzing.*Makefile/mi);
-ok(matches($o, '^Scanning', 'm'), 3);
-ok(matches($o, 'Analyzing', 'm'), 3);
+is(matches($o, '^Scanning', 'm'), 3);
+is(matches($o, 'Analyzing', 'm'), 3);
---------------------------- foo.cpp ------------------------------------------
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my @r;
@r = &Devel::PPPort::pv_pretty();
-ok($r[0], $r[1]);
-ok($r[0], "foobarbaz");
-ok($r[2], $r[3]);
-ok($r[2], '<leftpv_p\retty\nright>');
-ok($r[4], $r[5]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
-ok($r[6], $r[7]);
-skip(ord("A") != 65 ? "Skip for non-ASCII platform" : 0,
- $r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+is($r[0], $r[1]);
+is($r[0], "foobarbaz");
+is($r[2], $r[3]);
+is($r[2], '<leftpv_p\retty\nright>');
+is($r[4], $r[5]);
+if(ord("A") == 65) {
+ is($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
+is($r[6], $r[7]);
+if(ord("A") == 65) {
+ is($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...');
+}
+else {
+ skip("Skip for non-ASCII platform");
+}
@r = &Devel::PPPort::pv_display();
-ok($r[0], $r[1]);
-ok($r[0], '"foob\0rbaz"\0');
-ok($r[2], $r[3]);
+is($r[0], $r[1]);
+is($r[0], '"foob\0rbaz"\0');
+is($r[2], $r[3]);
ok($r[2] eq '"pv_di"...\0' ||
$r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :(
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
my $x = 'foo';
-ok(Devel::PPPort::newSVpvs(), "newSVpvs");
-ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
-ok(Devel::PPPort::newSVpvs_share(), 3);
+is(Devel::PPPort::newSVpvs(), "newSVpvs");
+is(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags");
+is(Devel::PPPort::newSVpvs_share(), 3);
Devel::PPPort::sv_catpvs($x);
-ok($x, "foosv_catpvs");
+is($x, "foosv_catpvs");
Devel::PPPort::sv_setpvs($x);
-ok($x, "sv_setpvs");
+is($x, "sv_setpvs");
my %h = ('hv_fetchs' => 42);
Devel::PPPort::hv_stores(\%h, 4711);
-ok(scalar keys %h, 2);
+is(scalar keys %h, 2);
ok(exists $h{'hv_stores'});
-ok($h{'hv_stores'}, 4711);
-ok(Devel::PPPort::hv_fetchs(\%h), 42);
-ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
-ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
+is($h{'hv_stores'}, 4711);
+is(Devel::PPPort::hv_fetchs(\%h), 42);
+is(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION);
+is(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::);
-ok(Devel::PPPort::get_cvs(), 3);
+is(Devel::PPPort::get_cvs(), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::newSVpvn_share(), 6);
+is(&Devel::PPPort::newSVpvn_share(), 6);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
my($l, $s) = Devel::PPPort::my_snprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
my($l, $s) = Devel::PPPort::my_sprintf();
-ok($l, 8);
-ok($s, "foobar42");
+is($l, 8);
+is($s, "foobar42");
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
ok(@e == @r);
for (0 .. $#e) {
- ok($r[$_], $e[$_]);
+ is($r[$_], $e[$_]);
}
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
$h{foo} = 'foo-';
$h{bar} = '';
-ok(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
-ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
-ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::vnewSVpvf(), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
+is(&Devel::PPPort::sv_vcatpvf('1-2-3-'), "$]" >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d');
+is(&Devel::PPPort::sv_vsetpvf('1-2-3-'), "$]" >= 5.004 ? 'Perl-42' : '%s-%d');
&Devel::PPPort::sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42' : 'foo-');
&Devel::PPPort::Perl_sv_catpvf_mg($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-');
&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo});
-ok($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
+is($h{foo}, "$]" >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-');
&Devel::PPPort::sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
+is($h{bar}, "$]" >= 5.004 ? 'mhx-42' : '');
&Devel::PPPort::Perl_sv_setpvf_mg($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
+is($h{bar}, "$]" >= 5.004 ? 'foo-43' : '');
&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar});
-ok($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
+is($h{bar}, "$]" >= 5.004 ? 'bar-44' : '');
-{
- my $__ntest;
- my $__total;
-
- sub plan {
- @_ == 2 or die "usage: plan(tests => count)";
- my $what = shift;
- $what eq 'tests' or die "cannot plan anything but tests";
- $__total = shift;
- defined $__total && $__total > 0 or die "need a positive number of tests";
- print "1..$__total\n";
- }
+#
+# t/test.pl - most of Test::More functionality without the fuss
- sub skip {
- my $reason = shift;
- ++$__ntest;
- print "ok $__ntest # skip: $reason\n"
- }
- sub ok ($;$$) {
- local($\,$,);
- my $ok = 0;
- my $result = shift;
- if (@_ == 0) {
- $ok = $result;
+# NOTE:
+#
+# Do not rely on features found only in more modern Perls here, as some CPAN
+# distributions copy this file and must operate on older Perls. Similarly, keep
+# things, simple as this may be run under fairly broken circumstances. For
+# example, increment ($x++) has a certain amount of cleverness for things like
+#
+# $x = 'zz';
+# $x++; # $x eq 'aaa';
+#
+# This stands more chance of breaking than just a simple
+#
+# $x = $x + 1
+#
+# In this file, we use the latter "Baby Perl" approach, and increment
+# will be worked over by t/op/inc.t
+
+$| = 1;
+$Level = 1;
+my $test = 1;
+my $planned;
+my $noplan;
+
+# This defines ASCII/UTF-8 vs EBCDIC/UTF-EBCDIC
+$::IS_ASCII = ord 'A' == 65;
+$::IS_EBCDIC = ord 'A' == 193;
+
+$TODO = 0;
+$NO_ENDING = 0;
+$Tests_Are_Passing = 1;
+
+# Use this instead of print to avoid interference while testing globals.
+sub _print {
+ local($\, $", $,) = (undef, ' ', '') if "$]" >= 5.004;
+ print STDOUT @_;
+}
+
+sub _print_stderr {
+ local($\, $", $,) = (undef, ' ', '') if "$]" >= 5.004;
+ print STDERR @_;
+}
+
+sub plan {
+ my $n;
+ if (@_ == 1) {
+ $n = shift;
+ if ($n eq 'no_plan') {
+ undef $n;
+ $noplan = 1;
+ }
} else {
- $expected = shift;
- if (!defined $expected) {
- $ok = !defined $result;
- } elsif (!defined $result) {
- $ok = 0;
- } elsif (ref($expected) eq 'Regexp') {
- die "using regular expression objects is not backwards compatible";
- } else {
- $ok = $result eq $expected;
- }
+ my %plan = @_;
+ $plan{skip_all} and skip_all($plan{skip_all});
+ $n = $plan{tests};
}
- ++$__ntest;
- if ($ok) {
- print "ok $__ntest\n"
+ _print "1..$n\n" unless $noplan;
+ $planned = $n;
+}
+
+
+# Set the plan at the end. See Test::More::done_testing.
+sub done_testing {
+ my $n = $test - 1;
+ $n = shift if @_;
+
+ _print "1..$n\n";
+ $planned = $n;
+}
+
+
+END {
+ my $ran = $test - 1;
+ if (!$NO_ENDING) {
+ if (defined $planned && $planned != $ran) {
+ _print_stderr
+ "# Looks like you planned $planned tests but ran $ran.\n";
+ } elsif ($noplan) {
+ _print "1..$ran\n";
+ }
+ }
+}
+
+sub _diag {
+ return unless @_;
+ my @mess = _comment(@_);
+ $TODO ? _print(@mess) : _print_stderr(@mess);
+}
+
+# Use this instead of "print STDERR" when outputting failure diagnostic
+# messages
+sub diag {
+ _diag(@_);
+}
+
+# Use this instead of "print" when outputting informational messages
+sub note {
+ return unless @_;
+ _print( _comment(@_) );
+}
+
+sub _comment {
+ return map { /^#/ ? "$_\n" : "# $_\n" }
+ map { split /\n/ } @_;
+}
+
+sub _have_dynamic_extension {
+ my $extension = shift;
+ unless (eval {require Config; 1}) {
+ warn "test.pl had problems loading Config: $@";
+ return 1;
+ }
+ $extension =~ s!::!/!g;
+ return 1 if ($Config::Config{extensions} =~ /\b$extension\b/);
+}
+
+sub skip_all {
+ if (@_) {
+ _print "1..0 # Skip @_\n";
+ } else {
+ _print "1..0\n";
+ }
+ exit(0);
+}
+
+sub BAIL_OUT {
+ my ($reason) = @_;
+ _print("Bail out! $reason\n");
+ exit 255;
+}
+
+sub _ok {
+ my ($pass, $where, $name, @mess) = @_;
+ # Do not try to microoptimize by factoring out the "not ".
+ # VMS will avenge.
+ my $out;
+ if ($name) {
+ # escape out '#' or it will interfere with '# skip' and such
+ $name =~ s/#/\\#/g;
+ $out = $pass ? "ok $test - $name" : "not ok $test - $name";
+ } else {
+ $out = $pass ? "ok $test" : "not ok $test";
+ }
+
+ if ($TODO) {
+ $out = $out . " # TODO $TODO";
+ } else {
+ $Tests_Are_Passing = 0 unless $pass;
+ }
+
+ _print "$out\n";
+
+ if ($pass) {
+ note @mess; # Ensure that the message is properly escaped.
}
else {
- print "not ok $__ntest\n"
+ my $msg = "# Failed test $test - ";
+ $msg.= "$name " if $name;
+ $msg .= "$where\n";
+ _diag $msg;
+ _diag @mess;
}
+
+ $test = $test + 1; # don't use ++
+
+ return $pass;
+}
+
+sub _where {
+ my @caller = caller($Level);
+ return "at $caller[1] line $caller[2]";
+}
+
+sub ok ($@) {
+ my ($pass, $name, @mess) = @_;
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub _q {
+ my $x = shift;
+ return 'undef' unless defined $x;
+ my $q = $x;
+ $q =~ s/\\/\\\\/g;
+ $q =~ s/'/\\'/g;
+ return "'$q'";
+}
+
+sub _qq {
+ my $x = shift;
+ return defined $x ? '"' . display ($x) . '"' : 'undef';
+};
+
+# Support pre-5.10 Perls, for the benefit of CPAN dists that copy this file.
+# Note that chr(90) exists in both ASCII ("Z") and EBCDIC ("!").
+my $chars_template = defined(eval { pack "W*", 90 }) ? "W*" : "U*";
+eval 'sub re::is_regexp { ref($_[0]) eq "Regexp" }'
+ if !defined &re::is_regexp;
+
+# keys are the codes \n etc map to, values are 2 char strings such as \n
+my %backslash_escape;
+my $x;
+foreach $x (split //, 'nrtfa\\\'"') {
+ $backslash_escape{ord eval "\"\\$x\""} = "\\$x";
+}
+# A way to display scalars containing control characters and Unicode.
+# Trying to avoid setting $_, or relying on local $_ to work.
+sub display {
+ my @result;
+ my $x;
+ foreach $x (@_) {
+ if (defined $x and not ref $x) {
+ my $y = '';
+ my $c;
+ foreach $c (unpack($chars_template, $x)) {
+ if ($c > 255) {
+ $y = $y . sprintf "\\x{%x}", $c;
+ } elsif ($backslash_escape{$c}) {
+ $y = $y . $backslash_escape{$c};
+ } else {
+ my $z = chr $c; # Maybe we can get away with a literal...
+ my $is_printable = ($::IS_ASCII)
+ ? $c >= ord(" ") && $c <= ord("~")
+ : $z !~ /[^[:^print:][:^ascii:]]/;
+ # /[::]/ was introduced before non-ASCII support
+ # The pattern above is equivalent (by de Morgan's
+ # laws) to:
+ # $z !~ /(?[ [:print:] & [:ascii:] ])/
+ # or, $z is not an ascii printable character
+
+ unless ($is_printable) {
+ # Use octal for characters with small ordinals that
+ # are traditionally expressed as octal: the controls
+ # below space, which on EBCDIC are almost all the
+ # controls, but on ASCII don't include DEL nor the C1
+ # controls.
+ if ($c < ord " ") {
+ $z = sprintf "\\%03o", $c;
+ } else {
+ $z = sprintf "\\x{%x}", $c;
+ }
+ }
+ $y = $y . $z;
+ }
+ }
+ $x = $y;
+ }
+ return $x unless wantarray;
+ push @result, $x;
+ }
+ return @result;
+}
+
+sub is ($$@) {
+ my ($got, $expected, $name, @mess) = @_;
+
+ my $pass;
+ if( !defined $got || !defined $expected ) {
+ # undef only matches undef
+ $pass = !defined $got && !defined $expected;
+ }
+ else {
+ $pass = $got eq $expected;
+ }
+
+ unless ($pass) {
+ unshift(@mess, "# got "._qq($got)."\n",
+ "# expected "._qq($expected)."\n");
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub isnt ($$@) {
+ my ($got, $isnt, $name, @mess) = @_;
+
+ my $pass;
+ if( !defined $got || !defined $isnt ) {
+ # undef only matches undef
+ $pass = defined $got || defined $isnt;
+ }
+ else {
+ $pass = $got ne $isnt;
+ }
+
+ unless( $pass ) {
+ unshift(@mess, "# it should not be "._qq($got)."\n",
+ "# but it is.\n");
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub cmp_ok ($$$@) {
+ my($got, $type, $expected, $name, @mess) = @_;
+
+ my $pass;
+ {
+ local $^W = 0;
+ local($@,$!); # don't interfere with $@
+ # eval() sometimes resets $!
+ $pass = eval "\$got $type \$expected";
+ }
+ unless ($pass) {
+ # It seems Irix long doubles can have 2147483648 and 2147483648
+ # that stringify to the same thing but are actually numerically
+ # different. Display the numbers if $type isn't a string operator,
+ # and the numbers are stringwise the same.
+ # (all string operators have alphabetic names, so tr/a-z// is true)
+ # This will also show numbers for some unneeded cases, but will
+ # definitely be helpful for things such as == and <= that fail
+ if ($got eq $expected and $type !~ tr/a-z//) {
+ unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
+ }
+ unshift(@mess, "# got "._qq($got)."\n",
+ "# expected $type "._qq($expected)."\n");
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+# Check that $got is within $range of $expected
+# if $range is 0, then check it's exact
+# else if $expected is 0, then $range is an absolute value
+# otherwise $range is a fractional error.
+# Here $range must be numeric, >= 0
+# Non numeric ranges might be a useful future extension. (eg %)
+sub within ($$$@) {
+ my ($got, $expected, $range, $name, @mess) = @_;
+ my $pass;
+ if (!defined $got or !defined $expected or !defined $range) {
+ # This is a fail, but doesn't need extra diagnostics
+ } elsif ($got !~ tr/0-9// or $expected !~ tr/0-9// or $range !~ tr/0-9//) {
+ # This is a fail
+ unshift @mess, "# got, expected and range must be numeric\n";
+ } elsif ($range < 0) {
+ # This is also a fail
+ unshift @mess, "# range must not be negative\n";
+ } elsif ($range == 0) {
+ # Within 0 is ==
+ $pass = $got == $expected;
+ } elsif ($expected == 0) {
+ # If expected is 0, treat range as absolute
+ $pass = ($got <= $range) && ($got >= - $range);
+ } else {
+ my $diff = $got - $expected;
+ $pass = abs ($diff / $expected) < $range;
+ }
+ unless ($pass) {
+ if ($got eq $expected) {
+ unshift @mess, "# $got - $expected = " . ($got - $expected) . "\n";
+ }
+ unshift@mess, "# got "._qq($got)."\n",
+ "# expected "._qq($expected)." (within "._qq($range).")\n";
+ }
+ _ok($pass, _where(), $name, @mess);
+}
+
+sub pass {
+ _ok(1, '', @_);
+}
+
+sub fail {
+ _ok(0, _where(), @_);
+}
+
+sub curr_test {
+ $test = shift if @_;
+ return $test;
+}
+
+sub next_test {
+ my $retval = $test;
+ $test = $test + 1; # don't use ++
+ $retval;
+}
+
+# Note: can't pass multipart messages since we try to
+# be compatible with Test::More::skip().
+sub skip {
+ my $why = shift;
+ my $n = @_ ? shift : 1;
+ my $bad_swap;
+ my $both_zero;
+ {
+ local $^W = 0;
+ $bad_swap = $why > 0 && $n == 0;
+ $both_zero = $why == 0 && $n == 0;
+ }
+ if ($bad_swap || $both_zero || @_) {
+ my $arg = "'$why', '$n'";
+ if (@_) {
+ $arg .= join(", ", '', map { qq['$_'] } @_);
+ }
+ die qq[$0: expected skip(why, count), got skip($arg)\n];
+ }
+ for (1..$n) {
+ _print "ok $test # skip $why\n";
+ $test = $test + 1;
+ }
+ local $^W = 0;
+ #last SKIP;
+}
+
+sub eq_array {
+ my ($ra, $rb) = @_;
+ return 0 unless $#$ra == $#$rb;
+ my $i;
+ for $i (0..$#$ra) {
+ next if !defined $ra->[$i] && !defined $rb->[$i];
+ return 0 if !defined $ra->[$i];
+ return 0 if !defined $rb->[$i];
+ return 0 unless $ra->[$i] eq $rb->[$i];
+ }
+ return 1;
+}
+
+sub eq_hash {
+ my ($orig, $suspect) = @_;
+ my $fail;
+ while (my ($key, $value) = each %$suspect) {
+ # Force a hash recompute if this perl's internals can cache the hash key.
+ $key = "" . $key;
+ if (exists $orig->{$key}) {
+ if (
+ defined $orig->{$key} != defined $value
+ || (defined $value && $orig->{$key} ne $value)
+ ) {
+ _print "# key ", _qq($key), " was ", _qq($orig->{$key}),
+ " now ", _qq($value), "\n";
+ $fail = 1;
+ }
+ } else {
+ _print "# key ", _qq($key), " is ", _qq($value),
+ ", not in original.\n";
+ $fail = 1;
+ }
+ }
+ foreach (keys %$orig) {
+ # Force a hash recompute if this perl's internals can cache the hash key.
+ $_ = "" . $_;
+ next if (exists $suspect->{$_});
+ _print "# key ", _qq($_), " was ", _qq($orig->{$_}), " now missing.\n";
+ $fail = 1;
}
+ !$fail;
}
1;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
package main;
-ok(&Devel::PPPort::no_THX_arg("42"), 43);
+is(&Devel::PPPort::no_THX_arg("42"), 43);
eval { &Devel::PPPort::with_THX_arg("yes\n"); };
ok($@ =~ /^yes/);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
# skip tests on 5.6.0 and earlier, plus 7.0
if ("$]" <= '5.006' || "$]" == '5.007' ) {
- for (1..93) {
- skip 'skip: broken utf8 support', 0;
- }
+ skip 'skip: broken utf8 support', 93;
exit;
}
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
-ok(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1);
+is(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
-ok(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
+is(&Devel::PPPort::isUTF8_CHAR("A", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("A", 0), 1);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", -1), 0);
+is(&Devel::PPPort::isUTF8_CHAR("\x{100}", 0), 2);
-ok(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
+is(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1);
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0xb6));
ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0x100));
if ("$]" < '5.006') {
- for (1 ..9) {
- ok(1, 1)
- }
+ skip("Perl version too early", 9);
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
- ok(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
- ok(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
- ok(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
+ is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1);
+ is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test");
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5);
+ is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6);
+ is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7);
if (ord("A") != 65) {
- ok(1, 1)
+ skip("Test not valid on EBCDIC", 1)
}
else {
- ok(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
+ is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7);
}
}
if ("$]" < '5.008') {
- for (1 ..3) {
- ok(1, 1)
- }
+ skip("Perl version too early", 3);
}
else {
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
- ok(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{101}", 3, 1), 1);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "a\x{102}", 3, 1), 0);
+ is(&Devel::PPPort::foldEQ_utf8("A\x{100}", 3, 1, "b\x{101}", 3, 1), 0);
}
my $ret = &Devel::PPPort::utf8_to_uvchr("A");
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr("\0");
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("A", 0);
-ok($ret->[0], ord("A"));
-ok($ret->[1], 1);
+is($ret->[0], ord("A"));
+is($ret->[1], 1);
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0);
-ok($ret->[0], 0);
-ok($ret->[1], 1);
+is($ret->[0], 0);
+is($ret->[1], 1);
if (ord("A") != 65) { # tests not valid for EBCDIC
- for (1 .. (2 + 4 + (7 * 5))) {
- ok(1, 1);
- }
+ skip("Perl version too early", 1 .. (2 + 4 + (7 * 5)));
}
else {
$ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0);
- ok($ret->[0], 0x100);
- ok($ret->[1], 2);
+ is($ret->[0], 0x100);
+ is($ret->[1], 2);
my @warnings;
local $SIG{__WARN__} = sub { push @warnings, @_; };
{
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0);
- ok($ret->[1], -1);
+ is($ret->[0], 0);
+ is($ret->[1], -1);
BEGIN { 'warnings'->unimport() if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80");
- ok($ret->[0], 0xFFFD);
- ok($ret->[1], 1);
+ is($ret->[0], 0xFFFD);
+ is($ret->[1], 1);
}
my @buf_tests = (
use vars '%Config';
if ($Config{ccflags} =~ /-DDEBUGGING/) {
shift @buf_tests;
- for (1..5) {
- ok(1, 1);
- }
+ skip("Test not valid on DEBUGGING builds", 5);
}
my $test;
undef @warnings;
BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0, "returned value $display; warnings enabled");
- ok($ret->[1], -1, "returned length $display; warnings enabled");
+ is($ret->[0], 0, "returned value $display; warnings enabled");
+ is($ret->[1], -1, "returned length $display; warnings enabled");
my $all_warnings = join "; ", @warnings;
my $contains = grep { $_ =~ $warning } $all_warnings;
- ok($contains, 1, $display
+ is($contains, 1, $display
. "; Got: '$all_warnings', which should contain '$warning'");
undef @warnings;
BEGIN { 'warnings'->unimport('utf8') if "$]" > '5.006' }
$ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment);
- ok($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
- ok($ret->[1], $test->{'no_warnings_returned_length'},
+ is($ret->[0], 0xFFFD, "returned value $display; warnings disabled");
+ is($ret->[1], $test->{'no_warnings_returned_length'},
"returned length $display; warnings disabled");
}
}
if ("$]" ge '5.008') {
BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } }
- ok(Devel::PPPort::sv_len_utf8("aščť"), 4);
- ok(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8("aščť"), 4);
+ is(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4);
my $str = "áíé";
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::downgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8($str), 3);
+ is(Devel::PPPort::sv_len_utf8($str), 3);
utf8::upgrade($str);
- ok(Devel::PPPort::sv_len_utf8_nomg($str), 3);
+ is(Devel::PPPort::sv_len_utf8_nomg($str), 3);
tie my $scalar, 'TieScalarCounter', "é";
- ok(tied($scalar)->{fetch}, 0);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 2);
- ok(tied($scalar)->{fetch}, 1);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 3);
- ok(tied($scalar)->{fetch}, 2);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
- ok(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
- ok(tied($scalar)->{fetch}, 3);
- ok(tied($scalar)->{store}, 0);
+ is(tied($scalar)->{fetch}, 0);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 2);
+ is(tied($scalar)->{fetch}, 1);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 3);
+ is(tied($scalar)->{fetch}, 2);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
+ is(Devel::PPPort::sv_len_utf8_nomg($scalar), 4);
+ is(tied($scalar)->{fetch}, 3);
+ is(tied($scalar)->{store}, 0);
} else {
- for (1..23) {
- skip 'skip: no SV_NOSTEAL support', 0;
- }
+ skip 'skip: no SV_NOSTEAL support', 23;
}
package TieScalarCounter;
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
BEGIN { require warnings if "$]" > '5.006' }
-ok(&Devel::PPPort::sv_setuv(42), 42);
-ok(&Devel::PPPort::newSVuv(123), 123);
-ok(&Devel::PPPort::sv_2uv("4711"), 4711);
-ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
-ok(&Devel::PPPort::SvUVx(1735928559), 1735928559);
-ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
-ok(&Devel::PPPort::XSRETURN_UV(), 42);
-ok(&Devel::PPPort::PUSHu(), 42);
-ok(&Devel::PPPort::XPUSHu(), 43);
-ok(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
+is(&Devel::PPPort::sv_setuv(42), 42);
+is(&Devel::PPPort::newSVuv(123), 123);
+is(&Devel::PPPort::sv_2uv("4711"), 4711);
+is(&Devel::PPPort::sv_2uv("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx("1735928559"), 1735928559);
+is(&Devel::PPPort::SvUVx(1735928559), 1735928559);
+is(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef);
+is(&Devel::PPPort::XSRETURN_UV(), 42);
+is(&Devel::PPPort::PUSHu(), 42);
+is(&Devel::PPPort::XPUSHu(), 43);
+is(&Devel::PPPort::my_strnlen("abc\0def", 7), 3);
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
ok(!defined(&Devel::PPPort::PL_sv_undef()));
ok(&Devel::PPPort::PL_sv_yes());
ok(!&Devel::PPPort::PL_sv_no());
-ok(&Devel::PPPort::PL_na("abcd"), 4);
-ok(&Devel::PPPort::PL_Sv(), "mhx");
+is(&Devel::PPPort::PL_na("abcd"), 4);
+is(&Devel::PPPort::PL_Sv(), "mhx");
ok(defined &Devel::PPPort::PL_tokenbuf());
ok("$]" >= 5.009005 || &Devel::PPPort::PL_parser());
ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/);
ok(defined &Devel::PPPort::PL_hints());
-ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
+is(&Devel::PPPort::PL_ppaddr("mhx"), "MHX");
for (&Devel::PPPort::other_variables()) {
ok($_ != 0);
else {
ok(@w == 0);
}
- ok($fail, 0);
+ is($fail, 0);
}
ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ("$]" < 5.009005 ? 1 : 0));
eval { &Devel::PPPort::no_dummy_parser_vars(0) };
if ("$]" < 5.009005) {
- ok($@, '');
+ is($@, '');
}
else {
if ($@) {
die qq[Cannot find "$FindBin::Bin/../parts/inc"] unless -d "$FindBin::Bin/../parts/inc";
sub load {
- eval "use Test";
- require 'testutil.pl' if $@;
+ require 'testutil.pl';
require 'inctools';
}
$warning = '';
Devel::PPPort::ckWARN();
-ok($warning, '');
+is($warning, '');
$^W = 1;
use Text::Balanced ':ALL';
-our $VERSION = '0.95';
+our $VERSION = '0.96';
use Filter::Util::Call;
use Carp;
my %selector_for = (
all => sub { my ($t)=@_; sub{ $_=$$_; $t->(@_); $_} },
executable=> sub { my ($t)=@_; sub{ref() ? $_=$$_ : $t->(@_); $_} },
+ executable_no_comments=> sub { my ($t)=@_; sub{ref() ? $_=$$_ : $t->(@_); $_} },
quotelike => sub { my ($t)=@_; sub{ref() && do{$_=$$_; $t->(@_)}; $_} },
regex => sub { my ($t)=@_;
sub{ref() or return $_;
use Filter::Simple::FilterOnlyTest qr/not ok/ => "ok",
"bad" => "ok", fail => "die";
-print "1..9\n";
+print "1..11\n";
sub fail { print "ok ", $_[0], "\n" }
sub ok { print "ok ", $_[0], "\n" }
print "not " unless "bad" =~ /bad/;
print "ok 9\n";
+
+use Filter::Simple::ExeNoComments;
+
+=for us
+
+shromplex
+
+=cut
+
+# shromplex
+
+# test the difference from code*
+my $x = "ABC";
+
+print $x eq "TEST" ? "" : "not ", "ok 10 # check strings processed\n";
+
+print "ok 11 # executable_no_comments\n";
--- /dev/null
+package Filter::Simple::ExeNoComments;
+
+use Filter::Simple;
+
+FILTER_ONLY
+ executable_no_comments => sub {
+ $_ =~ /shromplex/ and die "We wants no shromplexes!";
+ s/ABC/TEST/g;
+ };
+
+1;
#!./perl
-BEGIN {
- # Can't chdir in BEGIN before FindBin runs, as it then can't find us.
- @INC = -d 't' ? 'lib' : '../lib';
-}
-
print "1..2\n";
use FindBin qw($Bin);
print "# $Bin\n";
-print "not " unless $Bin =~ m,[/.]lib\]?$,;
+print "not " unless $Bin =~ m,[/.]t\]?$,;
print "ok 1\n";
$0 = "-";
+IO 1.41 -- Dec 12 2019 - Ricardo Signes
+ * [ TRIAL RELEASE ]
+ * import the latest from blead, so some changes may be in intermediate
+ versions found only in releases of perl5
+ * (perl #133936) make send() a bit saner
+ * (perl #133936) document differences between IO::Socket::* and builtin
+ * (perl #133936) ensure TO is honoured for UDP $sock->send()
+ * Remove vestiges of mpeix support (removed in 5.17.x)
+ * Documentation formatting fixes
+ * Improve isolation of tests as they run
+
IO 1.38 -- Apr 19 2018 - Todd Rinaldo
* Remove pre 5.8 logic from code base.
* Bump all IO modules to 1.38 and set required Perl to 5.8.1
use Test::More;
use Config;
-plan tests => 8;
+plan tests => 9;
my $listener = IO::Socket::INET->new(Listen => 1,
LocalAddr => '127.0.0.1',
my $connector = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
PeerPort => $port,
Proto => 'tcp');
+ if ($connector) {
+ my $buf;
+ # wait for parent to close its end
+ $connector->read($buf, 1);
+ }
+ else {
+ diag "child failed to connect to parent: $@";
+ }
exit(0);
} else {;
ok(defined($cpid), 'spawned a child');
my $new = $listener->accept();
+ ok($new, "got a socket from accept")
+ or diag "accept failed: $@";
+
is($new->sockdomain(), $d, 'domain match');
SKIP: {
skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
skip "no Socket::SO_TYPE", 1 if !defined(eval { Socket::SO_TYPE });
is($new->socktype(), $s, 'type match');
}
+ $new->close;
wait();
}
+5.20191220
+ - Updated for v5.31.7
+
5.20191120
- Updated for v5.31.6
our ( %released, %version, %families, %upstream, %bug_tracker, %deprecated, %delta );
use version;
-our $VERSION = '5.20191120';
+our $VERSION = '5.20191220';
sub PKG_PATTERN () { q#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z# }
sub _looks_like_invocant ($) { local $@; !!eval { $_[0]->isa(__PACKAGE__) } }
5.031005 => '2019-10-20',
5.030001 => '2019-11-10',
5.031006 => '2019-11-20',
+ 5.031007 => '2019-12-20',
);
for my $version ( sort { $a <=> $b } keys %released ) {
removed => {
}
},
+ 5.031007 => {
+ delta_from => 5.031006,
+ changed => {
+ 'B' => '1.78',
+ 'B::Deparse' => '1.52',
+ 'B::Op_private' => '5.031007',
+ 'Compress::Raw::Bzip2' => '2.093',
+ 'Compress::Raw::Zlib' => '2.093',
+ 'Compress::Zlib' => '2.093',
+ 'Config' => '5.031007',
+ 'Devel::PPPort' => '3.56',
+ 'English' => '1.11',
+ 'ExtUtils::Command' => '7.42',
+ 'ExtUtils::Command::MM' => '7.42',
+ 'ExtUtils::Liblist' => '7.42',
+ 'ExtUtils::Liblist::Kid'=> '7.42',
+ 'ExtUtils::MM' => '7.42',
+ 'ExtUtils::MM_AIX' => '7.42',
+ 'ExtUtils::MM_Any' => '7.42',
+ 'ExtUtils::MM_BeOS' => '7.42',
+ 'ExtUtils::MM_Cygwin' => '7.42',
+ 'ExtUtils::MM_DOS' => '7.42',
+ 'ExtUtils::MM_Darwin' => '7.42',
+ 'ExtUtils::MM_MacOS' => '7.42',
+ 'ExtUtils::MM_NW5' => '7.42',
+ 'ExtUtils::MM_OS2' => '7.42',
+ 'ExtUtils::MM_QNX' => '7.42',
+ 'ExtUtils::MM_UWIN' => '7.42',
+ 'ExtUtils::MM_Unix' => '7.42',
+ 'ExtUtils::MM_VMS' => '7.42',
+ 'ExtUtils::MM_VOS' => '7.42',
+ 'ExtUtils::MM_Win32' => '7.42',
+ 'ExtUtils::MM_Win95' => '7.42',
+ 'ExtUtils::MY' => '7.42',
+ 'ExtUtils::MakeMaker' => '7.42',
+ 'ExtUtils::MakeMaker::Config'=> '7.42',
+ 'ExtUtils::MakeMaker::Locale'=> '7.42',
+ 'ExtUtils::MakeMaker::version'=> '7.42',
+ 'ExtUtils::MakeMaker::version::regex'=> '7.42',
+ 'ExtUtils::Mkbootstrap' => '7.42',
+ 'ExtUtils::Mksymlists' => '7.42',
+ 'ExtUtils::testlib' => '7.42',
+ 'File::stat' => '1.09',
+ 'Filter::Simple' => '0.96',
+ 'IO::Compress::Adapter::Bzip2'=> '2.093',
+ 'IO::Compress::Adapter::Deflate'=> '2.093',
+ 'IO::Compress::Adapter::Identity'=> '2.093',
+ 'IO::Compress::Base' => '2.093',
+ 'IO::Compress::Base::Common'=> '2.093',
+ 'IO::Compress::Bzip2' => '2.093',
+ 'IO::Compress::Deflate' => '2.093',
+ 'IO::Compress::Gzip' => '2.093',
+ 'IO::Compress::Gzip::Constants'=> '2.093',
+ 'IO::Compress::RawDeflate'=> '2.093',
+ 'IO::Compress::Zip' => '2.093',
+ 'IO::Compress::Zip::Constants'=> '2.093',
+ 'IO::Compress::Zlib::Constants'=> '2.093',
+ 'IO::Compress::Zlib::Extra'=> '2.093',
+ 'IO::Uncompress::Adapter::Bunzip2'=> '2.093',
+ 'IO::Uncompress::Adapter::Identity'=> '2.093',
+ 'IO::Uncompress::Adapter::Inflate'=> '2.093',
+ 'IO::Uncompress::AnyInflate'=> '2.093',
+ 'IO::Uncompress::AnyUncompress'=> '2.093',
+ 'IO::Uncompress::Base' => '2.093',
+ 'IO::Uncompress::Bunzip2'=> '2.093',
+ 'IO::Uncompress::Gunzip'=> '2.093',
+ 'IO::Uncompress::Inflate'=> '2.093',
+ 'IO::Uncompress::RawInflate'=> '2.093',
+ 'IO::Uncompress::Unzip' => '2.093',
+ 'Module::CoreList' => '5.20191220',
+ 'Module::CoreList::Utils'=> '5.20191220',
+ 'Net::Ping' => '2.72',
+ 'Opcode' => '1.45',
+ 'Storable' => '3.18',
+ 'Test2' => '1.302170',
+ 'Test2::API' => '1.302170',
+ 'Test2::API::Breakage' => '1.302170',
+ 'Test2::API::Context' => '1.302170',
+ 'Test2::API::Instance' => '1.302170',
+ 'Test2::API::Stack' => '1.302170',
+ 'Test2::Event' => '1.302170',
+ 'Test2::Event::Bail' => '1.302170',
+ 'Test2::Event::Diag' => '1.302170',
+ 'Test2::Event::Encoding'=> '1.302170',
+ 'Test2::Event::Exception'=> '1.302170',
+ 'Test2::Event::Fail' => '1.302170',
+ 'Test2::Event::Generic' => '1.302170',
+ 'Test2::Event::Note' => '1.302170',
+ 'Test2::Event::Ok' => '1.302170',
+ 'Test2::Event::Pass' => '1.302170',
+ 'Test2::Event::Plan' => '1.302170',
+ 'Test2::Event::Skip' => '1.302170',
+ 'Test2::Event::Subtest' => '1.302170',
+ 'Test2::Event::TAP::Version'=> '1.302170',
+ 'Test2::Event::V2' => '1.302170',
+ 'Test2::Event::Waiting' => '1.302170',
+ 'Test2::EventFacet' => '1.302170',
+ 'Test2::EventFacet::About'=> '1.302170',
+ 'Test2::EventFacet::Amnesty'=> '1.302170',
+ 'Test2::EventFacet::Assert'=> '1.302170',
+ 'Test2::EventFacet::Control'=> '1.302170',
+ 'Test2::EventFacet::Error'=> '1.302170',
+ 'Test2::EventFacet::Hub'=> '1.302170',
+ 'Test2::EventFacet::Info'=> '1.302170',
+ 'Test2::EventFacet::Info::Table'=> '1.302170',
+ 'Test2::EventFacet::Meta'=> '1.302170',
+ 'Test2::EventFacet::Parent'=> '1.302170',
+ 'Test2::EventFacet::Plan'=> '1.302170',
+ 'Test2::EventFacet::Render'=> '1.302170',
+ 'Test2::EventFacet::Trace'=> '1.302170',
+ 'Test2::Formatter' => '1.302170',
+ 'Test2::Formatter::TAP' => '1.302170',
+ 'Test2::Hub' => '1.302170',
+ 'Test2::Hub::Interceptor'=> '1.302170',
+ 'Test2::Hub::Interceptor::Terminator'=> '1.302170',
+ 'Test2::Hub::Subtest' => '1.302170',
+ 'Test2::IPC' => '1.302170',
+ 'Test2::IPC::Driver' => '1.302170',
+ 'Test2::IPC::Driver::Files'=> '1.302170',
+ 'Test2::Tools::Tiny' => '1.302170',
+ 'Test2::Util' => '1.302170',
+ 'Test2::Util::ExternalMeta'=> '1.302170',
+ 'Test2::Util::Facets2Legacy'=> '1.302170',
+ 'Test2::Util::HashBase' => '1.302170',
+ 'Test2::Util::Trace' => '1.302170',
+ 'Test::Builder' => '1.302170',
+ 'Test::Builder::Formatter'=> '1.302170',
+ 'Test::Builder::Module' => '1.302170',
+ 'Test::Builder::Tester' => '1.302170',
+ 'Test::Builder::Tester::Color'=> '1.302170',
+ 'Test::Builder::TodoDiag'=> '1.302170',
+ 'Test::More' => '1.302170',
+ 'Test::Simple' => '1.302170',
+ 'Test::Tester' => '1.302170',
+ 'Test::Tester::Capture' => '1.302170',
+ 'Test::Tester::CaptureRunner'=> '1.302170',
+ 'Test::Tester::Delegate'=> '1.302170',
+ 'Test::use::ok' => '1.302170',
+ 'Tie::Hash::NamedCapture'=> '0.13',
+ 'VMS::Stdio' => '2.45',
+ 'XS::APItest' => '1.05',
+ 'feature' => '1.57',
+ 'ok' => '1.302170',
+ 'warnings' => '1.46',
+ },
+ removed => {
+ }
+ },
);
sub is_core
removed => {
}
},
+ 5.031007 => {
+ delta_from => 5.031006,
+ changed => {
+ },
+ removed => {
+ }
+ },
);
%deprecated = _undelta(\%deprecated);
use warnings;
use Module::CoreList;
-our $VERSION = '5.20191120';
+our $VERSION = '5.20191220';
our %utilities;
sub utilities {
removed => {
}
},
+ 5.031007 => {
+ delta_from => 5.031006,
+ changed => {
+ },
+ removed => {
+ }
+ },
);
%utilities = Module::CoreList::_undelta(\%delta);
CHANGES
-------
+2.72 Thu 28 Mar 2019 09:01:39 AM CET (rurban)
+ Features
+ - add .cirrus.yml smoker https://cirrus-ci.com/github/rurban/Net-Ping
+ Test fixes
+ - Skip failing freebsd localhost resolver tests
2.71 Tue Oct 16 18:41:51 CEST 2018 (rurban)
Features
our @ISA = qw(Exporter);
our @EXPORT = qw(pingecho);
our @EXPORT_OK = qw(wakeonlan);
-our $VERSION = "2.71";
+our $VERSION = "2.72";
# Globals
TODO: {
local $TODO = "Not working on os390 smoker; may be a permissions problem"
- if $^O eq 'os390';
+ if $^O eq 'os390';
+ $TODO = "Not working on freebsd" if $^O eq 'freebsd';
my $result = pingecho("127.0.0.1");
- is($result, 1, "pingecho works");
+ is($result, 1, "pingecho 127.0.0.1 works");
}
print "1..0 \# Skip: no echo port\n";
exit;
}
+ unless (Socket::getaddrinfo('localhost', &Socket::AF_INET())) {
+ print "1..0 \# Skip: no localhost resolver on $^O\n";
+ exit;
+ }
}
use Test::More tests => 8;
$p -> hires(1);
isnt($Net::Ping::hires, 0, 'Enable hires again');
-# Test on the default port
-my ($ret, $duration) = $p -> ping("localhost");
+SKIP: {
+ skip "unreliable ping localhost on $^O", 2
+ if $^O =~ /^(?:hpux|os390|irix|freebsd)$/;
-isnt($ret, 0, 'localhost should always be reachable');
+ # Test on the default port
+ my ($ret, $duration) = $p -> ping("localhost");
-# It is extremely likely that the duration contains a decimal
-# point if Time::HiRes is functioning properly, except when it
-# is fast enough to be "0", or slow enough to be exactly "1".
-like($duration, qr/\.|^[01]$/, 'returned duration is valid');
+ isnt($ret, 0, 'localhost should always be reachable');
+
+ # It is extremely likely that the duration contains a decimal
+ # point if Time::HiRes is functioning properly, except when it
+ # is fast enough to be "0", or slow enough to be exactly "1".
+ like($duration, qr/\.|^[01]$/, 'returned duration is valid');
+}
exit;
}
}
+ if ($^O eq 'freebsd') {
+ print "1..0 \# Skip: unreliable localhost resolver on $^O\n";
+ exit;
+ }
unless (eval "require Socket") {
print "1..0 \# Skip: no Socket\n";
exit;
}
if (my $port = getservbyname('echo', 'tcp')) {
- socket(*ECHO, &Socket::PF_INET(), &Socket::SOCK_STREAM(), (getprotobyname 'tcp')[2]);
- unless (connect(*ECHO, scalar &Socket::sockaddr_in($port, &Socket::inet_aton("localhost")))) {
+ socket(*ECHO, &Socket::PF_INET(), &Socket::SOCK_STREAM(),
+ (getprotobyname 'tcp')[2]);
+ unless (connect(*ECHO,
+ scalar
+ &Socket::sockaddr_in($port,
+ &Socket::inet_aton("localhost"))))
+ {
print "1..0 \# Skip: loopback tcp echo service is off ($!)\n";
exit;
}
print "1..0 \# Skip: no echo port\n";
exit;
}
+ unless (Socket::getaddrinfo('localhost', &Socket::AF_INET)) {
+ print "1..0 \# Skip: no localhost resolver on $^O\n";
+ exit;
+ }
}
# Test of stream protocol using loopback interface.
$p->{port_num} = $port2;
{
- local $TODO;
- $TODO = "Believed not to work on $^O" if $^O eq 'hpux' || $^O eq 'os390';
+ local $TODO = "Believed not to work on $^O" if $^O =~ /^(?:hpux|os390|freebsd)$/;
is($p->ping("127.0.0.1"), 1, 'second port is reachable');
}
# Try on the other port
$p->{port_num} = $port2;
-is($p->ping("127.0.0.1"), 1, "send SYN to second port") or diag ("ERRNO: $!");
+SKIP: {
+ skip "no localhost resolver on $^O", 2
+ unless Socket::getaddrinfo('localhost', &Socket::AF_INET);
+ is($p->ping("127.0.0.1"), 1, "send SYN to second port") or diag ("ERRNO: $!");
-{
- local $TODO;
- $TODO = "Believed not to work on $^O" if $^O eq 'hpux' || $^O eq 'MSWin32' || $^O eq 'os390';
+ {
+ local $TODO = "Believed not to work on $^O"
+ if $^O =~ /^(?:hpux|MSWin32|os390|freebsd)$/;
is($p->ack(), '127.0.0.1', 'IP should be reachable');
+ }
}
is($p->ack(), undef, 'No more sockets');
skip "No udp echo port", 2 unless getservbyname('echo', 'udp');
skip "udp ping blocked by Window's default settings", 2 if isWindowsVista();
skip "No getprotobyname", 2 unless $Config{d_getpbyname};
- skip "Not allowed on $^O", 2 if $^O =~ /^(hpux|irix|aix)$/;
+ skip "Not allowed on $^O", 2 if $^O =~ /^(hpux|irix|aix|freebsd)$/;
my $p = new Net::Ping "udp";
# message_type can't be used
eval {
ABSTRACT_FROM => 'Storable.pm',
($ExtUtils::MakeMaker::VERSION > 6.45 ?
(META_MERGE => { resources =>
- { bugtracker => 'https://rt.perl.org/perlbug/' },
+ { bugtracker => 'https://github.com/Perl/perl5/issues' },
provides => {
'Storable' => {
file => 'Storable.pm',
our ($canonical, $forgive_me);
BEGIN {
- our $VERSION = '3.17';
+ our $VERSION = '3.18';
}
our $recursion_limit;
/* The macro passes this by address, not value, and a lot of
called code assumes that it's 32 bits without checking. */
const SSize_t len = mg->mg_len;
+ /* we no longer accept vstrings over I32_SIZE-1, so don't emit
+ them, also, older Storables handle them badly.
+ */
+ if (len >= I32_MAX) {
+ CROAK(("vstring too large to freeze"));
+ }
STORE_PV_LEN((const char *)mg->mg_ptr,
len, SX_VSTRING, SX_LVSTRING);
}
count = call_sv((SV*)cv, G_ARRAY);
SPAGAIN;
if (count < 2)
- CROAK(("re::regexp_pattern returned only %d results", count));
+ CROAK(("re::regexp_pattern returned only %d results", (int)count));
*flags = POPs;
SvREFCNT_inc(*flags);
*re = POPs;
{
#ifdef SvVOK
char *s;
- I32 len;
+ U32 len;
SV *sv;
RLEN(len);
- TRACEME(("retrieve_lvstring (#%d), len = %" IVdf,
- (int)cxt->tagnum, (IV)len));
+ TRACEME(("retrieve_lvstring (#%d), len = %" UVuf,
+ (int)cxt->tagnum, (UV)len));
+
+ /* Since we'll no longer produce such large vstrings, reject them
+ here too.
+ */
+ if (len >= I32_MAX) {
+ CROAK(("vstring too large to fetch"));
+ }
New(10003, s, len+1, char);
- SAFEPVREAD(s, len, s);
+ SAFEPVREAD(s, (I32)len, s);
sv = retrieve(aTHX_ cxt, cname);
if (!sv) {
SPAGAIN;
if (count != 1)
- CROAK(("Bad count %d calling _make_re", count));
+ CROAK(("Bad count %d calling _make_re", (int)count));
re_ref = POPs;
for (s = cmd; *s; s++) {
if (*s != ' ' && !isALPHA(*s) &&
- strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+ memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) {
if (*s == '\n' && !s[1]) {
*s = '\0';
break;
/*N11=253*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0,
/*N12=276*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,299,
/*N13=299*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1,
-/*N14=322*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46,299
+/*N14=322*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46,345,
+/*N15=345*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,299
/* 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22*/
};
# endif
/*N11=253*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0,
/*N12=276*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,299,
/*N13=299*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1,
-/*N14=322*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46,299
+/*N14=322*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46, 46,345,
+/*N15=345*/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23, 23,299
/* 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22*/
};
# endif
ApdR |bool |sv_derived_from_pv|NN SV* sv|NN const char *const name|U32 flags
ApdR |bool |sv_derived_from_pvn|NN SV* sv|NN const char *const name \
|const STRLEN len|U32 flags
+ApdRx |bool |sv_isa_sv |NN SV* sv|NN SV* namesv
ApdR |bool |sv_does |NN SV* sv|NN const char *const name
ApdR |bool |sv_does_sv |NN SV* sv|NN SV* namesv|U32 flags
ApdR |bool |sv_does_pv |NN SV* sv|NN const char *const name|U32 flags
Ei |void |invlist_extend |NN SV* const invlist|const UV len
Ei |void |invlist_set_len|NN SV* const invlist|const UV len|const bool offset
EiRT |UV |invlist_highest|NN SV* const invlist
+#endif
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C)
EiRT |STRLEN*|get_invlist_iter_addr |NN SV* invlist
EiT |void |invlist_iterinit|NN SV* invlist
EiRT |bool |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end
EiRT |bool |invlist_is_iterating|NN SV* const invlist
EiR |SV* |invlist_contents|NN SV* const invlist \
|const bool traditional_style
+EixRT |UV |invlist_lowest|NN SV* const invlist
#ifndef PERL_EXT_RE_BUILD
EiRT |UV* |_invlist_array_init |NN SV* const invlist|const bool will_have_0
EiRT |UV |invlist_max |NN SV* const invlist
#endif
Ap |void |taint_env
Ap |void |taint_proper |NULLOK const char* f|NN const char *const s
-Ep |char * |_byte_dump_string \
+EXp |char * |_byte_dump_string \
|NN const U8 * const start \
|const STRLEN len \
|const bool format
ES |void |output_posix_warnings \
|NN RExC_state_t *pRExC_state \
|NN AV* posix_warnings
+EiT |Size_t |find_first_differing_byte_pos|NN const U8 * s1|NN const U8 * s2| const Size_t max
ES |AV* |add_multi_match|NULLOK AV* multi_char_matches \
|NN SV* multi_string \
|const STRLEN cp_count
EXRp |bool |isFOO_lc |const U8 classnum|const U8 character
#endif
-#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C)
-ERp |bool |_is_grapheme |NN const U8 * strbeg|NN const U8 * s|NN const U8 *strend|const UV cp
+#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C)
+ERp |bool |is_grapheme |NN const U8 * strbeg|NN const U8 * s|NN const U8 *strend|const UV cp
#endif
#if defined(PERL_IN_REGEXEC_C)
#endif
APpdT |bool |isinfnan |NV nv
-p |bool |isinfnansv |NN SV *sv
+pd |bool |isinfnansv |NN SV *sv
#if !defined(HAS_SIGNBIT)
AxdToP |int |Perl_signbit |NV f
#define sv_inc_nomg(a) Perl_sv_inc_nomg(aTHX_ a)
#define sv_insert_flags(a,b,c,d,e,f) Perl_sv_insert_flags(aTHX_ a,b,c,d,e,f)
#define sv_isa(a,b) Perl_sv_isa(aTHX_ a,b)
+#define sv_isa_sv(a,b) Perl_sv_isa_sv(aTHX_ a,b)
#define sv_isobject(a) Perl_sv_isobject(aTHX_ a)
#ifndef NO_MATHOMS
#define sv_iv(a) Perl_sv_iv(aTHX_ a)
#define compute_EXACTish S_compute_EXACTish
#define construct_ahocorasick_from_trie(a,b,c) S_construct_ahocorasick_from_trie(aTHX_ a,b,c)
#define edit_distance S_edit_distance
+#define find_first_differing_byte_pos S_find_first_differing_byte_pos
#define get_ANYOFM_contents(a) S_get_ANYOFM_contents(aTHX_ a)
#define get_ANYOF_cp_list_for_ssc(a,b) S_get_ANYOF_cp_list_for_ssc(aTHX_ a,b)
#define grok_bslash_N(a,b,c,d,e,f,g) S_grok_bslash_N(aTHX_ a,b,c,d,e,f,g)
#define handle_user_defined_property(a,b,c,d,e,f,g,h,i,j) Perl_handle_user_defined_property(aTHX_ a,b,c,d,e,f,g,h,i,j)
#define invlist_contents(a,b) S_invlist_contents(aTHX_ a,b)
#define invlist_is_iterating S_invlist_is_iterating
+#define invlist_lowest S_invlist_lowest
#define is_ssc_worth_it S_is_ssc_worth_it
#define join_exact(a,b,c,d,e,f,g) S_join_exact(aTHX_ a,b,c,d,e,f,g)
#define make_exactf_invlist(a,b) S_make_exactf_invlist(aTHX_ a,b)
# if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C) || defined(PERL_IN_OP_C)
#define _invlist_dump(a,b,c,d) Perl__invlist_dump(aTHX_ a,b,c,d)
# endif
-# if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
-#define add_cp_to_invlist(a,b) S_add_cp_to_invlist(aTHX_ a,b)
+# if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C)
#define get_invlist_iter_addr S_get_invlist_iter_addr
-#define invlist_extend(a,b) S_invlist_extend(aTHX_ a,b)
-#define invlist_highest S_invlist_highest
#define invlist_iterfinish S_invlist_iterfinish
#define invlist_iterinit S_invlist_iterinit
#define invlist_iternext S_invlist_iternext
+# endif
+# if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
+#define add_cp_to_invlist(a,b) S_add_cp_to_invlist(aTHX_ a,b)
+#define invlist_extend(a,b) S_invlist_extend(aTHX_ a,b)
+#define invlist_highest S_invlist_highest
#define invlist_set_len(a,b,c) S_invlist_set_len(aTHX_ a,b,c)
# endif
# if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_PERL_C) || defined(PERL_IN_UTF8_C)
#define to_byte_substr(a) S_to_byte_substr(aTHX_ a)
#define to_utf8_substr(a) S_to_utf8_substr(aTHX_ a)
# endif
-# if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C)
-#define _is_grapheme(a,b,c,d) Perl__is_grapheme(aTHX_ a,b,c,d)
+# if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C)
+#define is_grapheme(a,b,c,d) Perl_is_grapheme(aTHX_ a,b,c,d)
# endif
# if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C)
#define isFOO_lc(a,b) Perl_isFOO_lc(aTHX_ a,b)
#define ck_glob(a) Perl_ck_glob(aTHX_ a)
#define ck_grep(a) Perl_ck_grep(aTHX_ a)
#define ck_index(a) Perl_ck_index(aTHX_ a)
+#define ck_isa(a) Perl_ck_isa(aTHX_ a)
#define ck_join(a) Perl_ck_join(aTHX_ a)
#define ck_length(a) Perl_ck_length(aTHX_ a)
#define ck_lfun(a) Perl_ck_lfun(aTHX_ a)
# define vTHX PERL_GET_INTERP
# endif
+#define PL_AboveLatin1 (vTHX->IAboveLatin1)
+#define PL_Assigned_invlist (vTHX->IAssigned_invlist)
+#define PL_CCC_non0_non230 (vTHX->ICCC_non0_non230)
#define PL_DBcontrol (vTHX->IDBcontrol)
#define PL_DBcv (vTHX->IDBcv)
#define PL_DBgv (vTHX->IDBgv)
#define PL_DBtrace (vTHX->IDBtrace)
#define PL_Dir (vTHX->IDir)
#define PL_Env (vTHX->IEnv)
+#define PL_GCB_invlist (vTHX->IGCB_invlist)
+#define PL_HasMultiCharFold (vTHX->IHasMultiCharFold)
+#define PL_InBitmap (vTHX->IInBitmap)
+#define PL_InMultiCharFold (vTHX->IInMultiCharFold)
+#define PL_LB_invlist (vTHX->ILB_invlist)
#define PL_LIO (vTHX->ILIO)
+#define PL_Latin1 (vTHX->ILatin1)
#define PL_Mem (vTHX->IMem)
#define PL_MemParse (vTHX->IMemParse)
#define PL_MemShared (vTHX->IMemShared)
+#define PL_Posix_ptrs (vTHX->IPosix_ptrs)
+#define PL_Private_Use (vTHX->IPrivate_Use)
#define PL_Proc (vTHX->IProc)
+#define PL_SB_invlist (vTHX->ISB_invlist)
+#define PL_SCX_invlist (vTHX->ISCX_invlist)
#define PL_Sock (vTHX->ISock)
#define PL_StdIO (vTHX->IStdIO)
#define PL_Sv (vTHX->ISv)
#define PL_TR_SPECIAL_HANDLING_UTF8 (vTHX->ITR_SPECIAL_HANDLING_UTF8)
+#define PL_UpperLatin1 (vTHX->IUpperLatin1)
+#define PL_WB_invlist (vTHX->IWB_invlist)
+#define PL_XPosix_ptrs (vTHX->IXPosix_ptrs)
#define PL_Xpv (vTHX->IXpv)
#define PL_an (vTHX->Ian)
#define PL_argvgv (vTHX->Iargvgv)
#define PL_in_clean_objs (vTHX->Iin_clean_objs)
#define PL_in_eval (vTHX->Iin_eval)
#define PL_in_load_module (vTHX->Iin_load_module)
+#define PL_in_some_fold (vTHX->Iin_some_fold)
#define PL_in_utf8_COLLATE_locale (vTHX->Iin_utf8_COLLATE_locale)
#define PL_in_utf8_CTYPE_locale (vTHX->Iin_utf8_CTYPE_locale)
#define PL_in_utf8_turkic_locale (vTHX->Iin_utf8_turkic_locale)
#define PL_unitcheckav_save (vTHX->Iunitcheckav_save)
#define PL_unlockhook (vTHX->Iunlockhook)
#define PL_unsafe (vTHX->Iunsafe)
+#define PL_utf8_charname_begin (vTHX->Iutf8_charname_begin)
+#define PL_utf8_charname_continue (vTHX->Iutf8_charname_continue)
+#define PL_utf8_idcont (vTHX->Iutf8_idcont)
+#define PL_utf8_idstart (vTHX->Iutf8_idstart)
+#define PL_utf8_mark (vTHX->Iutf8_mark)
+#define PL_utf8_perl_idcont (vTHX->Iutf8_perl_idcont)
+#define PL_utf8_perl_idstart (vTHX->Iutf8_perl_idstart)
+#define PL_utf8_tofold (vTHX->Iutf8_tofold)
+#define PL_utf8_tolower (vTHX->Iutf8_tolower)
+#define PL_utf8_tosimplefold (vTHX->Iutf8_tosimplefold)
+#define PL_utf8_totitle (vTHX->Iutf8_totitle)
+#define PL_utf8_toupper (vTHX->Iutf8_toupper)
+#define PL_utf8_xidcont (vTHX->Iutf8_xidcont)
+#define PL_utf8_xidstart (vTHX->Iutf8_xidstart)
#define PL_utf8cache (vTHX->Iutf8cache)
#define PL_utf8locale (vTHX->Iutf8locale)
#define PL_warn_locale (vTHX->Iwarn_locale)
#if defined(PERL_GLOBAL_STRUCT)
-#define PL_AboveLatin1 (my_vars->GAboveLatin1)
-#define PL_GAboveLatin1 (my_vars->GAboveLatin1)
-#define PL_Assigned_invlist (my_vars->GAssigned_invlist)
-#define PL_GAssigned_invlist (my_vars->GAssigned_invlist)
-#define PL_CCC_non0_non230 (my_vars->GCCC_non0_non230)
-#define PL_GCCC_non0_non230 (my_vars->GCCC_non0_non230)
#define PL_C_locale_obj (my_vars->GC_locale_obj)
#define PL_GC_locale_obj (my_vars->GC_locale_obj)
-#define PL_GCB_invlist (my_vars->GGCB_invlist)
-#define PL_GGCB_invlist (my_vars->GGCB_invlist)
-#define PL_HasMultiCharFold (my_vars->GHasMultiCharFold)
-#define PL_GHasMultiCharFold (my_vars->GHasMultiCharFold)
-#define PL_InBitmap (my_vars->GInBitmap)
-#define PL_GInBitmap (my_vars->GInBitmap)
-#define PL_InMultiCharFold (my_vars->GInMultiCharFold)
-#define PL_GInMultiCharFold (my_vars->GInMultiCharFold)
-#define PL_LB_invlist (my_vars->GLB_invlist)
-#define PL_GLB_invlist (my_vars->GLB_invlist)
-#define PL_Latin1 (my_vars->GLatin1)
-#define PL_GLatin1 (my_vars->GLatin1)
-#define PL_Posix_ptrs (my_vars->GPosix_ptrs)
-#define PL_GPosix_ptrs (my_vars->GPosix_ptrs)
-#define PL_Private_Use (my_vars->GPrivate_Use)
-#define PL_GPrivate_Use (my_vars->GPrivate_Use)
-#define PL_SB_invlist (my_vars->GSB_invlist)
-#define PL_GSB_invlist (my_vars->GSB_invlist)
-#define PL_SCX_invlist (my_vars->GSCX_invlist)
-#define PL_GSCX_invlist (my_vars->GSCX_invlist)
-#define PL_UpperLatin1 (my_vars->GUpperLatin1)
-#define PL_GUpperLatin1 (my_vars->GUpperLatin1)
-#define PL_WB_invlist (my_vars->GWB_invlist)
-#define PL_GWB_invlist (my_vars->GWB_invlist)
-#define PL_XPosix_ptrs (my_vars->GXPosix_ptrs)
-#define PL_GXPosix_ptrs (my_vars->GXPosix_ptrs)
#define PL_appctx (my_vars->Gappctx)
#define PL_Gappctx (my_vars->Gappctx)
#define PL_check (my_vars->Gcheck)
#define PL_Ghash_state (my_vars->Ghash_state)
#define PL_hints_mutex (my_vars->Ghints_mutex)
#define PL_Ghints_mutex (my_vars->Ghints_mutex)
-#define PL_in_some_fold (my_vars->Gin_some_fold)
-#define PL_Gin_some_fold (my_vars->Gin_some_fold)
#define PL_keyword_plugin (my_vars->Gkeyword_plugin)
#define PL_Gkeyword_plugin (my_vars->Gkeyword_plugin)
#define PL_keyword_plugin_mutex (my_vars->Gkeyword_plugin_mutex)
#define PL_Guser_def_props_aTHX (my_vars->Guser_def_props_aTHX)
#define PL_user_prop_mutex (my_vars->Guser_prop_mutex)
#define PL_Guser_prop_mutex (my_vars->Guser_prop_mutex)
-#define PL_utf8_charname_begin (my_vars->Gutf8_charname_begin)
-#define PL_Gutf8_charname_begin (my_vars->Gutf8_charname_begin)
-#define PL_utf8_charname_continue (my_vars->Gutf8_charname_continue)
-#define PL_Gutf8_charname_continue (my_vars->Gutf8_charname_continue)
#define PL_utf8_foldclosures (my_vars->Gutf8_foldclosures)
#define PL_Gutf8_foldclosures (my_vars->Gutf8_foldclosures)
-#define PL_utf8_idcont (my_vars->Gutf8_idcont)
-#define PL_Gutf8_idcont (my_vars->Gutf8_idcont)
-#define PL_utf8_idstart (my_vars->Gutf8_idstart)
-#define PL_Gutf8_idstart (my_vars->Gutf8_idstart)
-#define PL_utf8_mark (my_vars->Gutf8_mark)
-#define PL_Gutf8_mark (my_vars->Gutf8_mark)
-#define PL_utf8_perl_idcont (my_vars->Gutf8_perl_idcont)
-#define PL_Gutf8_perl_idcont (my_vars->Gutf8_perl_idcont)
-#define PL_utf8_perl_idstart (my_vars->Gutf8_perl_idstart)
-#define PL_Gutf8_perl_idstart (my_vars->Gutf8_perl_idstart)
-#define PL_utf8_tofold (my_vars->Gutf8_tofold)
-#define PL_Gutf8_tofold (my_vars->Gutf8_tofold)
-#define PL_utf8_tolower (my_vars->Gutf8_tolower)
-#define PL_Gutf8_tolower (my_vars->Gutf8_tolower)
-#define PL_utf8_tosimplefold (my_vars->Gutf8_tosimplefold)
-#define PL_Gutf8_tosimplefold (my_vars->Gutf8_tosimplefold)
-#define PL_utf8_totitle (my_vars->Gutf8_totitle)
-#define PL_Gutf8_totitle (my_vars->Gutf8_totitle)
-#define PL_utf8_toupper (my_vars->Gutf8_toupper)
-#define PL_Gutf8_toupper (my_vars->Gutf8_toupper)
-#define PL_utf8_xidcont (my_vars->Gutf8_xidcont)
-#define PL_Gutf8_xidcont (my_vars->Gutf8_xidcont)
-#define PL_utf8_xidstart (my_vars->Gutf8_xidstart)
-#define PL_Gutf8_xidstart (my_vars->Gutf8_xidstart)
#define PL_veto_cleanup (my_vars->Gveto_cleanup)
#define PL_Gveto_cleanup (my_vars->Gveto_cleanup)
#define PL_watch_pvx (my_vars->Gwatch_pvx)
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.77';
+ $B::VERSION = '1.78';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
sv_catpvs(sstr, "\\@");
else if (*s == '\\')
{
- if (strchr("nrftax\\",*(s+1)))
+ if (memCHRs("nrftax\\",*(s+1)))
sv_catpvn(sstr, s++, 2);
else
sv_catpvs(sstr, "\\\\");
our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.44";
+$VERSION = "1.45";
use Carp;
use Exporter ();
lt i_lt gt i_gt le i_le ge i_ge eq i_eq ne i_ne ncmp i_ncmp
slt sgt sle sge seq sne scmp
+ isa
substr vec stringify study pos length index rindex ord chr
"asctime() and ctime() at 12345678");
# Careful! strftime() is locale sensitive. Let's take care of that
-my $orig_loc = 'C';
+my $orig_time_loc = 'C';
+my $orig_ctype_loc = 'C';
if (locales_enabled('LC_TIME')) {
- $orig_loc = setlocale(LC_TIME) || die "Cannot get locale information: $!";
+ $orig_time_loc = setlocale(LC_TIME) || die "Cannot get time locale information: $!";
setlocale(LC_TIME, "C") || die "Cannot setlocale() to C: $!";
}
+if (locales_enabled('LC_CTYPE')) {
+ $orig_ctype_loc = setlocale(LC_CTYPE) || die "Cannot get ctype locale information: $!";
+ setlocale(LC_CTYPE, "C") || die "Cannot setlocale() to C: $!";
+}
my $jan_16 = 15 * 86400;
is(ctime($jan_16), strftime("%a %b %d %H:%M:%S %Y\n", CORE::localtime($jan_16)),
"get ctime() equal to strftime()");
unlike($ss, qr/\w/, 'Still not internally UTF-8 encoded');
if (locales_enabled('LC_TIME')) {
- setlocale(LC_TIME, $orig_loc) || die "Cannot setlocale() back to orig: $!";
+ setlocale(LC_TIME, $orig_time_loc) || die "Cannot setlocale(LC_TIME) back to orig: $!";
+}
+if (locales_enabled('LC_CTYPE')) {
+ setlocale(LC_TIME, $orig_ctype_loc) || die "Cannot setlocale(LC_CTYPE) back to orig: $!";
}
# clock() seems to have different definitions of what it does between POSIX
use strict;
package Tie::Hash::NamedCapture;
-our $VERSION = "0.11";
-
-require XSLoader;
-XSLoader::load(); # This returns true, which makes require happy.
+our $VERSION = "0.13";
__END__
regular expression; the keys of C<%+>-like hashes list only the names of
buffers that have captured (and that are thus associated to defined values).
+This implementation has been moved into the core executable, but you
+can still load this module for backward compatibility.
+
=head1 SEE ALSO
L<perlreapi>, L<re>, L<perlmodlib/Pragmatic Modules>, L<perlvar/"%+">,
+++ /dev/null
-#define PERL_NO_GET_CONTEXT /* we want efficiency */
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-/* These are tightly coupled to the RXapif_* flags defined in regexp.h */
-#define UNDEF_FATAL 0x80000
-#define DISCARD 0x40000
-#define EXPECT_SHIFT 24
-#define ACTION_MASK 0x000FF
-
-#define FETCH_ALIAS (RXapif_FETCH | (2 << EXPECT_SHIFT))
-#define STORE_ALIAS (RXapif_STORE | (3 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
-#define DELETE_ALIAS (RXapif_DELETE | (2 << EXPECT_SHIFT) | UNDEF_FATAL)
-#define CLEAR_ALIAS (RXapif_CLEAR | (1 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
-#define EXISTS_ALIAS (RXapif_EXISTS | (2 << EXPECT_SHIFT))
-#define SCALAR_ALIAS (RXapif_SCALAR | (1 << EXPECT_SHIFT))
-
-MODULE = Tie::Hash::NamedCapture PACKAGE = Tie::Hash::NamedCapture
-PROTOTYPES: DISABLE
-
-void
-_tie_it(SV *sv)
- INIT:
- GV * const gv = (GV *)sv;
- HV * const hv = GvHVn(gv);
- SV *rv = newSV_type(SVt_RV);
- const char *gv_name = GvNAME(gv);
- CODE:
- SvRV_set(rv, newSVuv(
- strEQ(gv_name, "-") || strEQ(gv_name, "\003APTURE_ALL")
- ? RXapif_ALL : RXapif_ONE));
- SvROK_on(rv);
- sv_bless(rv, GvSTASH(CvGV(cv)));
-
- sv_unmagic((SV *)hv, PERL_MAGIC_tied);
- sv_magic((SV *)hv, rv, PERL_MAGIC_tied, NULL, 0);
- SvREFCNT_dec(rv); /* As sv_magic increased it by one. */
-
-SV *
-TIEHASH(package, ...)
- const char *package;
- PREINIT:
- UV flag = RXapif_ONE;
- CODE:
- mark += 2;
- while(mark < sp) {
- STRLEN len;
- const char *p = SvPV_const(*mark, len);
- if(memEQs(p, len, "all"))
- flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE;
- mark += 2;
- }
- RETVAL = newSV_type(SVt_RV);
- sv_setuv(newSVrv(RETVAL, package), flag);
- OUTPUT:
- RETVAL
-
-void
-FETCH(...)
- ALIAS:
- Tie::Hash::NamedCapture::FETCH = FETCH_ALIAS
- Tie::Hash::NamedCapture::STORE = STORE_ALIAS
- Tie::Hash::NamedCapture::DELETE = DELETE_ALIAS
- Tie::Hash::NamedCapture::CLEAR = CLEAR_ALIAS
- Tie::Hash::NamedCapture::EXISTS = EXISTS_ALIAS
- Tie::Hash::NamedCapture::SCALAR = SCALAR_ALIAS
- PREINIT:
- REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- U32 flags;
- SV *ret;
- const U32 action = ix & ACTION_MASK;
- const int expect = ix >> EXPECT_SHIFT;
- PPCODE:
- if (items != expect)
- croak_xs_usage(cv, expect == 2 ? "$key"
- : (expect == 3 ? "$key, $value"
- : ""));
-
- if (!rx || !SvROK(ST(0))) {
- if (ix & UNDEF_FATAL)
- Perl_croak_no_modify();
- else
- XSRETURN_UNDEF;
- }
-
- flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
-
- PUTBACK;
- ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL,
- expect >= 3 ? ST(2) : NULL, flags | action);
- SPAGAIN;
-
- if (ix & DISCARD) {
- /* Called with G_DISCARD, so our return stack state is thrown away.
- Hence if we were returned anything, free it immediately. */
- SvREFCNT_dec(ret);
- } else {
- PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
- }
-
-void
-FIRSTKEY(...)
- ALIAS:
- Tie::Hash::NamedCapture::NEXTKEY = 1
- PREINIT:
- REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
- U32 flags;
- SV *ret;
- const int expect = ix ? 2 : 1;
- const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY;
- PPCODE:
- if (items != expect)
- croak_xs_usage(cv, expect == 2 ? "$lastkey" : "");
-
- if (!rx || !SvROK(ST(0)))
- XSRETURN_UNDEF;
-
- flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
-
- PUTBACK;
- ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx),
- expect >= 2 ? ST(1) : NULL,
- flags | action);
- SPAGAIN;
-
- PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
-
-void
-flags(...)
- PPCODE:
- EXTEND(SP, 2);
- mPUSHu(RXapif_ONE);
- mPUSHu(RXapif_ALL);
use DynaLoader ();
use Exporter ();
-our $VERSION = '2.44';
+our $VERSION = '2.45';
our @ISA = qw( Exporter DynaLoader IO::File );
our @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT
&O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY );
io = sv_2io(fh);
fp = io ? IoOFP(io) : NULL;
iotype = io ? IoTYPE(io) : '\0';
- if (fp == NULL || strchr(">was+-|",iotype) == NULL) {
+ if (fp == NULL || memCHRs(">was+-|",iotype) == NULL) {
set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
}
if (!PerlIO_getname(fp,filespec)) XSRETURN_UNDEF;
struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
IO *io = sv_2io(mysv);
PerlIO *fp = io ? IoOFP(io) : NULL;
- if (fp == NULL || strchr(">was+-|",IoTYPE(io)) == NULL) {
+ if (fp == NULL || memCHRs(">was+-|",IoTYPE(io)) == NULL) {
set_errno(EBADF); set_vaxc_errno(SS$_IVCHAN); XSRETURN_UNDEF;
}
if (PerlIO_getname(fp,devnam) == NULL) { ST(0) = &PL_sv_undef; XSRETURN(1); }
use warnings;
use Carp;
-our $VERSION = '1.04';
+our $VERSION = '1.05';
require XSLoader;
seen_nextstate++;
retop = op_append_list(OP_LIST, retop, newSVOP(OP_CONST, 0,
/* newSVpvf("nextstate:%s:%d", CopFILE(cCOPx(kid)), cCOPx(kid)->cop_line))); */
- newSVpvf("nextstate:%d", cCOPx(kid)->cop_line)));
+ newSVpvf("nextstate:%u", (unsigned int)cCOPx(kid)->cop_line)));
break;
case OP_ARGCHECK: {
UNOP_AUX_item *aux = cUNOP_AUXx(kid)->op_aux;
return $succeeded;
}
-my $min_cont = (isASCII) ? 0x80 : 0xA0;
+my $min_cont = $::lowest_continuation;
my $continuation_shift = (isASCII) ? 6 : 5;
my $continuation_mask = (1 << $continuation_shift) - 1;
-sub isUTF8_CHAR($$) { # Uses first principals to determine if this is legal
- # (Doesn't work if overflows)
- my ($string, $length) = @_;
+sub isUTF8_CHAR($$) { # Uses first principals to determine if this I8 input
+ # is legal. (Doesn't work if overflows)
+ my ($native, $length) = @_;
+ my $i8 = native_to_I8($native);
- # Uses first principals to calculate if $string is legal
+ # Uses first principals to calculate if $i8 is legal
return 0 if $length <= 0;
- my $first = ord substr($string, 0, 1);
+ my $first = ord substr($i8, 0, 1);
# Invariant
return 1 if $length == 1 && $first < $min_cont;
return 0 if $utf8skip != $length;
- # Acuumulate the $code point. The remaining bits in the start byte count
+ # Accumulate the $code point. The remaining bits in the start byte count
# towards it
my $cp = $bits >> $utf8skip;
for my $i (1 .. $length - 1) {
- my $ord = ord substr($string, $i, 1);
+ my $ord = ord substr($i8, $i, 1);
# Wrong if not a continuation
return 0 if $ord < $min_cont || $ord >= 0xC0;
# If the calculated value can be expressed in fewer bytes than were passed
# in, is an illegal overlong. XXX if 'chr' is not working properly, this
# may not be right
- my $chr = chr $cp;
+ my $chr = uni_to_native(chr $cp);
utf8::upgrade($chr);
use bytes;
return 0 if length $chr < $length;
+ # Also, its possible on EBCDIC platforms that have more illegal start
+ # bytes than ASCII ones (like C3, C4) for something to have the same
+ # length but still be overlong. We make sure the first byte isn't smaller
+ # than the first byte of the real representation.
+ return 0 if substr($native, 0, 1) lt substr($chr, 0, 1);
+
return 1;
}
&& $ENV{PERL_DEBUG_FULL_TEST}
&& $ENV{PERL_DEBUG_FULL_TEST} == 97)
{
+ # We construct UTF-8 (I8 on EBCDIC platforms converted later to native)
+
my $min_cont_mask = $min_cont | 0xF;
my @bytes = ( 0, # Placeholder to signify to use an empty string ""
- ord 'A',# We assume that all the invariant characters are
+ 0x41, # We assume that all the invariant characters are
# properly in the same class, so this is an exemplar
# character
$min_cont .. 0xFF # But test every non-invariant individually
);
- my $shift = (isASCII) ? 6 : 5;
my $mark = $min_cont;
- my $mask = (1 << $shift) - 1;
+ my $mask = (1 << $continuation_shift) - 1;
for my $byte1 (@bytes) {
for my $byte2 (@bytes) {
last if $byte2 && ! $byte1; # Don't test empty preceding byte
my $should_be_string;
if ($length == 1) {
- $should_be_string = chr $cp;
+ $should_be_string = native_to_I8(chr $cp);
}
else {
# Starting with the code point, use first
- # principals to find the equivalen UTF-8
- # string
+ # principals to find the equivalent I8 string
my @bytes;
- my $uv = $cp;
+ my $uv = ord native_to_uni(chr $cp);
for (my $i = $length - 1; $i > 0; $i--) {
- $bytes[$i] = chr I8_to_native(($uv & $mask)
- | $mark);
- $uv >>= $shift;
+ $bytes[$i] = chr (($uv & $mask) | $mark);
+ $uv >>= $continuation_shift;
}
- $bytes[0] = chr I8_to_native(( $uv
- & start_mask($length))
+ $bytes[0] = chr ($uv & start_mask($length)
| start_mark($length));
$should_be_string = join "", @bytes;
}
# If the original string and the inverse are the
# same, it worked.
- if (is($native, $should_be_string,
- "utf8n_to_uvchr_msgs("
- . display_bytes($native)
- . ") returns correct uv=0x"
- . sprintf ("%x", $cp)))
- {
+ my $test_name = "utf8n_to_uvchr_msgs("
+ . display_bytes($native)
+ . ") yields "
+ . sprintf ("0x%x", $cp)
+ . "; does its I8 eq original";
+ if (is($should_be_string, $string, $test_name)) {
my $is_surrogate = $cp >= 0xD800
&& $cp <= 0xDFFF;
my $got_surrogate
#define FEATURE_MYREF_BIT 0x0004
#define FEATURE_EVALBYTES_BIT 0x0008
#define FEATURE_FC_BIT 0x0010
-#define FEATURE_POSTDEREF_QQ_BIT 0x0020
-#define FEATURE_REFALIASING_BIT 0x0040
-#define FEATURE_SAY_BIT 0x0080
-#define FEATURE_SIGNATURES_BIT 0x0100
-#define FEATURE_STATE_BIT 0x0200
-#define FEATURE_SWITCH_BIT 0x0400
-#define FEATURE_UNIEVAL_BIT 0x0800
-#define FEATURE_UNICODE_BIT 0x1000
+#define FEATURE_ISA_BIT 0x0020
+#define FEATURE_POSTDEREF_QQ_BIT 0x0040
+#define FEATURE_REFALIASING_BIT 0x0080
+#define FEATURE_SAY_BIT 0x0100
+#define FEATURE_SIGNATURES_BIT 0x0200
+#define FEATURE_STATE_BIT 0x0400
+#define FEATURE_SWITCH_BIT 0x0800
+#define FEATURE_UNIEVAL_BIT 0x1000
+#define FEATURE_UNICODE_BIT 0x2000
#define FEATURE_BUNDLE_DEFAULT 0
#define FEATURE_BUNDLE_510 1
FEATURE_IS_ENABLED_MASK(FEATURE_FC_BIT)) \
)
+#define FEATURE_ISA_IS_ENABLED \
+ ( \
+ CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \
+ FEATURE_IS_ENABLED_MASK(FEATURE_ISA_BIT) \
+ )
+
#define FEATURE_SAY_IS_ENABLED \
( \
(CURRENT_FEATURE_BUNDLE >= FEATURE_BUNDLE_510 && \
}
#endif /* PERL_IN_OP_C */
+#ifdef PERL_IN_MG_C
+
+#define magic_sethint_feature(keysv, keypv, keylen, valsv, valbool) \
+ S_magic_sethint_feature(aTHX_ (keysv), (keypv), (keylen), (valsv), (valbool))
+PERL_STATIC_INLINE void
+S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen,
+ SV *valsv, bool valbool) {
+ if (keysv)
+ keypv = SvPV_const(keysv, keylen);
+
+ if (memBEGINs(keypv, keylen, "feature_")) {
+ const char *subf = keypv + (sizeof("feature_")-1);
+ U32 mask = 0;
+ switch (*subf) {
+ case '_':
+ if (keylen == sizeof("feature___SUB__")-1
+ && memcmp(subf+1, "_SUB__", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE___SUB___BIT;
+ break;
+ }
+ return;
+
+ case 'b':
+ if (keylen == sizeof("feature_bitwise")-1
+ && memcmp(subf+1, "itwise", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_BITWISE_BIT;
+ break;
+ }
+ return;
+
+ case 'e':
+ if (keylen == sizeof("feature_evalbytes")-1
+ && memcmp(subf+1, "valbytes", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_EVALBYTES_BIT;
+ break;
+ }
+ return;
+
+ case 'f':
+ if (keylen == sizeof("feature_fc")-1
+ && memcmp(subf+1, "c", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_FC_BIT;
+ break;
+ }
+ return;
+
+ case 'i':
+ if (keylen == sizeof("feature_isa")-1
+ && memcmp(subf+1, "sa", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_ISA_BIT;
+ break;
+ }
+ return;
+
+ case 'm':
+ if (keylen == sizeof("feature_myref")-1
+ && memcmp(subf+1, "yref", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_MYREF_BIT;
+ break;
+ }
+ return;
+
+ case 'p':
+ if (keylen == sizeof("feature_postderef_qq")-1
+ && memcmp(subf+1, "ostderef_qq", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_POSTDEREF_QQ_BIT;
+ break;
+ }
+ return;
+
+ case 'r':
+ if (keylen == sizeof("feature_refaliasing")-1
+ && memcmp(subf+1, "efaliasing", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_REFALIASING_BIT;
+ break;
+ }
+ return;
+
+ case 's':
+ if (keylen == sizeof("feature_say")-1
+ && memcmp(subf+1, "ay", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_SAY_BIT;
+ break;
+ }
+ else if (keylen == sizeof("feature_signatures")-1
+ && memcmp(subf+1, "ignatures", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_SIGNATURES_BIT;
+ break;
+ }
+ else if (keylen == sizeof("feature_state")-1
+ && memcmp(subf+1, "tate", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_STATE_BIT;
+ break;
+ }
+ else if (keylen == sizeof("feature_switch")-1
+ && memcmp(subf+1, "witch", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_SWITCH_BIT;
+ break;
+ }
+ return;
+
+ case 'u':
+ if (keylen == sizeof("feature_unicode")-1
+ && memcmp(subf+1, "nicode", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_UNICODE_BIT;
+ break;
+ }
+ else if (keylen == sizeof("feature_unieval")-1
+ && memcmp(subf+1, "nieval", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_UNIEVAL_BIT;
+ break;
+ }
+ return;
+
+ default:
+ return;
+ }
+ if (valsv ? SvTRUE(valsv) : valbool)
+ PL_compiling.cop_features |= mask;
+ else
+ PL_compiling.cop_features &= ~mask;
+ }
+}
+#endif /* PERL_IN_MG_C */
+
#endif /* PERL_FEATURE_H_ */
/* ex: set ro: */
C<GV_ADDMULTI> flag, which means to pretend that the GV has been
seen before (i.e., suppress "Used once" warnings).
+=for apidoc Amnh||GV_ADDMULTI
+
=for apidoc gv_init
The old form of C<gv_init_pvn()>. It does not work with UTF-8 strings, as it
case KEY_do : case KEY_dump : case KEY_else : case KEY_elsif :
case KEY_END : case KEY_eq : case KEY_eval :
case KEY_for : case KEY_foreach: case KEY_format: case KEY_ge :
- case KEY_given : case KEY_goto : case KEY_grep :
- case KEY_gt : case KEY_if: case KEY_INIT: case KEY_last: case KEY_le:
- case KEY_local: case KEY_lt: case KEY_m : case KEY_map : case KEY_my:
+ case KEY_given : case KEY_goto : case KEY_grep : case KEY_gt :
+ case KEY_if : case KEY_isa : case KEY_INIT : case KEY_last :
+ case KEY_le : case KEY_local : case KEY_lt : case KEY_m :
+ case KEY_map : case KEY_my:
case KEY_ne : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
case KEY_package: case KEY_print: case KEY_printf:
case KEY_q : case KEY_qq : case KEY_qr : case KEY_qw :
recommended for performance reasons.
=for apidoc Amnh||GV_ADD
+=for apidoc Amnh||GV_NOADD_NOINIT
+=for apidoc Amnh||GV_NOINIT
+=for apidoc Amnh||GV_NOEXPAND
+=for apidoc Amnh||GV_ADDMG
+=for apidoc Amnh||SVf_UTF8
=cut
*/
if (memEQs(name, len, "\005NCODING"))
goto magicalize;
break;
- case '\006':
- if (memEQs(name, len, "\006EATURE_BITS"))
- goto magicalize;
- break;
case '\007': /* $^GLOBAL_PHASE */
if (memEQs(name, len, "\007LOBAL_PHASE"))
goto ro_magicalize;
C<l1> gives the number of bytes in C<s1>.
Returns zero if non-equal, or zero if non-equal.
+=for apidoc Am|bool|memCHRs|"list"|char c
+Returns the position of the first occurence of the byte C<c> in the literal
+string C<"list">, or NULL if C<c> doesn't appear in C<"list">. All bytes are
+treated as unsigned char. Thus this macro can be used to determine if C<c> is
+in a set of particular characters. Unlike L<strchr(3)>, it works even if C<c>
+is C<NUL> (and the set doesn't include C<NUL>).
+
=cut
New macros should use the following conventions for their names (which are
#define memGT(s1,s2,l) (memcmp(s1,s2,l) > 0)
#define memGE(s1,s2,l) (memcmp(s1,s2,l) >= 0)
+#define memCHRs(s1,c) ((const char *) memchr("" s1 "" , c, sizeof(s1)-1))
+
/*
* Character classes.
*
|| (c) == '\f' || (c) == '\n' || (c) == '\r' \
|| (c) == '\t' || (c) == '\v' \
|| inRANGE((c), 1, 3) /* SOH, STX, ETX */ \
- || (c) == 7 /* U+7F DEL */ \
+ || (c) == 7F /* U+7F DEL */ \
|| inRANGE((c), 0x0E, 0x13) /* SO SI DLE \
DC[1-3] */ \
|| (c) == 0x18 /* U+18 CAN */ \
/* To prevent S_scan_word in toke.c from hanging, we have to make sure that
* IDFIRST is an alnum. See
- * https://rt.perl.org/rt3/Ticket/Display.html?id=74022 for more detail than you
+ * https://github.com/Perl/perl5/issues/10275 for more detail than you
* ever wanted to know about. (In the ASCII range, there isn't a difference.)
* This used to be not the XID version, but we decided to go with the more
* modern Unicode definition */
#define isALNUM_uni(c) isWORDCHAR_uni(c)
#define isALNUM_LC_uvchr(c) isWORDCHAR_LC_uvchr(c)
#define isALNUM_utf8(p,e) isWORDCHAR_utf8(p,e)
+#define isALNUM_utf8_safe(p,e) isWORDCHAR_utf8_safe(p,e)
#define isALNUM_LC_utf8(p,e)isWORDCHAR_LC_utf8(p,e)
+#define isALNUM_LC_utf8_safe(p,e)isWORDCHAR_LC_utf8_safe(p,e)
#define isALNUMC_A(c) isALPHANUMERIC_A(c) /* Mnemonic: "C's alnum" */
#define isALNUMC_L1(c) isALPHANUMERIC_L1(c)
#define isALNUMC(c) isALPHANUMERIC(c)
#define isALNUMC_uni(c) isALPHANUMERIC_uni(c)
#define isALNUMC_LC_uvchr(c) isALPHANUMERIC_LC_uvchr(c)
#define isALNUMC_utf8(p,e) isALPHANUMERIC_utf8(p,e)
-#define isALNUMC_LC_utf8(p,e) isALPHANUMERIC_LC_utf8(p,e)
+#define isALNUMC_utf8_safe(p,e) isALPHANUMERIC_utf8_safe(p,e)
+#define isALNUMC_LC_utf8_safe(p,e) isALPHANUMERIC_LC_utf8_safe(p,e)
/* On EBCDIC platforms, CTRL-@ is 0, CTRL-A is 1, etc, just like on ASCII,
* except that they don't necessarily mean the same characters, e.g. CTRL-D is
# mkdir -p /opt/perl-catamount
# mkdir -p /opt/perl-catamount/include
# mkdir -p /opt/perl-catamount/lib
-# mkdir -p /opt/perl-catamount/lib/perl5/5.31.6
+# mkdir -p /opt/perl-catamount/lib/perl5/5.31.7
# mkdir -p /opt/perl-catamount/bin
# cp *.h /opt/perl-catamount/include
# cp libperl.a /opt/perl-catamount/lib
-# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.31.6
+# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.31.7
# cp miniperl perl run.sh cc.sh /opt/perl-catamount/lib
#
# With the headers and the libperl.a you can embed Perl to your Catamount
d_uselocale='undef'
fi
-# https://rt.perl.org/Ticket/Display.html?id=131337
+# https://github.com/Perl/perl5/issues/15984
# Reported in 11.0-CURRENT with g++-4.8.5:
# If using g++, the Configure scan for dlopen() fails.
# Easier for now to just to forcibly set it.
# > cc --version
# cc: HP C/aC++ B3910B A.06.15 [May 16 2007]
# Has optimizing problems with +O2 for blead (5.17.4),
- # see https://rt.perl.org:443/rt3/Ticket/Display.html?id=103668.
+ # see https://github.com/Perl/perl5/issues/11748.
#
# +O2 +Onolimit +Onoprocelim +Ostore_ordering \
# +Onolibcalls=strcmp
`
case "$cc" in
-'') for i in `ls -r /opt/sol*studio*/bin/cc` /opt/SUNWspro/bin/cc
+'') for i in `ls -r /opt/*studio*/bin/cc` /opt/SUNWspro/bin/cc
do
if test -f "$i"; then
cc=$i
restricted hashes may change, and the implementation currently is
insufficiently abstracted for any change to be tidy.
+=for apidoc Amnh||HV_ITERNEXT_WANTPLACEHOLDERS
+
=cut
*/
=back
+=for apidoc Amnh||PERL_EXIT_EXPECTED
+=for apidoc Amnh||PERL_EXIT_ABORT
+=for apidoc Amnh||PERL_EXIT_DESTRUCT_END
+=for apidoc Amnh||PERL_EXIT_WARN
+
=cut
*/
PERLVARA(I, TR_SPECIAL_HANDLING_UTF8, UTF8_MAXBYTES, char)
+PERLVAR(I, AboveLatin1, SV *)
+PERLVAR(I, Assigned_invlist, SV *)
+PERLVAR(I, GCB_invlist, SV *)
+PERLVAR(I, HasMultiCharFold, SV *)
+PERLVAR(I, InMultiCharFold, SV *)
+PERLVAR(I, Latin1, SV *)
+PERLVAR(I, LB_invlist, SV *)
+PERLVAR(I, SB_invlist, SV *)
+PERLVAR(I, SCX_invlist, SV *)
+PERLVAR(I, UpperLatin1, SV *) /* Code points 128 - 255 */
+
+/* List of characters that participate in any fold defined by Unicode */
+PERLVAR(I, in_some_fold, SV *)
+
+PERLVAR(I, utf8_idcont, SV *)
+PERLVAR(I, utf8_idstart, SV *)
+PERLVAR(I, utf8_perl_idcont, SV *)
+PERLVAR(I, utf8_perl_idstart, SV *)
+PERLVAR(I, utf8_xidcont, SV *)
+PERLVAR(I, utf8_xidstart, SV *)
+PERLVAR(I, WB_invlist, SV *)
+PERLVARA(I, XPosix_ptrs, POSIX_CC_COUNT, SV *)
+PERLVARA(I, Posix_ptrs, POSIX_CC_COUNT, SV *)
+PERLVAR(I, utf8_toupper, SV *)
+PERLVAR(I, utf8_totitle, SV *)
+PERLVAR(I, utf8_tolower, SV *)
+PERLVAR(I, utf8_tofold, SV *)
+PERLVAR(I, utf8_tosimplefold, SV *)
+PERLVAR(I, utf8_charname_begin, SV *)
+PERLVAR(I, utf8_charname_continue, SV *)
+PERLVAR(I, utf8_mark, SV *)
+PERLVARI(I, InBitmap, SV *, NULL)
+PERLVAR(I, CCC_non0_non230, SV *)
+PERLVAR(I, Private_Use, SV *)
+
/* If you are adding a U8 or U16, check to see if there are 'Space' comments
* above on where there are gaps which currently will be structure padding. */
: array[len - 1] - 1;
}
+#endif
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C)
+
PERL_STATIC_INLINE STRLEN*
S_get_invlist_iter_addr(SV* invlist)
{
goto unknown;
}
- case 3: /* 28 tokens of length 3 */
+ case 3: /* 29 tokens of length 3 */
switch (name[0])
{
case 'E':
goto unknown;
case 'i':
- if (name[1] == 'n' &&
- name[2] == 't')
- { /* int */
- return -KEY_int;
- }
+ switch (name[1])
+ {
+ case 'n':
+ if (name[2] == 't')
+ { /* int */
+ return -KEY_int;
+ }
- goto unknown;
+ goto unknown;
+
+ case 's':
+ if (name[2] == 'a')
+ { /* isa */
+ return (all_keywords || FEATURE_ISA_IS_ENABLED ? -KEY_isa : 0);
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
case 'l':
if (name[1] == 'o' &&
}
/* Generated from:
- * db0472e0ad4f44bd0816cad799d63b60d1bbd7e11cef40ea15bf0d00f69669f6 regen/keywords.pl
+ * f77998a5bc995c1b42d3d080de227ef5f11638bcd329367431d8f193aef2d3cc regen/keywords.pl
* ex: set ro: */
#define KEY_index 107
#define KEY_int 108
#define KEY_ioctl 109
-#define KEY_join 110
-#define KEY_keys 111
-#define KEY_kill 112
-#define KEY_last 113
-#define KEY_lc 114
-#define KEY_lcfirst 115
-#define KEY_le 116
-#define KEY_length 117
-#define KEY_link 118
-#define KEY_listen 119
-#define KEY_local 120
-#define KEY_localtime 121
-#define KEY_lock 122
-#define KEY_log 123
-#define KEY_lstat 124
-#define KEY_lt 125
-#define KEY_m 126
-#define KEY_map 127
-#define KEY_mkdir 128
-#define KEY_msgctl 129
-#define KEY_msgget 130
-#define KEY_msgrcv 131
-#define KEY_msgsnd 132
-#define KEY_my 133
-#define KEY_ne 134
-#define KEY_next 135
-#define KEY_no 136
-#define KEY_not 137
-#define KEY_oct 138
-#define KEY_open 139
-#define KEY_opendir 140
-#define KEY_or 141
-#define KEY_ord 142
-#define KEY_our 143
-#define KEY_pack 144
-#define KEY_package 145
-#define KEY_pipe 146
-#define KEY_pop 147
-#define KEY_pos 148
-#define KEY_print 149
-#define KEY_printf 150
-#define KEY_prototype 151
-#define KEY_push 152
-#define KEY_q 153
-#define KEY_qq 154
-#define KEY_qr 155
-#define KEY_quotemeta 156
-#define KEY_qw 157
-#define KEY_qx 158
-#define KEY_rand 159
-#define KEY_read 160
-#define KEY_readdir 161
-#define KEY_readline 162
-#define KEY_readlink 163
-#define KEY_readpipe 164
-#define KEY_recv 165
-#define KEY_redo 166
-#define KEY_ref 167
-#define KEY_rename 168
-#define KEY_require 169
-#define KEY_reset 170
-#define KEY_return 171
-#define KEY_reverse 172
-#define KEY_rewinddir 173
-#define KEY_rindex 174
-#define KEY_rmdir 175
-#define KEY_s 176
-#define KEY_say 177
-#define KEY_scalar 178
-#define KEY_seek 179
-#define KEY_seekdir 180
-#define KEY_select 181
-#define KEY_semctl 182
-#define KEY_semget 183
-#define KEY_semop 184
-#define KEY_send 185
-#define KEY_setgrent 186
-#define KEY_sethostent 187
-#define KEY_setnetent 188
-#define KEY_setpgrp 189
-#define KEY_setpriority 190
-#define KEY_setprotoent 191
-#define KEY_setpwent 192
-#define KEY_setservent 193
-#define KEY_setsockopt 194
-#define KEY_shift 195
-#define KEY_shmctl 196
-#define KEY_shmget 197
-#define KEY_shmread 198
-#define KEY_shmwrite 199
-#define KEY_shutdown 200
-#define KEY_sin 201
-#define KEY_sleep 202
-#define KEY_socket 203
-#define KEY_socketpair 204
-#define KEY_sort 205
-#define KEY_splice 206
-#define KEY_split 207
-#define KEY_sprintf 208
-#define KEY_sqrt 209
-#define KEY_srand 210
-#define KEY_stat 211
-#define KEY_state 212
-#define KEY_study 213
-#define KEY_sub 214
-#define KEY_substr 215
-#define KEY_symlink 216
-#define KEY_syscall 217
-#define KEY_sysopen 218
-#define KEY_sysread 219
-#define KEY_sysseek 220
-#define KEY_system 221
-#define KEY_syswrite 222
-#define KEY_tell 223
-#define KEY_telldir 224
-#define KEY_tie 225
-#define KEY_tied 226
-#define KEY_time 227
-#define KEY_times 228
-#define KEY_tr 229
-#define KEY_truncate 230
-#define KEY_uc 231
-#define KEY_ucfirst 232
-#define KEY_umask 233
-#define KEY_undef 234
-#define KEY_unless 235
-#define KEY_unlink 236
-#define KEY_unpack 237
-#define KEY_unshift 238
-#define KEY_untie 239
-#define KEY_until 240
-#define KEY_use 241
-#define KEY_utime 242
-#define KEY_values 243
-#define KEY_vec 244
-#define KEY_wait 245
-#define KEY_waitpid 246
-#define KEY_wantarray 247
-#define KEY_warn 248
-#define KEY_when 249
-#define KEY_while 250
-#define KEY_write 251
-#define KEY_x 252
-#define KEY_xor 253
-#define KEY_y 254
+#define KEY_isa 110
+#define KEY_join 111
+#define KEY_keys 112
+#define KEY_kill 113
+#define KEY_last 114
+#define KEY_lc 115
+#define KEY_lcfirst 116
+#define KEY_le 117
+#define KEY_length 118
+#define KEY_link 119
+#define KEY_listen 120
+#define KEY_local 121
+#define KEY_localtime 122
+#define KEY_lock 123
+#define KEY_log 124
+#define KEY_lstat 125
+#define KEY_lt 126
+#define KEY_m 127
+#define KEY_map 128
+#define KEY_mkdir 129
+#define KEY_msgctl 130
+#define KEY_msgget 131
+#define KEY_msgrcv 132
+#define KEY_msgsnd 133
+#define KEY_my 134
+#define KEY_ne 135
+#define KEY_next 136
+#define KEY_no 137
+#define KEY_not 138
+#define KEY_oct 139
+#define KEY_open 140
+#define KEY_opendir 141
+#define KEY_or 142
+#define KEY_ord 143
+#define KEY_our 144
+#define KEY_pack 145
+#define KEY_package 146
+#define KEY_pipe 147
+#define KEY_pop 148
+#define KEY_pos 149
+#define KEY_print 150
+#define KEY_printf 151
+#define KEY_prototype 152
+#define KEY_push 153
+#define KEY_q 154
+#define KEY_qq 155
+#define KEY_qr 156
+#define KEY_quotemeta 157
+#define KEY_qw 158
+#define KEY_qx 159
+#define KEY_rand 160
+#define KEY_read 161
+#define KEY_readdir 162
+#define KEY_readline 163
+#define KEY_readlink 164
+#define KEY_readpipe 165
+#define KEY_recv 166
+#define KEY_redo 167
+#define KEY_ref 168
+#define KEY_rename 169
+#define KEY_require 170
+#define KEY_reset 171
+#define KEY_return 172
+#define KEY_reverse 173
+#define KEY_rewinddir 174
+#define KEY_rindex 175
+#define KEY_rmdir 176
+#define KEY_s 177
+#define KEY_say 178
+#define KEY_scalar 179
+#define KEY_seek 180
+#define KEY_seekdir 181
+#define KEY_select 182
+#define KEY_semctl 183
+#define KEY_semget 184
+#define KEY_semop 185
+#define KEY_send 186
+#define KEY_setgrent 187
+#define KEY_sethostent 188
+#define KEY_setnetent 189
+#define KEY_setpgrp 190
+#define KEY_setpriority 191
+#define KEY_setprotoent 192
+#define KEY_setpwent 193
+#define KEY_setservent 194
+#define KEY_setsockopt 195
+#define KEY_shift 196
+#define KEY_shmctl 197
+#define KEY_shmget 198
+#define KEY_shmread 199
+#define KEY_shmwrite 200
+#define KEY_shutdown 201
+#define KEY_sin 202
+#define KEY_sleep 203
+#define KEY_socket 204
+#define KEY_socketpair 205
+#define KEY_sort 206
+#define KEY_splice 207
+#define KEY_split 208
+#define KEY_sprintf 209
+#define KEY_sqrt 210
+#define KEY_srand 211
+#define KEY_stat 212
+#define KEY_state 213
+#define KEY_study 214
+#define KEY_sub 215
+#define KEY_substr 216
+#define KEY_symlink 217
+#define KEY_syscall 218
+#define KEY_sysopen 219
+#define KEY_sysread 220
+#define KEY_sysseek 221
+#define KEY_system 222
+#define KEY_syswrite 223
+#define KEY_tell 224
+#define KEY_telldir 225
+#define KEY_tie 226
+#define KEY_tied 227
+#define KEY_time 228
+#define KEY_times 229
+#define KEY_tr 230
+#define KEY_truncate 231
+#define KEY_uc 232
+#define KEY_ucfirst 233
+#define KEY_umask 234
+#define KEY_undef 235
+#define KEY_unless 236
+#define KEY_unlink 237
+#define KEY_unpack 238
+#define KEY_unshift 239
+#define KEY_untie 240
+#define KEY_until 241
+#define KEY_use 242
+#define KEY_utime 243
+#define KEY_values 244
+#define KEY_vec 245
+#define KEY_wait 246
+#define KEY_waitpid 247
+#define KEY_wantarray 248
+#define KEY_warn 249
+#define KEY_when 250
+#define KEY_while 251
+#define KEY_write 252
+#define KEY_x 253
+#define KEY_xor 254
+#define KEY_y 255
/* Generated from:
- * db0472e0ad4f44bd0816cad799d63b60d1bbd7e11cef40ea15bf0d00f69669f6 regen/keywords.pl
+ * f77998a5bc995c1b42d3d080de227ef5f11638bcd329367431d8f193aef2d3cc regen/keywords.pl
* ex: set ro: */
use strict;
use Test::More;
-plan tests => 3886;
+plan tests => 3904;
use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
# logic to add CORE::
my $desc = "$keyword: lex=$lex $expr => $expected_expr";
$desc .= " (lex sub)" if $lexsub;
-
my $code;
my $code_ref;
if ($lexsub) {
package lexsubtest;
- no warnings 'experimental::lexical_subs';
+ no warnings 'experimental::lexical_subs', 'experimental::isa';
use feature 'lexical_subs';
no strict 'vars';
$code = "sub { state sub $keyword; ${vars}() = $expr }";
+ $code = "use feature 'isa';\n$code" if $keyword eq "isa";
$code_ref = eval $code
or die "$@ in $expr";
}
else {
package test;
+ no warnings 'experimental::isa';
use subs ();
import subs $keyword;
$code = "no strict 'vars'; sub { ${vars}() = $expr }";
+ $code = "use feature 'isa';\n$code" if $keyword eq "isa";
$code_ref = eval $code
or die "$@ in $expr";
}
index 23 p
int 01 $
ioctl 3 p
+isa B -
join 13 p
# keys handled specially
kill 123 p
MDEREF_SHIFT
);
-$VERSION = '1.51';
+$VERSION = '1.52';
use strict;
our $AUTOLOAD;
use warnings ();
sub pp_sle { binop(@_, "le", 15) }
sub pp_scmp { maybe_targmy(@_, \&binop, "cmp", 14) }
+sub pp_isa { binop(@_, "isa", 15) }
+
sub pp_sassign { binop(@_, "=", 7, SWAP_CHILDREN) }
sub pp_aassign { binop(@_, "=", 7, SWAP_CHILDREN | LIST_CONTEXT) }
our %bits;
-our $VERSION = "5.031006";
+our $VERSION = "5.031007";
$bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv);
$bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv);
@{$bits{index}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{int}{0} = $bf[0];
@{$bits{ioctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
+@{$bits{isa}}{1,0} = ($bf[1], $bf[1]);
@{$bits{join}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{keys}{0} = $bf[0];
@{$bits{kill}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
package English;
-our $VERSION = '1.10';
+our $VERSION = '1.11';
require Exporter;
@ISA = qw(Exporter);
use English;
use English qw( -no_match_vars ) ; # Avoids regex performance
- # penalty in perl 5.16 and
+ # penalty in perl 5.18 and
# earlier
...
if ($ERRNO =~ /denied/) { ... }
use warnings;
use warnings::register;
use Carp;
+use constant _IS_CYGWIN => $^O eq "cygwin";
BEGIN { *warnif = \&warnings::warnif }
our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
-our $VERSION = '1.08';
+our $VERSION = '1.09';
our @fields;
our ( $st_dev, $st_ino, $st_mode,
# This code basically assumes that the rwx bits of the mode are
# the 0777 bits, but so does Perl_cando.
- if ($uid == 0 && $^O ne "VMS") {
+ if (_IS_CYGWIN ? _ingroup(544, $eff) : ($uid == 0 && $^O ne "VMS")) {
# If we're root on unix
# not testing for executable status => all file tests are true
return 1 if !($mode & 0111);
package feature;
-our $VERSION = '1.56';
+our $VERSION = '1.57';
our %feature = (
fc => 'feature_fc',
+ isa => 'feature_isa',
say => 'feature_say',
state => 'feature_state',
switch => 'feature_switch',
unicode_strings => 'feature_unicode',
);
-
-my %feature_bits = (
- bitwise => 0x0001,
- current_sub => 0x0002,
- declared_refs => 0x0004,
- evalbytes => 0x0008,
- fc => 0x0010,
- postderef_qq => 0x0020,
- refaliasing => 0x0040,
- say => 0x0080,
- signatures => 0x0100,
- state => 0x0200,
- switch => 0x0400,
- unicode_eval => 0x0800,
- unicode_strings => 0x1000,
-);
-
our %feature_bundle = (
"5.10" => [qw(say state switch)],
"5.11" => [qw(say state switch unicode_strings)],
"5.15" => [qw(current_sub evalbytes fc say state switch unicode_eval unicode_strings)],
"5.23" => [qw(current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
"5.27" => [qw(bitwise current_sub evalbytes fc postderef_qq say state switch unicode_eval unicode_strings)],
- "all" => [qw(bitwise current_sub declared_refs evalbytes fc postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
+ "all" => [qw(bitwise current_sub declared_refs evalbytes fc isa postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)],
"default" => [qw()],
);
This feature is available from Perl 5.26 onwards.
+=head2 The 'isa' feature
+
+This allows the use of the C<isa> infix operator, which tests whether the
+scalar given by the left operand is an object of the class given by the
+right operand. See L<perlop/Class Instance Operator> for more details.
+
+This feature is available from Perl 5.32 onwards.
+
=head1 FEATURE BUNDLES
It's possible to load multiple features together, using
my $bundle_number = $^H & $hint_mask;
my $features = $bundle_number != $hint_mask
&& $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
- my $bits = ${^FEATURE_BITS};
if ($features) {
# Features are enabled implicitly via bundle hints.
# Delete any keys that may be left over from last time.
delete @^H{ values(%feature) };
- $bits = 0;
$^H |= $hint_mask;
for (@$features) {
$^H{$feature{$_}} = 1;
- $bits |= $feature_bits{$_};
$^H |= $hint_uni8bit if $_ eq 'unicode_strings';
}
}
}
if ($import) {
$^H{$feature{$name}} = 1;
- $bits |= $feature_bits{$name};
$^H |= $hint_uni8bit if $name eq 'unicode_strings';
} else {
delete $^H{$feature{$name}};
- $bits &= ~$feature_bits{$name};
$^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
}
}
- ${^FEATURE_BITS} = $bits;
}
sub unknown_feature {
with C<"In">, so it's quite possible that a conflict will occur in the future.
The compound form is guaranteed to not become obsolete, and its meaning is
clearer anyway. See L<perlunicode/"Blocks"> for more information about this.
+
+User-defined properties must begin with "In" or "Is". These override any
+Unicode property of the same name.
END
}
my $text = $Is_flags_text;
# 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
# 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
# 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
-# 08071cd168b1ac72bf01f13a82c4d0470a391e2bdd0b706e9fe20ab17cc861c8 lib/unicore/mktables
+# 498da0b9ef6a52bfd71bda5771005bbe4cfc37b456d9d350cd840991eb80c8b1 lib/unicore/mktables
# a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
# 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
# e9283c761c5a95e3379384ca47c13a284f08d743c2be6e5091f1152b1b6b7a37 regen/mk_PL_charclass.pl
-# 74442760b048f85cf5e9e87c3baffc94e861ba397dda0d33f4c22b40ef7efbe6 regen/mk_invlists.pl
+# bddfa92837a1e11b3c74c80512e0492dc325a15ee9e2d768f246ddb3ef3bcef9 regen/mk_invlists.pl
# ex: set ro:
package warnings;
-our $VERSION = "1.45";
+our $VERSION = "1.46";
# Verify that we're called correctly so that warnings will work.
# Can't use Carp, since Carp uses us!
'experimental::private_use' => 140,
'experimental::uniprop_wildcards' => 142,
'experimental::vlb' => 144,
+
+ # Warnings Categories added in Perl 5.031
+ 'experimental::isa' => 146,
);
our %Bits = (
'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x51\x15\x50\x51\x01", # [51..56,58..62,66..68,70..72]
+ 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55\x51\x15\x50\x51\x05", # [51..56,58..62,66..68,70..73]
'experimental::alpha_assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [67]
'experimental::bitwise' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [58]
'experimental::const_attr' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [59]
'experimental::declared_refs' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [66]
+ 'experimental::isa' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [73]
'experimental::lexical_subs' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [52]
'experimental::postderef' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00", # [55]
'experimental::private_use' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [70]
'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [31]
'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\xa2\x2a\xa0\xa2\x02", # [51..56,58..62,66..68,70..72]
+ 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa\xa2\x2a\xa0\xa2\x0a", # [51..56,58..62,66..68,70..73]
'experimental::alpha_assertions' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [67]
'experimental::bitwise' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [58]
'experimental::const_attr' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [59]
'experimental::declared_refs' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [66]
+ 'experimental::isa' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [73]
'experimental::lexical_subs' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [52]
'experimental::postderef' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00", # [55]
'experimental::private_use' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [70]
# These are used by various things, including our own tests
our $NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-our $DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x51\x55\x50\x51\x01", # [2,4,22,23,25,52..56,58..63,66..68,70..72]
-our $LAST_BIT = 146 ;
+our $DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55\x51\x55\x50\x51\x05", # [2,4,22,23,25,52..56,58..63,66..68,70..73]
+our $LAST_BIT = 148 ;
our $BYTES = 19 ;
sub Croaker
| |
| +- experimental::declared_refs
| |
+ | +- experimental::isa
+ | |
| +- experimental::lexical_subs
| |
| +- experimental::postderef
* known at compile time; "do_setlocale_r", not known until run time */
# define do_setlocale_c(cat, locale) my_setlocale(cat, locale)
# define do_setlocale_r(cat, locale) my_setlocale(cat, locale)
+# define FIX_GLIBC_LC_MESSAGES_BUG(i)
#else /* Below uses POSIX 2008 */
emulate_setlocale(cat, locale, cat ## _INDEX, TRUE)
# define do_setlocale_r(cat, locale) emulate_setlocale(cat, locale, 0, FALSE)
+# if ! defined(__GLIBC__) || ! defined(USE_LOCALE_MESSAGES)
+
+# define FIX_GLIBC_LC_MESSAGES_BUG(i)
+
+# else /* Invalidate glibc cache of loaded translations, see [perl #134264] */
+
+# include <libintl.h>
+# define FIX_GLIBC_LC_MESSAGES_BUG(i) \
+ STMT_START { \
+ if ((i) == LC_MESSAGES_INDEX) { \
+ textdomain(textdomain(NULL)); \
+ } \
+ } STMT_END
+
+# endif
+
/* A third array, parallel to the ones above to map from category to its
* equivalent mask */
const int category_masks[] = {
Safefree(PL_curlocales[i]);
PL_curlocales[i] = savepv(locale);
}
+
+ FIX_GLIBC_LC_MESSAGES_BUG(LC_MESSAGES_INDEX);
}
else {
/* Then update the category's record */
Safefree(PL_curlocales[index]);
PL_curlocales[index] = savepv(locale);
+
+ FIX_GLIBC_LC_MESSAGES_BUG(index);
}
# endif
"isxdigit('%s') unexpectedly is %d\n",
name, cBOOL(isxdigit(i))));
}
- if (UNLIKELY(tolower(i) != (int) toLOWER_A(i))) {
+ if (UNLIKELY(tolower(i) != (int) toLOWER_A(i))) {
is_bad = TRUE;
DEBUG_L(PerlIO_printf(Perl_debug_log,
"tolower('%s')=0x%x instead of the expected 0x%x\n",
name, tolower(i), (int) toLOWER_A(i)));
}
- if (UNLIKELY(toupper(i) != (int) toUPPER_A(i))) {
+ if (UNLIKELY(toupper(i) != (int) toUPPER_A(i))) {
is_bad = TRUE;
DEBUG_L(PerlIO_printf(Perl_debug_log,
"toupper('%s')=0x%x instead of the expected 0x%x\n",
Safefree(save_locale);
}
-# elif defined(HAS_POSIX_2008_LOCALE) \
- && defined(HAS_STRERROR_L) \
- && defined(HAS_DUPLOCALE)
+# elif defined(USE_POSIX_2008_LOCALE) \
+ && defined(HAS_STRERROR_L) \
+ && defined(HAS_DUPLOCALE)
/* This function is also trivial if we don't have to worry about thread
* safety and have strerror_l(), as it handles the switch of locales so we
* Symbols should only be here temporarily. Once they are actually used,
* they should be removed from here.
*
- * HAS_BUILTIN_ADD_OVERFLOW
- * HAS_BUILTIN_MUL_OVERFLOW
- * HAS_BUILTIN_SUB_OVERFLOW
- * HAS_LOCALECONV_L
- * HAS_MBRLEN
- * HAS_MBRTOWC
- * HAS_NANOSLEEP
- * HAS_STRTOD_L
- * HAS_STRTOLD_L
- * I_WCHAR
- * I_WCTYPE
- * HAS_TOWLOWER
- * HAS_TOWUPPER
- * SETLOCALE_ACCEPTS_ANY_LOCALE_NAME
+ * HAS_WCRTOMB
*/
#include "EXTERN.h"
#define PERL_IN_MG_C
#include "perl.h"
+#include "feature.h"
#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
# ifdef I_GRP
if (nextchar == '\0') {
sv_setiv(sv, (IV)PL_maxsysfd);
}
- else if (strEQ(remaining, "EATURE_BITS")) {
- sv_setuv(sv, PL_compiling.cop_features);
- }
break;
case '\007': /* ^GLOBAL_PHASE */
if (strEQ(remaining, "LOBAL_PHASE")) {
if (mg->mg_ptr[1] == '\0') {
PL_maxsysfd = SvIV(sv);
}
- else if (strEQ(mg->mg_ptr + 1, "EATURE_BITS")) {
- PL_compiling.cop_features = SvUV(sv);
- }
break;
case '\010': /* ^H */
{
PL_hints |= HINT_LOCALIZE_HH;
CopHINTHASH_set(&PL_compiling,
cophh_store_sv(CopHINTHASH_get(&PL_compiling), key, 0, sv, 0));
+ magic_sethint_feature(key, NULL, 0, sv, 0);
return 0;
}
MUTABLE_SV(mg->mg_ptr), 0, 0)
: cophh_delete_pvn(CopHINTHASH_get(&PL_compiling),
mg->mg_ptr, mg->mg_len, 0, 0));
+ if (mg->mg_len == HEf_SVKEY)
+ magic_sethint_feature(MUTABLE_SV(mg->mg_ptr), NULL, 0, NULL, FALSE);
+ else
+ magic_sethint_feature(NULL, mg->mg_ptr, mg->mg_len, NULL, FALSE);
return 0;
}
PERL_UNUSED_ARG(mg);
cophh_free(CopHINTHASH_get(&PL_compiling));
CopHINTHASH_set(&PL_compiling, cophh_new_empty());
+ CLEARFEATUREBITS();
return 0;
}
s++;
flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
+ if (s == send) {
+ return flags;
+ }
/* NaN can be followed by various stuff (NaNQ, NaNS), but
* there are also multiple different NaN values, and some
/* "nanq" or "nans" are ok, though generating
* these portably is tricky. */
s++;
+ if (s == send) {
+ return flags;
+ }
}
if (*s == '(') {
/* C99 style "nan(123)" or Perlish equivalent "nan($uv)". */
return IS_NUMBER_IN_UV;
}
/* We could be e.g. at "Inf" or "NaN", or at the "#" of "1.#INF". */
- if ((s + 2 < send) && strchr("inqs#", toFOLD(*s))) {
+ if ((s + 2 < send) && memCHRs("inqs#", toFOLD(*s))) {
/* Really detect inf/nan. Start at d, not s, since the above
* code might have already consumed the "1." or "1". */
const int infnan = Perl_grok_infnan(aTHX_ &d, send);
}
/*
-=for apidoc
+=for apidoc isinfnansv
Checks whether the argument would be either an infinity or C<NaN> when used
as a number, but is careful not to trigger non-numeric or uninitialized
if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
&& isASCII(name[1])
- && (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
+ && (!isPRINT(name[1]) || memCHRs("\t\n\r\f", name[1]))) {
/* diag_listed_as: Can't use global %s in %s */
yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in %s",
name[0], toCTRL(name[1]),
bool sigil = FALSE;
/* some heuristics to detect a potential error */
- while (*s && (strchr(", \t\n", *s)))
+ while (*s && (memCHRs(", \t\n", *s)))
s++;
while (1) {
- if (*s && (strchr("@$%", *s) || (!lex && *s == '*'))
+ if (*s && (memCHRs("@$%", *s) || (!lex && *s == '*'))
&& *++s
&& (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
s++;
sigil = TRUE;
while (*s && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s)))
s++;
- while (*s && (strchr(", \t\n", *s)))
+ while (*s && (memCHRs(", \t\n", *s)))
s++;
}
else
child of the unary op; it is consumed by this function and become part
of the constructed op tree.
+=for apidoc Amnh||OPf_KIDS
+
=cut
*/
is_compiletime = 1;
has_code = 0;
if (expr->op_type == OP_LIST) {
- OP *o;
- for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) {
- if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) {
- has_code = 1;
- assert(!o->op_next);
- if (UNLIKELY(!OpHAS_SIBLING(o))) {
- assert(PL_parser && PL_parser->error_count);
- /* This can happen with qr/ (?{(^{})/. Just fake up
- the op we were expecting to see, to avoid crashing
- elsewhere. */
- op_sibling_splice(expr, o, 0,
- newSVOP(OP_CONST, 0, &PL_sv_no));
- }
- o->op_next = OpSIBLING(o);
- }
- else if (o->op_type != OP_CONST && o->op_type != OP_PUSHMARK)
- is_compiletime = 0;
- }
+ OP *this_o;
+ for (this_o = cLISTOPx(expr)->op_first; this_o; this_o = OpSIBLING(this_o)) {
+ if (this_o->op_type == OP_NULL && (this_o->op_flags & OPf_SPECIAL)) {
+ has_code = 1;
+ assert(!this_o->op_next);
+ if (UNLIKELY(!OpHAS_SIBLING(this_o))) {
+ assert(PL_parser && PL_parser->error_count);
+ /* This can happen with qr/ (?{(^{})/. Just fake up
+ the op we were expecting to see, to avoid crashing
+ elsewhere. */
+ op_sibling_splice(expr, this_o, 0,
+ newSVOP(OP_CONST, 0, &PL_sv_no));
+ }
+ this_o->op_next = OpSIBLING(this_o);
+ }
+ else if (this_o->op_type != OP_CONST && this_o->op_type != OP_PUSHMARK)
+ is_compiletime = 0;
+ }
}
else if (expr->op_type != OP_CONST)
is_compiletime = 0;
If C<PERL_LOADMOD_DENY> is set, the module is loaded as if with C<no> rather
than C<use>.
+=for apidoc Amnh||PERL_LOADMOD_DENY
+=for apidoc Amnh||PERL_LOADMOD_NOIMPORT
+=for apidoc Amnh||PERL_LOADMOD_IMPORT_OPS
+
=cut */
void
(void)CvGV(cv);
if (floor) LEAVE_SCOPE(floor);
ENTER;
+
+ SAVEVPTR(PL_curcop);
+ if (PL_curcop == &PL_compiling) {
+ /* Avoid pushing the "global" &PL_compiling onto the
+ * context stack. For example, a stack trace inside
+ * nested use's would show all calls coming from whoever
+ * most recently updated PL_compiling.cop_file and
+ * cop_line. So instead, temporarily set PL_curcop to a
+ * private copy of &PL_compiling. PL_curcop will soon be
+ * set to point back to &PL_compiling anyway but only
+ * after the temp value has been pushed onto the context
+ * stack as blk_oldcop.
+ * This is slightly hacky, but necessary. Note also
+ * that in the brief window before PL_curcop is set back
+ * to PL_compiling, IN_PERL_COMPILETIME/IN_PERL_RUNTIME
+ * will give the wrong answer.
+ */
+ Newx(PL_curcop, 1, COP);
+ StructCopy(&PL_compiling, PL_curcop, COP);
+ PL_curcop->op_slabbed = 0;
+ SAVEFREEPV(PL_curcop);
+ }
+
PUSHSTACKi(PERLSI_REQUIRE);
SAVECOPFILE(&PL_compiling);
SAVECOPLINE(&PL_compiling);
- SAVEVPTR(PL_curcop);
DEBUG_x( dump_sub(gv) );
Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
A null pointer is returned as usual if there is no statically-determinable
subroutine.
+=for apidoc Amnh||OPpEARLY_CV
+=for apidoc Amnh||OPpENTERSUB_AMPER
+=for apidoc Amnh||RV2CVOPCV_MARK_EARLY
+=for apidoc Amnh||RV2CVOPCV_RETURN_NAME_GV
+
=cut
*/
continue;
case '_':
/* _ must be at the end */
- if (proto[1] && !strchr(";@%", proto[1]))
+ if (proto[1] && !memCHRs(";@%", proto[1]))
goto oops;
/* FALLTHROUGH */
case '$':
only the C<CALL_CHECKER_REQUIRE_GV> bit currently has a defined meaning
(for which see above). All other bits should be clear.
+=for apidoc Amnh||CALL_CHECKER_REQUIRE_GV
+
=for apidoc cv_get_call_checker
The original form of L</cv_get_call_checker_flags>, which does not return
}
+OP *
+Perl_ck_isa(pTHX_ OP *o)
+{
+ OP *classop = cBINOPo->op_last;
+
+ PERL_ARGS_ASSERT_CK_ISA;
+
+ /* Convert barename into PV */
+ if(classop->op_type == OP_CONST && classop->op_private & OPpCONST_BARE) {
+ /* TODO: Optionally convert package to raw HV here */
+ classop->op_private &= ~(OPpCONST_BARE|OPpCONST_STRICT);
+ }
+
+ return o;
+}
+
/*
---------------------------------------------------------
"lvrefslice",
"lvavref",
"anonconst",
+ "isa",
"freed",
};
#endif
"lvalue ref assignment",
"lvalue array reference",
"anonymous constant",
+ "derived class test",
"freed op",
};
#endif
Perl_pp_lvrefslice,
Perl_pp_lvavref,
Perl_pp_anonconst,
+ Perl_pp_isa,
}
#endif
#ifdef PERL_PPADDR_INITED
Perl_ck_null, /* lvrefslice */
Perl_ck_null, /* lvavref */
Perl_ck_null, /* anonconst */
+ Perl_ck_isa, /* isa */
}
#endif
#ifdef PERL_CHECK_INITED
0x00000440, /* lvrefslice */
0x00000b40, /* lvavref */
0x00000144, /* anonconst */
+ 0x00000204, /* isa */
};
#endif
233, /* lvrefslice */
234, /* lvavref */
0, /* anonconst */
+ 12, /* isa */
};
0x0438, 0x1a50, 0x426c, 0x3d28, 0x3505, /* const */
0x2fdc, 0x3659, /* gvsv */
0x18b5, /* gv */
- 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
+ 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor, isa */
0x2fdc, 0x41b8, 0x03d7, /* padsv */
0x2fdc, 0x41b8, 0x05b4, 0x30cc, 0x3ea9, /* padav */
0x2fdc, 0x41b8, 0x05b4, 0x0650, 0x30cc, 0x3ea8, 0x2b41, /* padhv */
/* LVREFSLICE */ (OPpLVAL_INTRO),
/* LVAVREF */ (OPpARG1_MASK|OPpPAD_STATE|OPpLVAL_INTRO),
/* ANONCONST */ (OPpARG1_MASK),
+ /* ISA */ (OPpARG2_MASK),
};
OP_LVREFSLICE = 394,
OP_LVAVREF = 395,
OP_ANONCONST = 396,
+ OP_ISA = 397,
OP_max
} opcode;
-#define MAXO 397
+#define MAXO 398
#define OP_FREED MAXO
/* the OP_IS_* macros are optimized to a simple range check because
/* Not found. Check for non-FAT name and try truncated name. */
/* Don't know if this helps though... */
for (beg = dot = path + strlen(path);
- beg > path && !strchr(":/\\", *(beg-1));
+ beg > path && !memCHRs(":/\\", *(beg-1));
beg--)
if (*beg == '.')
dot = beg;
goto doshell;
for (s = cmd; *s; s++) {
- if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
+ if (*s != ' ' && !isALPHA(*s) && memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) {
if (*s == '\n' && s[1] == '\0') {
*s = '\0';
break;
For state vars, C<SVs_PADSTALE> is overloaded to mean 'not yet initialised',
but this internal state is stored in a separate pad entry.
+=for apidoc Amnh||SVs_PADSTALE
+
=for apidoc AmnxU|PADNAMELIST *|PL_comppad_name
During compilation, this points to the array containing the names part
included. If the first argument is neither a CV nor a GV, this flag is
ignored (subject to change).
+=for apidoc Amnh||CV_NAME_NOTQUAL
+
=cut
*/
the outer pad name that this one mirrors. The returned pad name has the
C<PADNAMEt_OUTER> flag already set.
+=for apidoc Amnh||PADNAMEt_OUTER
+
=cut
*/
#define PERL_REVISION 5 /* age */
#define PERL_VERSION 31 /* epoch */
-#define PERL_SUBVERSION 6 /* generation */
+#define PERL_SUBVERSION 7 /* generation */
/* The following numbers describe the earliest compatible version of
Perl ("compatibility" here being defined as sufficient binary/API
*/
#define PERL_API_REVISION 5
#define PERL_API_VERSION 31
-#define PERL_API_SUBVERSION 6
+#define PERL_API_SUBVERSION 7
/*
XXX Note: The selection of non-default Configure options, such
as -Duselonglong may invalidate these settings. Currently, Configure
PL_warn_locale = NULL;
#endif
+ SvREFCNT_dec(PL_AboveLatin1);
+ PL_AboveLatin1 = NULL;
+ SvREFCNT_dec(PL_Assigned_invlist);
+ PL_Assigned_invlist = NULL;
+ SvREFCNT_dec(PL_GCB_invlist);
+ PL_GCB_invlist = NULL;
+ SvREFCNT_dec(PL_HasMultiCharFold);
+ PL_HasMultiCharFold = NULL;
+ SvREFCNT_dec(PL_InMultiCharFold);
+ PL_InMultiCharFold = NULL;
+ SvREFCNT_dec(PL_Latin1);
+ PL_Latin1 = NULL;
+ SvREFCNT_dec(PL_LB_invlist);
+ PL_LB_invlist = NULL;
+ SvREFCNT_dec(PL_SB_invlist);
+ PL_SB_invlist = NULL;
+ SvREFCNT_dec(PL_SCX_invlist);
+ PL_SCX_invlist = NULL;
+ SvREFCNT_dec(PL_UpperLatin1);
+ PL_UpperLatin1 = NULL;
+ SvREFCNT_dec(PL_in_some_fold);
+ PL_in_some_fold = NULL;
+ SvREFCNT_dec(PL_utf8_idcont);
+ PL_utf8_idcont = NULL;
+ SvREFCNT_dec(PL_utf8_idstart);
+ PL_utf8_idstart = NULL;
+ SvREFCNT_dec(PL_utf8_perl_idcont);
+ PL_utf8_perl_idcont = NULL;
+ SvREFCNT_dec(PL_utf8_perl_idstart);
+ PL_utf8_perl_idstart = NULL;
+ SvREFCNT_dec(PL_utf8_xidcont);
+ PL_utf8_xidcont = NULL;
+ SvREFCNT_dec(PL_utf8_xidstart);
+ PL_utf8_xidstart = NULL;
+ SvREFCNT_dec(PL_WB_invlist);
+ PL_WB_invlist = NULL;
+ SvREFCNT_dec(PL_utf8_toupper);
+ PL_utf8_toupper = NULL;
+ SvREFCNT_dec(PL_utf8_totitle);
+ PL_utf8_totitle = NULL;
+ SvREFCNT_dec(PL_utf8_tolower);
+ PL_utf8_tolower = NULL;
+ SvREFCNT_dec(PL_utf8_tofold);
+ PL_utf8_tofold = NULL;
+ SvREFCNT_dec(PL_utf8_tosimplefold);
+ PL_utf8_tosimplefold = NULL;
+ SvREFCNT_dec(PL_utf8_charname_begin);
+ PL_utf8_charname_begin = NULL;
+ SvREFCNT_dec(PL_utf8_charname_continue);
+ PL_utf8_charname_continue = NULL;
+ SvREFCNT_dec(PL_utf8_mark);
+ PL_utf8_mark = NULL;
+ SvREFCNT_dec(PL_InBitmap);
+ PL_InBitmap = NULL;
+ SvREFCNT_dec(PL_CCC_non0_non230);
+ PL_CCC_non0_non230 = NULL;
+ SvREFCNT_dec(PL_Private_Use);
+ PL_Private_Use = NULL;
+
+ for (i = 0; i < POSIX_CC_COUNT; i++) {
+ SvREFCNT_dec(PL_XPosix_ptrs[i]);
+ PL_XPosix_ptrs[i] = NULL;
+
+ if (i != _CC_CASED) { /* A copy of Alpha */
+ SvREFCNT_dec(PL_Posix_ptrs[i]);
+ PL_Posix_ptrs[i] = NULL;
+ }
+ }
+
if (!specialWARN(PL_compiling.cop_warnings))
PerlMemShared_free(PL_compiling.cop_warnings);
PL_compiling.cop_warnings = NULL;
d = s;
if (!*s)
break;
- if (!strchr("CDIMUdmtwW", *s))
+ if (!memCHRs("CDIMUdmtwW", *s))
Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
while (++s && *s) {
if (isSPACE(*s)) {
The C<G_RETHROW> flag can be used if you only need eval_sv() to
execute code specified by a string, but not catch any errors.
+=for apidoc Amnh||G_RETHROW
=cut
*/
taint_proper(NULL, s); \
}
# define TAINT_set(s) (PL_tainted = (s))
-# define TAINT_get (PL_tainted) /* Is something tainted? */
-# define TAINTING_get (PL_tainting) /* Is taint checking enabled? */
+# define TAINT_get (cBOOL(UNLIKELY(PL_tainted))) /* Is something tainted? */
+# define TAINTING_get (cBOOL(UNLIKELY(PL_tainting))) /* Is taint checking enabled? */
# define TAINTING_set(s) (PL_tainting = (s))
# define TAINT_WARN_get (PL_taint_warn) /* FALSE => tainting violations
are fatal
*/
/* The quadmath literals are anon structs which -Wc++-compat doesn't like. */
-GCC_DIAG_IGNORE_DECL(-Wpragmas);
+# ifndef USE_CPLUSPLUS
GCC_DIAG_IGNORE_DECL(-Wc++-compat);
+# endif
# ifdef USE_QUADMATH
/* Cannot use HUGE_VALQ for PL_inf because not a compile-time
# endif
# endif
+# ifndef USE_CPLUSPLUS
GCC_DIAG_RESTORE_DECL;
-GCC_DIAG_RESTORE_DECL;
+# endif
#else
#else /* !PERL_CORE */
-#undef PL_AboveLatin1
-#define PL_AboveLatin1 (*Perl_GAboveLatin1_ptr(NULL))
-#undef PL_Assigned_invlist
-#define PL_Assigned_invlist (*Perl_GAssigned_invlist_ptr(NULL))
-#undef PL_CCC_non0_non230
-#define PL_CCC_non0_non230 (*Perl_GCCC_non0_non230_ptr(NULL))
#undef PL_C_locale_obj
#define PL_C_locale_obj (*Perl_GC_locale_obj_ptr(NULL))
-#undef PL_GCB_invlist
-#define PL_GCB_invlist (*Perl_GGCB_invlist_ptr(NULL))
-#undef PL_HasMultiCharFold
-#define PL_HasMultiCharFold (*Perl_GHasMultiCharFold_ptr(NULL))
-#undef PL_InBitmap
-#define PL_InBitmap (*Perl_GInBitmap_ptr(NULL))
-#undef PL_InMultiCharFold
-#define PL_InMultiCharFold (*Perl_GInMultiCharFold_ptr(NULL))
-#undef PL_LB_invlist
-#define PL_LB_invlist (*Perl_GLB_invlist_ptr(NULL))
-#undef PL_Latin1
-#define PL_Latin1 (*Perl_GLatin1_ptr(NULL))
-#undef PL_Posix_ptrs
-#define PL_Posix_ptrs (*Perl_GPosix_ptrs_ptr(NULL))
-#undef PL_Private_Use
-#define PL_Private_Use (*Perl_GPrivate_Use_ptr(NULL))
-#undef PL_SB_invlist
-#define PL_SB_invlist (*Perl_GSB_invlist_ptr(NULL))
-#undef PL_SCX_invlist
-#define PL_SCX_invlist (*Perl_GSCX_invlist_ptr(NULL))
-#undef PL_UpperLatin1
-#define PL_UpperLatin1 (*Perl_GUpperLatin1_ptr(NULL))
-#undef PL_WB_invlist
-#define PL_WB_invlist (*Perl_GWB_invlist_ptr(NULL))
-#undef PL_XPosix_ptrs
-#define PL_XPosix_ptrs (*Perl_GXPosix_ptrs_ptr(NULL))
#undef PL_appctx
#define PL_appctx (*Perl_Gappctx_ptr(NULL))
#undef PL_check
#define PL_hash_state (*Perl_Ghash_state_ptr(NULL))
#undef PL_hints_mutex
#define PL_hints_mutex (*Perl_Ghints_mutex_ptr(NULL))
-#undef PL_in_some_fold
-#define PL_in_some_fold (*Perl_Gin_some_fold_ptr(NULL))
#undef PL_keyword_plugin
#define PL_keyword_plugin (*Perl_Gkeyword_plugin_ptr(NULL))
#undef PL_keyword_plugin_mutex
#define PL_user_def_props_aTHX (*Perl_Guser_def_props_aTHX_ptr(NULL))
#undef PL_user_prop_mutex
#define PL_user_prop_mutex (*Perl_Guser_prop_mutex_ptr(NULL))
-#undef PL_utf8_charname_begin
-#define PL_utf8_charname_begin (*Perl_Gutf8_charname_begin_ptr(NULL))
-#undef PL_utf8_charname_continue
-#define PL_utf8_charname_continue (*Perl_Gutf8_charname_continue_ptr(NULL))
#undef PL_utf8_foldclosures
#define PL_utf8_foldclosures (*Perl_Gutf8_foldclosures_ptr(NULL))
-#undef PL_utf8_idcont
-#define PL_utf8_idcont (*Perl_Gutf8_idcont_ptr(NULL))
-#undef PL_utf8_idstart
-#define PL_utf8_idstart (*Perl_Gutf8_idstart_ptr(NULL))
-#undef PL_utf8_mark
-#define PL_utf8_mark (*Perl_Gutf8_mark_ptr(NULL))
-#undef PL_utf8_perl_idcont
-#define PL_utf8_perl_idcont (*Perl_Gutf8_perl_idcont_ptr(NULL))
-#undef PL_utf8_perl_idstart
-#define PL_utf8_perl_idstart (*Perl_Gutf8_perl_idstart_ptr(NULL))
-#undef PL_utf8_tofold
-#define PL_utf8_tofold (*Perl_Gutf8_tofold_ptr(NULL))
-#undef PL_utf8_tolower
-#define PL_utf8_tolower (*Perl_Gutf8_tolower_ptr(NULL))
-#undef PL_utf8_tosimplefold
-#define PL_utf8_tosimplefold (*Perl_Gutf8_tosimplefold_ptr(NULL))
-#undef PL_utf8_totitle
-#define PL_utf8_totitle (*Perl_Gutf8_totitle_ptr(NULL))
-#undef PL_utf8_toupper
-#define PL_utf8_toupper (*Perl_Gutf8_toupper_ptr(NULL))
-#undef PL_utf8_xidcont
-#define PL_utf8_xidcont (*Perl_Gutf8_xidcont_ptr(NULL))
-#undef PL_utf8_xidstart
-#define PL_utf8_xidstart (*Perl_Gutf8_xidstart_ptr(NULL))
#undef PL_veto_cleanup
#define PL_veto_cleanup (*Perl_Gveto_cleanup_ptr(NULL))
#undef PL_watch_pvx
int imode, int perm, PerlIO *f, int narg, SV **args)
{
if (!f && narg == 1 && *args == &PL_sv_undef) {
- int imode = PerlIOUnix_oflags(mode);
+ imode = PerlIOUnix_oflags(mode);
if (imode != -1 && (f = PerlIO_tmpfile_flags(imode))) {
if (!layers || !*layers)
PERLVAR(G, perllib_sep, char)
#endif
-PERLVAR(G, AboveLatin1, SV *)
-PERLVAR(G, Assigned_invlist, SV *)
-PERLVAR(G, GCB_invlist, SV *)
-PERLVAR(G, HasMultiCharFold, SV *)
-PERLVAR(G, InMultiCharFold, SV *)
-PERLVAR(G, Latin1, SV *)
-PERLVAR(G, LB_invlist, SV *)
-PERLVAR(G, SB_invlist, SV *)
-PERLVAR(G, SCX_invlist, SV *)
-PERLVAR(G, UpperLatin1, SV *) /* Code points 128 - 255 */
-
-/* List of characters that participate in any fold defined by Unicode */
-PERLVAR(G, in_some_fold, SV *)
-
-PERLVAR(G, utf8_idcont, SV *)
-PERLVAR(G, utf8_idstart, SV *)
-PERLVAR(G, utf8_perl_idcont, SV *)
-PERLVAR(G, utf8_perl_idstart, SV *)
-PERLVAR(G, utf8_xidcont, SV *)
-PERLVAR(G, utf8_xidstart, SV *)
-PERLVAR(G, WB_invlist, SV *)
-PERLVARA(G, XPosix_ptrs, POSIX_CC_COUNT, SV *)
-PERLVARA(G, Posix_ptrs, POSIX_CC_COUNT, SV *)
-PERLVAR(G, utf8_toupper, SV *)
-PERLVAR(G, utf8_totitle, SV *)
-PERLVAR(G, utf8_tolower, SV *)
-PERLVAR(G, utf8_tofold, SV *)
-PERLVAR(G, utf8_tosimplefold, SV *)
-PERLVAR(G, utf8_charname_begin, SV *)
-PERLVAR(G, utf8_charname_continue, SV *)
-PERLVAR(G, utf8_mark, SV *)
-PERLVARI(G, InBitmap, SV *, NULL)
-PERLVAR(G, CCC_non0_non230, SV *)
-PERLVAR(G, Private_Use, SV *)
-
/* Definitions of user-defined \p{} properties, as the subs that define them
* are only called once */
PERLVARI(G, user_def_props, HV *, NULL)
* This symbol contains the ~name expanded version of PRIVLIB, to be used
* in programs that are not prepared to deal with ~ expansion at run-time.
*/
-#define PRIVLIB "/sys/lib/perl/5.31.6" /**/
-#define PRIVLIB_EXP "/sys/lib/perl/5.31.6" /**/
+#define PRIVLIB "/sys/lib/perl/5.31.7" /**/
+#define PRIVLIB_EXP "/sys/lib/perl/5.31.7" /**/
/* PTRSIZE:
* This symbol contains the size of a pointer, so that the C preprocessor
* removed. The elements in inc_version_list (inc_version_list.U) can
* be tacked onto this variable to generate a list of directories to search.
*/
-#define SITELIB "/sys/lib/perl/5.31.6/site_perl" /**/
-#define SITELIB_EXP "/sys/lib/perl/5.31.6/site_perl" /**/
-#define SITELIB_STEM "/sys/lib/perl/5.31.6/site_perl" /**/
+#define SITELIB "/sys/lib/perl/5.31.7/site_perl" /**/
+#define SITELIB_EXP "/sys/lib/perl/5.31.7/site_perl" /**/
+#define SITELIB_STEM "/sys/lib/perl/5.31.7/site_perl" /**/
/* Size_t_size:
* This symbol holds the size of a Size_t in bytes.
alignbytes='4'
aphostname='/bin/uname -n'
api_revision='5'
-api_subversion='6'
+api_subversion='7'
api_version='31'
-api_versionstring='5.31.6'
+api_versionstring='5.31.7'
ar='ar'
-archlib='/sys/lib/perl5/5.31.6/386'
-archlibexp='/sys/lib/perl5/5.31.6/386'
+archlib='/sys/lib/perl5/5.31.7/386'
+archlibexp='/sys/lib/perl5/5.31.7/386'
archname64=''
archname='386'
archobjs=''
d_atanh='undef'
d_atolf='undef'
d_atoll='define'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='undef'
d_wait4='undef'
d_waitpid='define'
+d_wcrtomb='undef'
d_wcscmp='undef'
d_wcstombs='define'
d_wcsxfrm='undef'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='/sys/lib/perl/5.31.6/386'
+installarchlib='/sys/lib/perl/5.31.7/386'
installbin='/usr/bin'
installman1dir='/sys/man/1pub'
installman3dir='/sys/man/2pub'
installprefix='/usr'
installprefixexp='/usr'
-installprivlib='/sys/lib/perl/5.31.6'
+installprivlib='/sys/lib/perl/5.31.7'
installscript='/usr/bin'
-installsitearch='/sys/lib/perl/5.31.6/site_perl/386'
+installsitearch='/sys/lib/perl/5.31.7/site_perl/386'
installsitebin='/usr/bin'
-installsitelib='/sys/lib/perl/5.31.6/site_perl'
+installsitelib='/sys/lib/perl/5.31.7/site_perl'
installstyle='lib/perl5'
installusrbinperl='undef'
installvendorarch=''
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/sys/lib/perl/5.31.6'
-privlibexp='/sys/lib/perl/5.31.6'
+privlib='/sys/lib/perl/5.31.7'
+privlibexp='/sys/lib/perl/5.31.7'
procselfexe=''
prototype='define'
ptrsize='4'
sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 0'
sig_size='50'
signal_t='void'
-sitearch='/sys/lib/perl/5.31.6/site_perl/386'
+sitearch='/sys/lib/perl/5.31.7/site_perl/386'
sitearchexp='/sys/lib/perl/site_perl/386'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
-sitelib='/sys/lib/perl/5.31.6/site_perl'
-sitelib_stem='/sys/lib/perl/5.31.6/site_perl'
-sitelibexp='/sys/lib/perl/5.31.6/site_perl'
+sitelib='/sys/lib/perl/5.31.7/site_perl'
+sitelib_stem='/sys/lib/perl/5.31.7/site_perl'
+sitelibexp='/sys/lib/perl/5.31.7/site_perl'
siteprefix='/usr'
siteprefixexp='/usr'
sizesize='4'
strerror_r_proto='0'
strings='/sys/include/ape/string.h'
submit=''
-subversion='6'
+subversion='7'
sysman='/sys/man/1pub'
tail=''
tar=''
vendorlibexp=''
vendorprefix=''
vendorprefixexp=''
-version='5.31.6'
-version_patchlevel_string='version 31 subversion 6'
+version='5.31.7'
+version_patchlevel_string='version 31 subversion 7'
versiononly='undef'
vi=''
xlibpth=''
config_argc=0
PERL_REVISION=5
PERL_VERSION=31
-PERL_SUBVERSION=6
+PERL_SUBVERSION=7
PERL_API_REVISION=5
PERL_API_VERSION=31
-PERL_API_SUBVERSION=6
+PERL_API_SUBVERSION=7
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
perlhist Perl history records
perldelta Perl changes since previous version
+ perl5316delta Perl changes in version 5.31.6
perl5315delta Perl changes in version 5.31.5
perl5314delta Perl changes in version 5.31.4
perl5313delta Perl changes in version 5.31.3
--- /dev/null
+=encoding utf8
+
+=head1 NAME
+
+perl5316delta - what is new for perl v5.31.6
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.31.5 release and the 5.31.6
+release.
+
+If you are upgrading from an earlier release such as 5.31.4, first read
+L<perl5315delta>, which describes differences between 5.31.4 and 5.31.5.
+
+=head1 Core Enhancements
+
+=head2 Alpha assertions are no longer experimental
+
+See L<perlre/(*pla:pattern)>, L<perlre/(*plb:pattern)>,
+L<perlre/(*nla:pattern)>>, and L<perlre/(*nlb:pattern)>.
+Use of these no longer generates a warning; existing code that disables
+the warning category C<experimental::script_run> will continue to work
+without any changes needed. Enabling the category has no effect.
+
+=head2 Script runs are no longer experimental
+
+See L<perlre/Script Runs>. Use of these no longer generates a warning;
+existing code that disables the warning category
+C<experimental::alpha_assertions> will continue to work without any
+changes needed. Enabling the category has no effect.
+
+=head2 Feature checks are now faster
+
+Previously feature checks in the parser required a hash lookup when
+features we set outside of a feature bundle, this has been optimized
+to a bit mask check. [#17229]
+
+=head2 Perl is now developed on Github
+
+Perl is now developed on Github, you can find us at
+L<https://github.com/Perl/perl5>.
+
+Non-security bugs should now be reported via Github.
+
+=head1 Modules and Pragmata
+
+=head2 Updated Modules and Pragmata
+
+=over 4
+
+=item *
+
+L<B::Deparse> has been upgraded from version 1.50 to 1.51.
+
+=item *
+
+L<Compress::Raw::Bzip2> has been upgraded from version 2.087 to 2.090.
+
+=item *
+
+L<Compress::Raw::Zlib> has been upgraded from version 2.087 to 2.090.
+
+=item *
+
+L<Devel::PPPort> has been upgraded from version 3.54 to 3.55.
+
+=item *
+
+L<DynaLoader> has been upgraded from version 1.45 to 1.46.
+
+=item *
+
+L<feature> has been upgraded from version 1.55 to 1.56.
+
+=item *
+
+L<IO::Compress::Base> has been upgraded from version 2.087 to 2.090.
+
+=item *
+
+L<Math::BigInt> has been upgraded from version 1.999817_01 to 1.999818.
+
+=item *
+
+L<Module::CoreList> has been upgraded from version 5.20191020 to 5.20191120.
+
+=item *
+
+L<Module::Load::Conditional> has been upgraded from version 0.68 to 0.70.
+
+=item *
+
+L<mro> has been upgraded from version 1.22 to 1.23.
+
+=item *
+
+L<perlfaq> has been upgraded from version 5.20190126 to 5.20191102.
+
+=item *
+
+L<Pod::Simple> has been upgraded from version 3.39 to 3.40.
+
+=item *
+
+L<POSIX> has been upgraded from version 1.89 to 1.90.
+
+=item *
+
+L<Scalar::Util> has been upgraded from version 1.52 to 1.53.
+
+=item *
+
+L<Sys::Syslog> has been upgraded from version 0.35 to 0.36.
+
+=item *
+
+L<Test::Simple> has been upgraded from version 1.302168 to 1.302169.
+
+=item *
+
+L<Tie::StdHandle> has been upgraded from version 4.5 to 4.6.
+
+=item *
+
+L<Unicode::UCD> has been upgraded from version 0.73 to 0.74.
+
+=item *
+
+L<Win32API::File> has been upgraded from version 0.1203 to 0.1203_01.
+
+=back
+
+=head1 Utility Changes
+
+=head2 L<streamzip>
+
+=over 4
+
+=item *
+
+This is a new utility, included as part of an
+L<IO::Compress::Base> upgrade.
+
+L<streamzip> creates a zip file from stdin. The program will read data
+from stdin, compress it into a zip container and, by default, write a
+streamed zip file to stdout.
+
+=back
+
+=head1 Configuration and Compilation
+
+=over 4
+
+=item *
+
+F<Configure> now correctly handles gcc-10. Previously it was interpreting it
+as gcc-1 and turned on C<-fpcc-struct-return>.
+
+=back
+
+=head1 Platform Support
+
+=head2 Platform-Specific Notes
+
+=over 4
+
+=item Windows
+
+The configuration for C<ccflags> and C<optimize> are now separate, as
+with POSIX platforms. [#17156]
+
+=back
+
+=head1 Internal Changes
+
+=over 4
+
+=item *
+
+The lexer (C<Perl_yylex()> in F<toke.c>) was previously a single 4100-line
+function, relying heavily on C<goto> and a lot of widely-scoped local variables
+to do its work. It has now been pulled apart into a few dozen smaller static
+functions; the largest remaining chunk (C<yyl_word_or_keyword()>) is a little
+over 900 lines, and consists of a single C<switch> statement, all of whose
+C<case> groups are independent. This should be much easier to understand and
+maintain.
+
+=item *
+
+The OS-level signal handlers and type (Sighandler_t) used by the perl core
+were declared as having three parameters, but the OS was always told to
+call them with one argument. This has been fixed by declaring them to have
+one parameter. See the merge commit C<v5.31.5-346-g116e19abbf> for full
+details.
+
+=item *
+
+The code that handles C<tr///> has been extensively revised, fixing
+various bugs, especially when the source and/or replacement strings
+contain characters whose code points are above 255. Some of the bugs
+were undocumented, one being that under some circumstances (but not all)
+with C</s>, the squeezing was done based on the source, rather than the
+replacement. A documented bug that got fixed was [perl RT #125493].
+
+=item *
+
+A new macro for XS writers dealing with UTF-8-encoded Unicode strings
+has been created L<perlapi/C<UTF8_CHK_SKIP>> that is safer in the face
+of malformed UTF-8 input than L<perlapi/C<UTF8_SKIP>> (but not as safe
+as L<perlapi/C<UTF8_SAFE_SKIP>>). It won't read past a NUL character.
+It has been backported in L<Devel::PPPort> 3.55 and later.
+
+=back
+
+=head1 Selected Bug Fixes
+
+=over 4
+
+=item *
+
+printf() or sprintf() with the C<%n> format could cause a panic on
+debugging builds, or report an incorrectly cached length value when
+producing C<SVfUTF8> flagged strings. [#17221]
+
+=item *
+
+The tokenizer has been extensively refactored. [#17241][#17189]
+
+=item *
+
+C<use strict "subs"> is now enforced for bareword constants optimized
+into a C<multiconcat> operator. [#17254]
+
+=item *
+
+A memory leak in regular expression patterns has been fixed [#17218].
+
+=back
+
+=head1 Acknowledgements
+
+Perl 5.31.6 represents approximately 4 weeks of development since Perl
+5.31.5 and contains approximately 43,000 lines of changes across 490 files
+from 31 authors.
+
+Excluding auto-generated files, documentation and release tools, there were
+approximately 35,000 lines of changes to 300 .pm, .t, .c and .h files.
+
+Perl continues to flourish into its fourth decade thanks to a vibrant
+community of users and developers. The following people are known to have
+contributed the improvements that became Perl 5.31.6:
+
+Aaron Crane, Chad Granum, Chris 'BinGOs' Williams, Craig A. Berry, Dagfinn
+Ilmari Mannsåker, Dan Book, Dave Cross, David Mitchell, E. Choroba, Graham
+Knop, Hauke D, Ichinose Shogo, James E Keenan, Karen Etheridge, Karl
+Williamson, Matt Turner, Max Maischein, Nicholas Clark, Nicolas R., Pali,
+Paul Evans, Petr Písař, Richard Leach, Sergey Aleynikov, Steve Hay, Steve
+Peters, Todd Rinaldo, Tomasz Konojacki, Tom Hukins, Tony Cook, Yves Orton.
+
+The list above is almost certainly incomplete as it is automatically
+generated from version control history. In particular, it does not include
+the names of the (very much appreciated) contributors who reported issues to
+the Perl bug tracker.
+
+Many of the changes included in this version originated in the CPAN modules
+included in Perl's core. We're grateful to the entire CPAN community for
+helping Perl to flourish.
+
+For a more complete list of all of Perl's historical contributors, please
+see the F<AUTHORS> file in the Perl source distribution.
+
+=head1 Reporting Bugs
+
+If you find what you think is a bug, you might check the perl bug database
+at L<https://github.com/Perl/perl5/issues>. There may also be information at
+L<http://www.perl.org/>, the Perl Home Page.
+
+If you believe you have an unreported bug, please run the L<perlbug> program
+included with your release. Be sure to trim your bug down to a tiny but
+sufficient test case. Your bug report, along with the output of C<perl -V>,
+will be sent off to perlbug@perl.org to be analysed by the Perl porting team.
+
+If the bug you are reporting has security implications which make it
+inappropriate to send to a publicly archived mailing list, then see
+L<perlsec/SECURITY VULNERABILITY CONTACT INFORMATION>
+for details of how to report the issue.
+
+=head1 Give Thanks
+
+If you wish to thank the Perl 5 Porters for the work we had done in Perl 5,
+you can do so by running the C<perlthanks> program:
+
+ perlthanks
+
+This will send an email to the Perl 5 Porters list with your show of thanks.
+
+=head1 SEE ALSO
+
+The F<Changes> file for an explanation of how to view exhaustive details on
+what changed.
+
+The F<INSTALL> file for how to build Perl.
+
+The F<README> file for general stuff.
+
+The F<Artistic> and F<Copying> files for copyright information.
+
+=cut
GPOS no Matches where last m//g left off.
# Word Boundary Opcodes:
- BOUND no Like BOUNDA for non-utf8, otherwise match
- "" between any Unicode \w\W or \W\w
+ BOUND no Like BOUNDA for non-utf8, otherwise like
+ BOUNDU
BOUNDL no Like BOUND/BOUNDU, but \w and \W are
defined by current locale
BOUNDU no Match "" at any boundary of a given type
using /u rules.
BOUNDA no Match "" at any boundary between \w\W or
\W\w, where \w is [_a-zA-Z0-9]
- NBOUND no Like NBOUNDA for non-utf8, otherwise match
- "" between any Unicode \w\w or \W\W
+ NBOUND no Like NBOUNDA for non-utf8, otherwise like
+ BOUNDU
NBOUNDL no Like NBOUND/NBOUNDU, but \w and \W are
defined by current locale
NBOUNDU no Match "" at any non-boundary of a given
ANYOFHr sv 1 Like ANYOFH, but the flags field contains
packed bounds for all matchable UTF-8 start
bytes.
+ ANYOFHs sv 1 Like ANYOFHb, but has a string field that
+ gives the leading matchable UTF-8 bytes;
+ flags field is len
ANYOFR packed 1 Matches any character in the range given by
its packed args: upper 12 bits is the max
delta from the base lower 20; the flags
=head1 NAME
-perldelta - what is new for perl v5.31.6
+perldelta - what is new for perl v5.31.7
=head1 DESCRIPTION
-This document describes differences between the 5.31.5 release and the 5.31.6
+This document describes differences between the 5.31.6 release and the 5.31.7
release.
-If you are upgrading from an earlier release such as 5.31.4, first read
-L<perl5315delta>, which describes differences between 5.31.4 and 5.31.5.
+If you are upgrading from an earlier release such as 5.31.5, first read
+L<perl5316delta>, which describes differences between 5.31.5 and 5.31.6.
=head1 Core Enhancements
-=head2 Alpha assertions are no longer experimental
+=head2 The isa Operator
-See L<perlre/(*pla:pattern)>, L<perlre/(*plb:pattern)>,
-L<perlre/(*nla:pattern)>>, and L<perlre/(*nlb:pattern)>.
-Use of these no longer generates a warning; existing code that disables
-the warning category C<experimental::script_run> will continue to work
-without any changes needed. Enabling the category has no effect.
+A new experimental infix operator called C<isa> tests whether a given object
+is an instance of a given class or a class derived from it:
-=head2 Script runs are no longer experimental
+ if( $obj isa Package::Name ) { ... }
-See L<perlre/Script Runs>. Use of these no longer generates a warning;
-existing code that disables the warning category
-C<experimental::alpha_assertions> will continue to work without any
-changes needed. Enabling the category has no effect.
+For more detail see L<perlop/Class Instance Operator>.
-=head2 Feature checks are now faster
+=head1 Incompatible Changes
-Previously feature checks in the parser required a hash lookup when
-features we set outside of a feature bundle, this has been optimized
-to a bit mask check. [#17229]
+=head2 C<\p{I<user-defined>}> properties now always override official
+Unicode ones
-=head2 Perl is now developed on Github
+Previously, if and only if a user-defined property was declared prior to
+the compilation of the regular expression pattern containing it, its
+definition was used instead of any official Unicode property with the
+same name. Now, it always overrides the official property. This
+change could break existing code that relied (likely unwittingly) on the
+previous behavior. Without this fix, if Unicode released a new version
+with a new property that happens to have the same name as the one you
+had long been using, your program would break when you upgraded to a
+perl that used that new Unicode version. See L<perlunicode/User-Defined
+Character Properties>. [L<GH #17205|https://github.com/Perl/perl5/issues/17205>]
-Perl is now developed on Github, you can find us at
-L<https://github.com/Perl/perl5>.
-Non-security bugs should now be reported via Github.
+=head1 Deprecations
+
+=head2 Module removals
+
+The following modules will be removed from the core distribution in a
+future release, and will at that time need to be installed from CPAN.
+Distributions on CPAN which require these modules will need to list them as
+prerequisites.
+
+The core versions of these modules will now issue C<"deprecated">-category
+warnings to alert you to this fact. To silence these deprecation warnings,
+install the modules in question from CPAN.
+
+Note that these are (with rare exceptions) fine modules that you are encouraged
+to continue to use. Their disinclusion from core primarily hinges on their
+necessity to bootstrapping a fully functional, CPAN-capable Perl installation,
+not usually on concerns over their design.
+
+=over
+
+=item B::Debug
+
+B::Debug is no longer shipped with Perl, you can still install it from CPAN.
+
+=back
=head1 Modules and Pragmata
=item *
-L<B::Deparse> has been upgraded from version 1.50 to 1.51.
+L<B> has been upgraded from version 1.77 to 1.78.
+
+=item *
+
+L<B::Deparse> has been upgraded from version 1.51 to 1.52.
=item *
-L<Compress::Raw::Bzip2> has been upgraded from version 2.087 to 2.090.
+L<Compress::Raw::Bzip2> has been upgraded from version 2.090 to 2.093.
=item *
-L<Compress::Raw::Zlib> has been upgraded from version 2.087 to 2.090.
+L<Compress::Raw::Zlib> has been upgraded from version 2.090 to 2.093.
=item *
-L<Devel::PPPort> has been upgraded from version 3.54 to 3.55.
+L<CPAN> now points to version 2.27 instead of version 2.27-TRIAL2.
=item *
-L<DynaLoader> has been upgraded from version 1.45 to 1.46.
+L<Devel::PPPort> has been upgraded from version 3.55 to 3.56.
=item *
-L<feature> has been upgraded from version 1.55 to 1.56.
+L<English> has been upgraded from version 1.10 to 1.11.
=item *
-L<IO::Compress::Base> has been upgraded from version 2.087 to 2.090.
+L<ExtUtils::MakeMaker> has been upgraded from version 7.38 to 7.42.
=item *
-L<Math::BigInt> has been upgraded from version 1.999817_01 to 1.999818.
+L<feature> has been upgraded from version 1.56 to 1.57.
=item *
-L<Module::CoreList> has been upgraded from version 5.20191020 to 5.20191120.
+L<File::stat> has been upgraded from version 1.08 to 1.09.
=item *
-L<Module::Load::Conditional> has been upgraded from version 0.68 to 0.70.
+L<Filter::Simple> has been upgraded from version 0.95 to 0.96.
=item *
-L<mro> has been upgraded from version 1.22 to 1.23.
+L<FindBin> is now a dual-life module.
=item *
-L<perlfaq> has been upgraded from version 5.20190126 to 5.20191102.
+L<IO::Compress> has been upgraded from version 2.090 to 2.093.
=item *
-L<Pod::Simple> has been upgraded from version 3.39 to 3.40.
+L<Module::CoreList> has been upgraded from version 5.20191120 to 5.20191220.
=item *
-L<POSIX> has been upgraded from version 1.89 to 1.90.
+L<Net::Ping> has been upgraded from version 2.71 to 2.72.
=item *
-L<Scalar::Util> has been upgraded from version 1.52 to 1.53.
+L<Opcode> has been upgraded from version 1.44 to 1.45.
=item *
-L<Sys::Syslog> has been upgraded from version 0.35 to 0.36.
+L<Storable> has been upgraded from version 3.17 to 3.18.
+
+fix to disallow vstring magic strings over 2GB.
=item *
-L<Test::Simple> has been upgraded from version 1.302168 to 1.302169.
+L<Test::Simple> has been upgraded from version 1.302169 to 1.302170.
=item *
-L<Tie::StdHandle> has been upgraded from version 4.5 to 4.6.
+L<Tie::Hash::NamedCapture> has been upgraded from version 0.11 to 0.13.
=item *
-L<Unicode::UCD> has been upgraded from version 0.73 to 0.74.
+L<VMS::Stdio> has been upgraded from version 2.44 to 2.45.
=item *
-L<Win32API::File> has been upgraded from version 0.1203 to 0.1203_01.
+L<warnings> has been upgraded from version 1.45 to 1.46.
+
+=item *
+
+L<XS::APItest> has been upgraded from version 1.04 to 1.05.
=back
-=head1 Utility Changes
+=head1 Documentation
+
+=head2 Changes to Existing Documentation
+
+We have attempted to update the documentation to reflect the changes
+listed in this document. If you find any we have missed, send email
+to L<perlbug@perl.org|mailto:perlbug@perl.org>.
-=head2 L<streamzip>
+Additionally, the following selected changes have been made:
+
+=head3 L<perldebguts>
=over 4
-=item *
+=item Simplify a couple regnode definitions
+
+Update BOUND and NBOUND definitions.
-This is a new utility, included as part of an
-L<IO::Compress::Base> upgrade.
+=item Add ANYOFHs regnode
-L<streamzip> creates a zip file from stdin. The program will read data
-from stdin, compress it into a zip container and, by default, write a
-streamed zip file to stdout.
+This node is like ANYOFHb, but is used when more than one leading byte
+is the same in all the matched code points.
+
+ANYOFHb is used to avoid having to convert from UTF-8 to code point for
+something that won't match. It checks that the first byte in the UTF-8
+encoded target is the desired one, thus ruling out most of the possible
+code points.
=back
-=head1 Configuration and Compilation
+=head3 L<perldiag>
=over 4
-=item *
+=item Add documentation for experimental 'isa' operator
-F<Configure> now correctly handles gcc-10. Previously it was interpreting it
-as gcc-1 and turned on C<-fpcc-struct-return>.
+(S experimental::isa) This warning is emitted if you use the (C<isa>)
+operator. This operator is currently experimental and its behaviour may
+change in future releases of Perl.
=back
-=head1 Platform Support
+=head3 L<perlfunc>
-=head2 Platform-Specific Notes
+=over 4
+
+=item caller
+
+Like L<C<__FILE__>|/__FILE__> and L<C<__LINE__>|/__LINE__>, the filename and
+line number returned here may be altered by the mechanism described at
+L<perlsyn/"Plain Old Comments (Not!)">.
+
+=item __FILE__
+
+It can be altered by the mechanism described at
+L<perlsyn/"Plain Old Comments (Not!)">.
+
+=item __LINE__
+
+It can be altered by the mechanism described at
+L<perlsyn/"Plain Old Comments (Not!)">.
+
+=item return
+
+Mention that you cannot return from do BLOCK
+
+=back
+
+=head3 L<perlguts>
=over 4
-=item Windows
+=item Update documentation for UTF8f
-The configuration for C<ccflags> and C<optimize> are now separate, as
-with POSIX platforms. [#17156]
+=item Add missing '=for apidoc' lines
=back
-=head1 Internal Changes
+=head3 L<perlhacktips>
=over 4
-=item *
+=item Perl strings are NOT the same as C strings
-The lexer (C<Perl_yylex()> in F<toke.c>) was previously a single 4100-line
-function, relying heavily on C<goto> and a lot of widely-scoped local variables
-to do its work. It has now been pulled apart into a few dozen smaller static
-functions; the largest remaining chunk (C<yyl_word_or_keyword()>) is a little
-over 900 lines, and consists of a single C<switch> statement, all of whose
-C<case> groups are independent. This should be much easier to understand and
-maintain.
+=back
-=item *
+=head3 L<perlop>
-The OS-level signal handlers and type (Sighandler_t) used by the perl core
-were declared as having three parameters, but the OS was always told to
-call them with one argument. This has been fixed by declaring them to have
-one parameter. See the merge commit C<v5.31.5-346-g116e19abbf> for full
-details.
+=over 4
-=item *
+=item 'isa' operator is experimental
-The code that handles C<tr///> has been extensively revised, fixing
-various bugs, especially when the source and/or replacement strings
-contain characters whose code points are above 255. Some of the bugs
-were undocumented, one being that under some circumstances (but not all)
-with C</s>, the squeezing was done based on the source, rather than the
-replacement. A documented bug that got fixed was [perl RT #125493].
+This is an experimental feature and is available from Perl 5.31.6 when enabled
+by C<use feature 'isa'>. It emits a warning in the C<experimental::isa>
+category.
-=item *
+=back
+
+=head3 L<perlreref>
+
+=over 4
+
+=item Fix some typos.
-A new macro for XS writers dealing with UTF-8-encoded Unicode strings
-has been created L<perlapi/C<UTF8_CHK_SKIP>> that is safer in the face
-of malformed UTF-8 input than L<perlapi/C<UTF8_SKIP>> (but not as safe
-as L<perlapi/C<UTF8_SAFE_SKIP>>). It won't read past a NUL character.
-It has been backported in L<Devel::PPPort> 3.55 and later.
+=back
+
+=head3 L<perlvar>
+
+=over 4
+
+=item Remove ${^FEATURE_BITS}.
+
+=back
+
+=head1 Utility Changes
+
+=head2 L<perlbug>
+
+=over 4
+
+=item Adjust bug tracker homepage url to point to GitHub.
+
+=back
+
+=head1 Configuration and Compilation
+
+=head2 F<Configure>
+
+=over 4
+
+=item Check if the compiler can handle inline attribute.
+
+=item Check for character data alignment.
+
+=back
+
+=head1 Testing
+
+Tests were added and changed to reflect the other additions and
+changes in this release. Furthermore, these significant changes were
+made:
+
+=over 4
+
+=item t/charset_tools.pl
+
+Avoid some work on ASCII platforms
+
+=item t/re/regexp.t
+
+Speed up many regex tests on ASCII platform
+
+=item t/re/pat.t
+
+Skip tests that don't work on EBCDIC
+
+=back
+
+=head1 Platform Support
+
+=head2 Platform-Specific Notes
+
+=over 4
+
+=item Solaris
+
+C<Configure> will now find recent versions of the Oracle Developer Studio
+compiler, which are found under C</opt/developerstudio*>.
=back
=over 4
-=item *
+=item Fix MYMALLOC (PERL_MALLOC) build on Windows
-printf() or sprintf() with the C<%n> format could cause a panic on
-debugging builds, or report an incorrectly cached length value when
-producing C<SVfUTF8> flagged strings. [#17221]
+=item \p{user-defined} overrides official Unicode [L<GH #17025|https://github.com/Perl/perl5/issues/17025>]
-=item *
+Prior to this patch, they only sometimes overrode.
-The tokenizer has been extensively refactored. [#17241][#17189]
+=item Regular Expressions
-=item *
+Properly handle filled /il regnodes and multi-char folds
-C<use strict "subs"> is now enforced for bareword constants optimized
-into a C<multiconcat> operator. [#17254]
+=item Compilation error during make minitest [L<GH #17293|https://github.com/Perl/perl5/issues/17293>]
-=item *
+move the implementation of %-, %+ into core
+
+=item read beyond buffer in grok_inf_nan [L<GH #17370|https://github.com/Perl/perl5/issues/17370>]
-A memory leak in regular expression patterns has been fixed [#17218].
+=item Workaround glibc bug with LC_MESSAGES [L<GH #17081|https://github.com/Perl/perl5/issues/17081>]
=back
=head1 Acknowledgements
-Perl 5.31.6 represents approximately 4 weeks of development since Perl
-5.31.5 and contains approximately 43,000 lines of changes across 490 files
-from 31 authors.
+Perl 5.31.7 represents approximately 4 weeks of development since Perl
+5.31.6 and contains approximately 9,300 lines of changes across 450 files
+from 22 authors.
Excluding auto-generated files, documentation and release tools, there were
-approximately 35,000 lines of changes to 300 .pm, .t, .c and .h files.
+approximately 5,200 lines of changes to 280 .pm, .t, .c and .h files.
Perl continues to flourish into its fourth decade thanks to a vibrant
community of users and developers. The following people are known to have
-contributed the improvements that became Perl 5.31.6:
-
-Aaron Crane, Chad Granum, Chris 'BinGOs' Williams, Craig A. Berry, Dagfinn
-Ilmari Mannsåker, Dan Book, Dave Cross, David Mitchell, E. Choroba, Graham
-Knop, Hauke D, Ichinose Shogo, James E Keenan, Karen Etheridge, Karl
-Williamson, Matt Turner, Max Maischein, Nicholas Clark, Nicolas R., Pali,
-Paul Evans, Petr Písař, Richard Leach, Sergey Aleynikov, Steve Hay, Steve
-Peters, Todd Rinaldo, Tomasz Konojacki, Tom Hukins, Tony Cook, Yves Orton.
+contributed the improvements that became Perl 5.31.7:
+
+Ask Bjørn Hansen, brian d foy, Bryan Stenson, Chad Granum, Chris 'BinGOs'
+Williams, Dan Book, David Mitchell, Felipe Gasper, James E Keenan, Karl
+Williamson, Matthew Horsfall, Max Maischein, Nicolas R., Pali, Paul Evans,
+Ricardo Signes, Sawyer X, Stefan Seifert, Steve Hay, Tomasz Konojacki, Tony
+Cook, Vitali Peil.
The list above is almost certainly incomplete as it is automatically
generated from version control history. In particular, it does not include
(W overload) You tried to overload a constant type the overload package is
unaware of.
+=item isa is experimental
+
+(S experimental::isa) This warning is emitted if you use the (C<isa>)
+operator. This operator is currently experimental and its behaviour may
+change in future releases of Perl.
+
=item -i used with no filenames on the command line, reading from STDIN
(S inplace) The C<-i> option was passed on the command line, indicating
C<experimental::smartmatch>.
The ticket for this feature is
-L<[perl #119317]|https://rt.perl.org/rt3/Ticket/Display.html?id=119317>.
+L<[perl #13173]|https://github.com/Perl/perl5/issues/13173>.
=item Pluggable keywords
The ticket for this feature is
-L<[perl #119455]|https://rt.perl.org/rt3/Ticket/Display.html?id=119455>.
+L<[perl #13199]|https://github.com/Perl/perl5/issues/13199>.
See L<perlapi/PL_keyword_plugin> for the mechanism.
Introduced in Perl 5.18
The ticket for this feature is
-L<[perl #119451]|https://rt.perl.org/rt3/Ticket/Display.html?id=119451>.
+L<[perl #13197]|https://github.com/Perl/perl5/issues/13197>.
See also: L<perlrecharclass/Extended Bracketed Character Classes>
C<experimental::signatures>.
The ticket for this feature is
-L<[perl #121481]|https://rt.perl.org/Ticket/Display.html?id=121481>.
+L<[perl #13681]|https://github.com/Perl/perl5/issues/13681>.
=item Aliasing via reference
C<experimental::refaliasing>.
The ticket for this feature is
-L<[perl #122947]|https://rt.perl.org/rt3/Ticket/Display.html?id=122947>.
+L<[perl #14150]|https://github.com/Perl/perl5/issues/14150>.
See also: L<perlref/Assigning to References>
C<experimental::const_attr>.
The ticket for this feature is
-L<[perl #123630]|https://rt.perl.org/rt3/Ticket/Display.html?id=123630>.
+L<[perl #14428]|https://github.com/Perl/perl5/issues/14428>.
See also: L<perlsub/Constant Functions>
=item The <:win32> IO pseudolayer
The ticket for this feature is
-L<[perl #119453]|https://rt.perl.org/rt3/Ticket/Display.html?id=119453>.
+L<[perl #13198]|https://github.com/Perl/perl5/issues/13198>.
See also L<perlrun>
C<experimental::declared_refs>.
The ticket for this feature is
-L<[perl #128654]|https://rt.perl.org/rt3/Ticket/Display.html?id=128654>.
+L<[perl #15458]|https://github.com/Perl/perl5/issues/15458>.
See also: L<perlref/Declaring a Reference to a Variable>
=item There is an C<installhtml> target in the Makefile.
The ticket for this feature is
-L<[perl #116487]|https://rt.perl.org/rt3/Ticket/Display.html?id=116487>.
+L<[perl #12726]|https://github.com/Perl/perl5/issues/12726>.
=item (Limited) Variable-length look-behind
# 0 1 2
my ($package, $filename, $line) = caller;
+Like L<C<__FILE__>|/__FILE__> and L<C<__LINE__>|/__LINE__>, the filename and
+line number returned here may be altered by the mechanism described at
+L<perlsyn/"Plain Old Comments (Not!)">.
+
With EXPR, it returns some extra information that the debugger uses to
print a stack trace. The value of EXPR indicates how many call frames
to go back before the current one.
=for Pod::Functions the name of the current source file
A special token that returns the name of the file in which it occurs.
+It can be altered by the mechanism described at
+L<perlsyn/"Plain Old Comments (Not!)">.
=item fileno FILEHANDLE
X<fileno>
=for Pod::Functions the current source line number
A special token that compiles to the current line number.
+It can be altered by the mechanism described at
+L<perlsyn/"Plain Old Comments (Not!)">.
=item link OLDFILE,NEWFILE
X<link>
Returns from a subroutine, L<C<eval>|/eval EXPR>,
L<C<do FILE>|/do EXPR>, L<C<sort>|/sort SUBNAME LIST> block or regex
-eval block (but not a L<C<grep>|/grep BLOCK LIST> or
-L<C<map>|/map BLOCK LIST> block) with the value
+eval block (but not a L<C<grep>|/grep BLOCK LIST>,
+L<C<map>|/map BLOCK LIST>, or L<C<do BLOCK>|/do BLOCK> block) with the value
given in EXPR. Evaluation of EXPR may be in list, scalar, or void
context, depending on how the return value will be used, and the context
may vary from one execution to the next (see
where C<err_msg> is an SV.
+=for apidoc Amnh||SVf
+=for apidoc Amh||SVfARG|SV *sv
+
Not all scalar types are printable. Simple values certainly are: one of
IV, UV, NV, or PV. Also, if the SV is a reference to some value,
either it will be dereferenced and the value printed, or information
=head2 Formatted Printing of Strings
-If you just want the bytes printed in a NUL-terminated string, you can
-just use C<%s> (assuming they are all printables). But if there is a
-possibility the value will be encoded as UTF-8, you should instead use
-the C<UTF8f> format. And as its parameter, use the C<UTF8fARG()> macro:
+If you just want the bytes printed in a 7bit NUL-terminated string, you can
+just use C<%s> (assuming they are all really only 7bit). But if there is a
+possibility the value will be encoded as UTF-8 or contains bytes above
+C<0x7F> (and therefore 8bit), you should instead use the C<UTF8f> format.
+And as its parameter, use the C<UTF8fARG()> macro:
chr * msg;
UTF8fARG(can_utf8, strlen(msg), msg));
The first parameter to C<UTF8fARG> is a boolean: 1 if the string is in
-UTF-8; 0 if bytes.
+UTF-8; 0 if string is in native byte encoding (Latin1).
The second parameter is the number of bytes in the string to print.
And the third and final parameter is a pointer to the first byte in the
string.
writers. L<perlintern> is the autogenerated manual for the functions
which are not part of the API and are supposedly for internal use only.
+=for comment
+skip apidoc
+The following is an example and shouldn't be read as a real apidoc line
+
Source documentation is created by putting POD comments into the C
source, like this:
all the relevant system and configuration information.
To browse existing Perl bugs and patches, you can use the web interface
-at L<https://rt.perl.org/>.
+at L<https://github.com/perl/perl5/issues>.
Please check the archive of the perl5-porters list (see below) and/or
the bug tracking system before submitting a bug report. Often, you'll
core) to bring the source code at that commit to a buildable state.
Here's a real world example, taken from work done to resolve
-L<perl #72414|https://rt.perl.org/Ticket/Display.html?id=72414>.
+L<perl #10118|https://github.com/Perl/perl5/issues/10118>.
Use of F<Porting/bisect.pl> had identified commit
C<ba77e4cc9d1ceebf472c9c5c18b2377ee47062e6> as the commit in which a bug was
corrected. To confirm, a P5P developer wanted to configure and build perl at
That is C99 or C++. Some C compilers allow that, but you shouldn't.
-The gcc option C<-Wdeclaration-after-statements> scans for such
+The gcc option C<-Wdeclaration-after-statement> scans for such
problems (by default on starting from Perl 5.9.4).
=item *
=item *
+Perl strings are NOT the same as C strings: They may contain C<NUL>
+characters, whereas a C string is terminated by the first C<NUL>.
+That is why Perl API functions that deal with strings generally take a
+pointer to the first byte and either a length or a pointer to the byte
+just beyond the final one.
+
+And this is the reason that many of the C library string handling
+functions should not be used. They don't cope with the full generality
+of Perl strings. It may be that your test cases don't have embedded
+C<NUL>s, and so the tests pass, whereas there may well eventually arise
+real-world cases where they fail. A lesson here is to include C<NUL>s
+in your tests. Now it's fairly rare in most real world cases to get
+C<NUL>s, so your code may seem to work, until one day a C<NUL> comes
+along.
+
+Here's an example. It used to be a common paradigm, for decades, in the
+perl core to use S<C<strchr("list", c)>> to see if the character C<c> is
+any of the ones given in C<"list">, a double-quote-enclosed string of
+the set of characters that we are seeing if C<c> is one of. As long as
+C<c> isn't a C<NUL>, it works. But when C<c> is a C<NUL>, C<strchr>
+returns a pointer to the terminating C<NUL> in C<"list">. This likely
+will result in a segfault or a security issue when the caller uses that
+end pointer as the starting point to read from.
+
+A solution to this and many similar issues is to use the C<mem>I<-foo> C
+library functions instead. In this case C<memchr> can be used to see if
+C<c> is in C<"list"> and works even if C<c> is C<NUL>. These functions
+need an additional parameter to give the string length.
+In the case of literal string parameters, perl has defined macros that
+calculate the length for you. See L<perlapi/Miscellaneous Functions>.
+
+=item *
+
malloc(0), realloc(0), calloc(0, 0) are non-portable. To be portable
allocate at least one byte. (In general you should rarely need to work
at this low level, but instead use the various malloc wrappers.)
Max M 5.31.4 2019-Sep-20
Steve 5.31.5 2019-Oct-20
BinGOs 5.31.6 2019-Nov-20
+ Nicolas R 5.31.7 2019-Dec-20
=head2 SELECTED RELEASE SIZES
nonassoc named unary operators
nonassoc < > <= >= lt gt le ge
nonassoc == != <=> eq ne cmp ~~
+ nonassoc isa
left &
left | ^
left &&
if ( fc($x) eq fc($y) ) { ... }
+=head2 Class Instance Operator
+X<isa operator>
+
+Binary C<isa> evaluates to true when left argument is an object instance of
+the class (or a subclass derived from that class) given by the right argument.
+If the left argument is not defined, not a blessed object instance, or does
+not derive from the class given by the right argument, the operator evaluates
+as false. The right argument may give the class either as a barename or a
+scalar expression that yields a string class name:
+
+ if( $obj isa Some::Class ) { ... }
+
+ if( $obj isa "Different::Class" ) { ... }
+ if( $obj isa $name_of_class ) { ... }
+
+This is an experimental feature and is available from Perl 5.31.6 when enabled
+by C<use feature 'isa'>. It emits a warning in the C<experimental::isa>
+category.
+
=head2 Smartmatch Operator
First available in Perl 5.10.1 (the 5.10.0 version behaved differently),
The pack code C<w> has been added to support a portable binary data
encoding scheme that goes way beyond simple integers. (Details can
-be found at L<http://Casbah.org/>, the Scarab project.) A BER (Binary Encoded
+be found at L<https://github.com/mworks-project/mw_scarab/blob/master/Scarab-0.1.00d19/doc/binary-serialization.txt>,
+the Scarab project.) A BER (Binary Encoded
Representation) compressed unsigned integer stores base 128
digits, most significant digit first, with as few digits as possible.
Bit eight (the high bit) is set on each byte except the last. There
=head1 STANDARDS OF CONDUCT
The official forum for the development of perl is the perl5-porters mailing
-list, mentioned above, and its bugtracker at rt.perl.org. Posting to the
+list, mentioned above, and its bugtracker at GitHub. Posting to the
list and the bugtracker is not a right: all participants in discussion are
expected to adhere to a standard of conduct.
Unacceptable behavior will result in a public and clearly identified
warning. A second instance of unacceptable behavior from the same
-individual will result in removal from the mailing list and rt.perl.org,
-for a period of one calendar month. The rationale for this is to
+individual will result in removal from the mailing list and GitHub issue
+tracker, for a period of one calendar month. The rationale for this is to
provide an opportunity for the person to change the way they act.
After the time-limited ban has been lifted, a third instance of
=item *
F<ext/XS-APItest/t/call_checker.t> - see
-L<https://rt.perl.org/Ticket/Display.html?id=78502>
+L<https://github.com/Perl/perl5/issues/10750>
=item *
(?:...) Groups subexpressions without capturing (cluster)
(?pimsx-imsx:...) Enable/disable option (as per m// modifiers)
(?=...) Zero-width positive lookahead assertion
- (?*pla:...) Same, starting in 5.32; experimentally in 5.28
- (?*positive_lookahead:...) Same, same versions as *pla
+ (*pla:...) Same, starting in 5.32; experimentally in 5.28
+ (*positive_lookahead:...) Same, same versions as *pla
(?!...) Zero-width negative lookahead assertion
- (?*nla:...) Same, starting in 5.32; experimentally in 5.28
- (?*negative_lookahead:...) Same, same versions as *nla
+ (*nla:...) Same, starting in 5.32; experimentally in 5.28
+ (*negative_lookahead:...) Same, same versions as *nla
(?<=...) Zero-width positive lookbehind assertion
- (?*plb:...) Same, starting in 5.32; experimentally in 5.28
- (?*positive_lookbehind:...) Same, same versions as *plb
+ (*plb:...) Same, starting in 5.32; experimentally in 5.28
+ (*positive_lookbehind:...) Same, same versions as *plb
(?<!...) Zero-width negative lookbehind assertion
- (?*nlb:...) Same, starting in 5.32; experimentally in 5.28
- (?*negative_lookbehind:...) Same, same versions as *plb
+ (*nlb:...) Same, starting in 5.32; experimentally in 5.28
+ (*negative_lookbehind:...) Same, same versions as *plb
(?>...) Grab what we can, prohibit backtracking
- (?*atomic:...) Same, starting in 5.32; experimentally in 5.28
+ (*atomic:...) Same, starting in 5.32; experimentally in 5.28
(?|...) Branch reset
(?<name>...) Named capture
(?'name'...) Named capture
Birrell, Andrew D. An Introduction to Programming with
Threads. Digital Equipment Corporation, 1989, DEC-SRC Research Report
#35 online as
-L<ftp://ftp.dec.com/pub/DEC/SRC/research-reports/SRC-035.pdf>
+L<https://www.hpl.hp.com/techreports/Compaq-DEC/SRC-RR-35.pdf>
(highly recommended)
Robbins, Kay. A., and Steven Robbins. Practical Unix Programming: A
whose names begin with C<"In"> or C<"Is">. (The experimental feature
L<perlre/(?[ ])> provides an alternative which allows more complex
definitions.) The subroutines can be defined in any
-package. The user-defined properties can be used in the regular expression
+package. They override any Unicode properties expressed as the same
+names. The user-defined properties can be used in the regular
+expression
C<\p{}> and C<\P{}> constructs; if you are using a user-defined property from a
package other than the one you are in, you must specify its package in the
C<\p{}> or C<\P{}> construct.
rectify this have been scrapped, as users found that rewriting a
pending exception is actually a useful feature, and not a bug.
-The C<$SIG{__DIE__}> doesn't support C<'IGNORE'>, it has the same
+The C<$SIG{__DIE__}> doesn't support C<'IGNORE'>; it has the same
effect as C<'DEFAULT'>.
C<__DIE__>/C<__WARN__> handlers are very special in one respect: they
This variable was added in Perl 5.8.2 and removed in 5.26.0.
Setting it to anything other than C<undef> was made fatal in Perl 5.28.0.
-=item ${^FEATURE_BITS}
-X<${^FEATURE_BITS}>
-
-The current set of features enabled by the C<use feature> pragma. It
-has the same scoping as the C<$^H> and C<%^H> variables. The exact
-values are considered internal to the L<feature> pragma and may change
-between versions of Perl.
-
-This variable was added in Perl v5.32.0.
-
=item ${^GLOBAL_PHASE}
X<${^GLOBAL_PHASE}>
return NORMAL;
}
+PP(pp_isa)
+{
+ dSP;
+ SV *left, *right;
+
+ right = POPs;
+ left = TOPs;
+
+ SETs(boolSV(sv_isa_sv(left, right)));
+ RETURN;
+}
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
}
for (t1 = SvPVX_const(sv); *t1; t1++)
#ifdef __VMS
- if (strchr("*%?", *t1))
+ if (memCHRs("*%?", *t1))
#else
- if (strchr("$&*(){}[]'\";\\|?<>~`", *t1))
+ if (memCHRs("$&*(){}[]'\";\\|?<>~`", *t1))
#endif
break;
if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &statbuf) < 0) {
} /* End of switch */
if (checksum) {
- if (strchr("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
+ if (memCHRs("fFdD", TYPE_NO_MODIFIERS(datumtype)) ||
(checksum > bits_in_uv &&
- strchr("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
+ memCHRs("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) {
NV trouble, anv;
anv = (NV) (1 << (checksum & 15));
switch (howlen) {
case e_star:
- len = strchr("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
+ len = memCHRs("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ?
0 : items;
break;
default:
if (symptr->flags & FLAG_SLASH) {
IV count;
if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack");
- if (strchr("aAZ", lookahead.code)) {
+ if (memCHRs("aAZ", lookahead.code)) {
if (lookahead.howlen == e_number) count = lookahead.length;
else {
if (items > 0) {
PERL_CALLCONV OP *Perl_pp_int(pTHX);
PERL_CALLCONV OP *Perl_pp_introcv(pTHX);
PERL_CALLCONV OP *Perl_pp_ioctl(pTHX);
+PERL_CALLCONV OP *Perl_pp_isa(pTHX);
PERL_CALLCONV OP *Perl_pp_iter(pTHX);
PERL_CALLCONV OP *Perl_pp_join(pTHX);
PERL_CALLCONV OP *Perl_pp_kvaslice(pTHX);
#define PERL_ARGS_ASSERT_CK_INDEX \
assert(o)
+PERL_CALLCONV OP * Perl_ck_isa(pTHX_ OP *o)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_CK_ISA \
+ assert(o)
+
PERL_CALLCONV OP * Perl_ck_join(pTHX_ OP *o)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_CK_JOIN \
PERL_CALLCONV int Perl_sv_isa(pTHX_ SV* sv, const char *const name);
#define PERL_ARGS_ASSERT_SV_ISA \
assert(name)
+PERL_CALLCONV bool Perl_sv_isa_sv(pTHX_ SV* sv, SV* namesv)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_SV_ISA_SV \
+ assert(sv); assert(namesv)
+
PERL_CALLCONV int Perl_sv_isobject(pTHX_ SV* sv);
#define PERL_ARGS_ASSERT_SV_ISOBJECT
#ifndef NO_MATHOMS
#define PERL_ARGS_ASSERT_EDIT_DISTANCE \
assert(src); assert(tgt)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE Size_t S_find_first_differing_byte_pos(const U8 * s1, const U8 * s2, const Size_t max);
+#define PERL_ARGS_ASSERT_FIND_FIRST_DIFFERING_BYTE_POS \
+ assert(s1); assert(s2)
+#endif
STATIC SV * S_get_ANYOFM_contents(pTHX_ const regnode * n)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_GET_ANYOFM_CONTENTS \
assert(invlist)
#endif
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE UV S_invlist_lowest(SV* const invlist)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_INVLIST_LOWEST \
+ assert(invlist)
+#endif
+
STATIC bool S_is_ssc_worth_it(const RExC_state_t * pRExC_state, const regnode_ssc * ssc);
#define PERL_ARGS_ASSERT_IS_SSC_WORTH_IT \
assert(pRExC_state); assert(ssc)
#define PERL_ARGS_ASSERT__INVLIST_DUMP \
assert(file); assert(indent); assert(invlist)
#endif
-#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
-#ifndef PERL_NO_INLINE_FUNCTIONS
-PERL_STATIC_INLINE SV* S_add_cp_to_invlist(pTHX_ SV* invlist, const UV cp)
- __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_ADD_CP_TO_INVLIST
-#endif
-
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C)
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE STRLEN* S_get_invlist_iter_addr(SV* invlist)
__attribute__warn_unused_result__;
#endif
#ifndef PERL_NO_INLINE_FUNCTIONS
-PERL_STATIC_INLINE void S_invlist_extend(pTHX_ SV* const invlist, const UV len);
-#define PERL_ARGS_ASSERT_INVLIST_EXTEND \
- assert(invlist)
-#endif
-#ifndef PERL_NO_INLINE_FUNCTIONS
-PERL_STATIC_INLINE UV S_invlist_highest(SV* const invlist)
- __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_INVLIST_HIGHEST \
- assert(invlist)
-#endif
-
-#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE void S_invlist_iterfinish(SV* invlist);
#define PERL_ARGS_ASSERT_INVLIST_ITERFINISH \
assert(invlist)
assert(invlist); assert(start); assert(end)
#endif
+#endif
+#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_DOOP_C)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE SV* S_add_cp_to_invlist(pTHX_ SV* invlist, const UV cp)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_ADD_CP_TO_INVLIST
+#endif
+
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE void S_invlist_extend(pTHX_ SV* const invlist, const UV len);
+#define PERL_ARGS_ASSERT_INVLIST_EXTEND \
+ assert(invlist)
+#endif
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE UV S_invlist_highest(SV* const invlist)
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_INVLIST_HIGHEST \
+ assert(invlist)
+#endif
+
#ifndef PERL_NO_INLINE_FUNCTIONS
PERL_STATIC_INLINE void S_invlist_set_len(pTHX_ SV* const invlist, const UV len, const bool offset);
#define PERL_ARGS_ASSERT_INVLIST_SET_LEN \
#define PERL_ARGS_ASSERT_TO_UTF8_SUBSTR \
assert(prog)
#endif
-#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C)
-PERL_CALLCONV bool Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 *strend, const UV cp)
+#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C)
+PERL_CALLCONV bool Perl_is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 *strend, const UV cp)
__attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT__IS_GRAPHEME \
+#define PERL_ARGS_ASSERT_IS_GRAPHEME \
assert(strbeg); assert(s); assert(strend)
#endif
* 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
* 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
* 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
- * 08071cd168b1ac72bf01f13a82c4d0470a391e2bdd0b706e9fe20ab17cc861c8 lib/unicore/mktables
+ * 498da0b9ef6a52bfd71bda5771005bbe4cfc37b456d9d350cd840991eb80c8b1 lib/unicore/mktables
* a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
* 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
* f9a393e7add8c7c2728356473ce5b52246d51295b2da0c48fb6f0aa21799e2bb regen/regcharclass.pl
/* Certain characters are output as a sequence with the first being a
* backslash. */
-#define isBACKSLASHED_PUNCT(c) strchr("-[]\\^", c)
+#define isBACKSLASHED_PUNCT(c) memCHRs("-[]\\^", c)
struct RExC_state_t {
/* Change from /d into /u rules, and restart the parse. RExC_uni_semantics is
* a flag that indicates we need to override /d with /u as a result of
* something in the pattern. It should only be used in regards to calling
- * set_regex_charset() or get_regex_charse() */
+ * set_regex_charset() or get_regex_charset() */
#define REQUIRE_UNI_RULES(flagp, restart_retval) \
STMT_START { \
if (DEPENDS_SEMANTICS) { \
#define _invlist_intersection_complement_2nd(a, b, output) \
_invlist_intersection_maybe_complement_2nd(a, b, TRUE, output)
+/* We add a marker if we are deferring expansion of a potential user-defined
+ * property until it is needed at runtime the first time it is encountered in a
+ * pattern match. This marker that shouldn't conflict with any that could be
+ * in a legal name is appended to its name to indicate this. There is a string
+ * and character form */
+#define DEFERRED_PROP_EXPANSION_MARKERs "~"
+#define DEFERRED_PROP_EXPANSION_MARKERc '~'
+
/* About scan_data_t.
During optimisation we recurse through the regexp program performing
populate_ANYOF_from_invlist( (regnode *) ssc, &invlist);
set_ANYOF_arg(pRExC_state, (regnode *) ssc, invlist, NULL, NULL);
+ SvREFCNT_dec(invlist);
/* Make sure is clone-safe */
ssc->invlist = NULL;
if ( SvIV(re_trie_maxbuff)>=0 ) {
regnode *cur;
regnode *first = (regnode *)NULL;
- regnode *last = (regnode *)NULL;
+ regnode *prev = (regnode *)NULL;
regnode *tail = scan;
U8 trietype = 0;
U32 count=0;
REG_NODE_NUM(noper_next), SvPV_nolen_const(RExC_mysv));
}
Perl_re_printf( aTHX_ "(First==%d,Last==%d,Cur==%d,tt==%s,ntt==%s,nntt==%s)\n",
- REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur),
+ REG_NODE_NUM(first), REG_NODE_NUM(prev), REG_NODE_NUM(cur),
PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype]
);
});
} else {
if ( trietype == NOTHING )
trietype = noper_trietype;
- last = cur;
+ prev = cur;
}
if (first)
count++;
* noper may either be a triable node which can
* not be tried together with the current trie,
* or a non triable node */
- if ( last ) {
+ if ( prev ) {
/* If last is set and trietype is not
* NOTHING then we have found at least two
* triable branch sequences in a row of a
make_trie( pRExC_state,
startbranch, first, cur, tail,
count, trietype, depth+1 );
- last = NULL; /* note: we clear/update
+ prev = NULL; /* note: we clear/update
first, trietype etc below,
so we dont do it here */
}
Perl_re_indentf( aTHX_ "- %s (%d) <SCAN FINISHED> ",
depth+1, SvPV_nolen_const( RExC_mysv ), REG_NODE_NUM(cur));
Perl_re_printf( aTHX_ "(First==%d, Last==%d, Cur==%d, tt==%s)\n",
- REG_NODE_NUM(first), REG_NODE_NUM(last), REG_NODE_NUM(cur),
+ REG_NODE_NUM(first), REG_NODE_NUM(prev), REG_NODE_NUM(cur),
PL_reg_name[trietype]
);
});
- if ( last && trietype ) {
+ if ( prev && trietype ) {
if ( trietype != NOTHING ) {
/* the last branch of the sequence was part of
* a trie, so we have to construct it here
OP(opt)= OPTIMIZED;
}
}
- } /* end if ( last) */
+ } /* end if ( prev) */
} /* TRIE_MAXBUF is non zero */
-
} /* do trie */
}
case ANYOFH:
case ANYOFHb:
case ANYOFHr:
+ case ANYOFHs:
case ANYOF:
if (flags & SCF_DO_STCLASS_AND)
ssc_and(pRExC_state, data->start_class,
DEBUG_r(if (!PL_colorset) reginitcolors());
- /* Initialize these here instead of as-needed, as is quick and avoids
- * having to test them each time otherwise */
- if (! PL_InBitmap) {
-#ifdef DEBUGGING
- char * dump_len_string;
-#endif
-
- /* This is calculated here, because the Perl program that generates the
- * static global ones doesn't currently have access to
- * NUM_ANYOF_CODE_POINTS */
- PL_InBitmap = _new_invlist(2);
- PL_InBitmap = _add_range_to_invlist(PL_InBitmap, 0,
- NUM_ANYOF_CODE_POINTS - 1);
-#ifdef DEBUGGING
- dump_len_string = PerlEnv_getenv("PERL_DUMP_RE_MAX_LEN");
- if ( ! dump_len_string
- || ! grok_atoUV(dump_len_string, (UV *)&PL_dump_re_max_len, NULL))
- {
- PL_dump_re_max_len = 60; /* A reasonable default */
- }
-#endif
- }
pRExC_state->warn_text = NULL;
pRExC_state->unlexed_names = NULL;
i = rx->sublen + rx->suboffset - rx->offs[0].end;
}
else
- if ( 0 <= n && n <= (I32)rx->nparens &&
- (s1 = rx->offs[n].start) != -1 &&
+ if (inRANGE(n, 0, (I32)rx->nparens) &&
+ (s1 = rx->offs[n].start) != -1 &&
(t1 = rx->offs[n].end) != -1)
{
/* $&, ${^MATCH}, $1 ... */
#endif
+PERL_STATIC_INLINE UV
+S_invlist_lowest(SV* const invlist)
+{
+ /* Returns the lowest code point that matches an inversion list. This API
+ * has an ambiguity, as it returns 0 under either the lowest is actually
+ * 0, or if the list is empty. If this distinction matters to you, check
+ * for emptiness before calling this function */
+
+ UV len = _invlist_len(invlist);
+ UV *array;
+
+ PERL_ARGS_ASSERT_INVLIST_LOWEST;
+
+ if (len == 0) {
+ return 0;
+ }
+
+ array = invlist_array(invlist);
+
+ return array[0];
+}
+
STATIC SV *
S_invlist_contents(pTHX_ SV* const invlist, const bool traditional_style)
{
}
while (RExC_parse < RExC_end) {
- /* && strchr("iogcmsx", *RExC_parse) */
+ /* && memCHRs("iogcmsx", *RExC_parse) */
/* (?g), (?gc) and (?o) are useless here
and must be globally applied -- japhy */
switch (*RExC_parse) {
RExC_parse-seqstart, seqstart);
NOT_REACHED; /*NOTREACHED*/
case '<': /* (?<...) */
+ /* If you want to support (?<*...), first reconcile with GH #17363 */
if (*RExC_parse == '!')
paren = ',';
else if (*RExC_parse != '=')
ckWARNreg(RExC_parse, "Empty (?) without any modifiers");
}
/* FALLTHROUGH */
+ case '*': /* If you want to support (?*...), first reconcile with GH #17363 */
+ /* FALLTHROUGH */
default: /* e.g., (?i) */
RExC_parse = (char *) seqstart + 1;
parse_flags:
value = (U8 *) SvPV(value_sv, value_len);
/* See if the result is one code point vs 0 or multiple */
- if (value_len > 0 && value_len <= (UV) ((SvUTF8(value_sv))
- ? UTF8SKIP(value)
- : 1))
+ if (inRANGE(value_len, 1, ((UV) SvUTF8(value_sv)
+ ? UTF8SKIP(value)
+ : 1)))
{
/* Here, exactly one code point. If that isn't what is wanted,
* fail */
goto continue_parse;
}
- else if (! LOC) { /* XXX shouldn't /l assume could be a UTF-8
- locale, and prepare for that? */
+ else if (FOLD) {
bool splittable = FALSE;
bool backed_up = FALSE;
- char * e = s;
-
- assert(FOLD);
+ char * e;
+ char * s_start;
/* Here is /i. Running out of room creates a problem if we are
* folding, and the split happens in the middle of a
* oldp points to the beginning byte in the input of
* 'ender'.
*
+ * In the case of /il, we haven't folded anything that could be
+ * affected by the locale. That means only above-Latin1
+ * characters that fold to other above-latin1 characters get
+ * folded at compile time. To check where a good place to
+ * split nodes is, everything in it will have to be folded.
+ * The boolean 'maybe_exactfu' keeps track in /il if there are
+ * any unfolded characters in the node. */
+ bool need_to_fold_loc = LOC && ! maybe_exactfu;
+
+ /* If we do need to fold the node, we need a place to store the
+ * folded copy, and a way to map back to the unfolded original
+ * */
+ char * locfold_buf = NULL;
+ Size_t * loc_correspondence = NULL;
+
+ if (! need_to_fold_loc) { /* The normal case. Just
+ initialize to the actual node */
+ e = s;
+ s_start = s0;
+ s = old_old_s; /* Point to the beginning of the final char
+ that fits in the node */
+ }
+ else {
+
+ /* Here, we have filled a /il node, and there are unfolded
+ * characters in it. If the runtime locale turns out to be
+ * UTF-8, there are possible multi-character folds, just
+ * like when not under /l. The node hence can't terminate
+ * in the middle of such a fold. To determine this, we
+ * have to create a folded copy of this node. That means
+ * reparsing the node, folding everything assuming a UTF-8
+ * locale. (If at runtime it isn't such a locale, the
+ * actions here wouldn't have been necessary, but we have
+ * to assume the worst case.) If we find we need to back
+ * off the folded string, we do so, and then map that
+ * position back to the original unfolded node, which then
+ * gets output, truncated at that spot */
+
+ char * redo_p = RExC_parse;
+ char * redo_e;
+ char * old_redo_e;
+
+ /* Allow enough space assuming a single byte input folds to
+ * a single byte output, plus assume that the two unparsed
+ * characters (that we may need) fold to the largest number
+ * of bytes possible, plus extra for one more worst case
+ * scenario. In the loop below, if we start eating into
+ * that final spare space, we enlarge this initial space */
+ Size_t size = max_string_len + (3 * UTF8_MAXBYTES_CASE) + 1;
+
+ Newxz(locfold_buf, size, char);
+ Newxz(loc_correspondence, size, Size_t);
+
+ /* Redo this node's parse, folding into 'locfold_buf' */
+ redo_p = RExC_parse;
+ old_redo_e = redo_e = locfold_buf;
+ while (redo_p <= oldp) {
+
+ old_redo_e = redo_e;
+ loc_correspondence[redo_e - locfold_buf]
+ = redo_p - RExC_parse;
+
+ if (UTF) {
+ Size_t added_len;
+
+ (void) _to_utf8_fold_flags((U8 *) redo_p,
+ (U8 *) RExC_end,
+ (U8 *) redo_e,
+ &added_len,
+ FOLD_FLAGS_FULL);
+ redo_e += added_len;
+ redo_p += UTF8SKIP(redo_p);
+ }
+ else {
+
+ /* Note that if this code is run on some ancient
+ * Unicode versions, SHARP S doesn't fold to 'ss',
+ * but rather than clutter the code with #ifdef's,
+ * as is done above, we ignore that possibility.
+ * This is ok because this code doesn't affect what
+ * gets matched, but merely where the node gets
+ * split */
+ if (UCHARAT(redo_p) != LATIN_SMALL_LETTER_SHARP_S) {
+ *redo_e++ = toLOWER_L1(UCHARAT(redo_p));
+ }
+ else {
+ *redo_e++ = 's';
+ *redo_e++ = 's';
+ }
+ redo_p++;
+ }
+
+
+ /* If we're getting so close to the end that a
+ * worst-case fold in the next character would cause us
+ * to overflow, increase, assuming one byte output byte
+ * per one byte input one, plus room for another worst
+ * case fold */
+ if ( redo_p <= oldp
+ && redo_e > locfold_buf + size
+ - (UTF8_MAXBYTES_CASE + 1))
+ {
+ Size_t new_size = size
+ + (oldp - redo_p)
+ + UTF8_MAXBYTES_CASE + 1;
+ Ptrdiff_t e_offset = redo_e - locfold_buf;
+
+ Renew(locfold_buf, new_size, char);
+ Renew(loc_correspondence, new_size, Size_t);
+ size = new_size;
+
+ redo_e = locfold_buf + e_offset;
+ }
+ }
+
+ /* Set so that things are in terms of the folded, temporary
+ * string */
+ s = old_redo_e;
+ s_start = locfold_buf;
+ e = redo_e;
+
+ }
+
+ /* Here, we have 's', 's_start' and 'e' set up to point to the
+ * input that goes into the node, folded.
+ *
* If the final character of the node and the fold of ender
* form the first two characters of a three character fold, we
* need to peek ahead at the next (unparsed) character in the
* and try again.
*
* Otherwise, the node can be split at the current position.
- */
- s = old_old_s; /* Point to the beginning of the final char
- that fits in the node */
-
- /* The same logic is used for UTF-8 patterns and not */
+ *
+ * The same logic is used for UTF-8 patterns and not */
if (UTF) {
Size_t added_len;
* drop down to try at that position */
if (isPUNCT(*p)) {
s = (char *) utf8_hop_back((U8 *) s, -1,
- (U8 *) s0);
+ (U8 *) s_start);
backed_up = TRUE;
}
else {
* either case would break apart a fold */
do {
char *prev_s = (char *) utf8_hop_back((U8 *) s, -1,
- (U8 *) s0);
+ (U8 *) s_start);
/* If is a multi-char fold, can't split here. Backup
* one char and try again */
* three character fold starting at the character
* before s, we can't split either before or after s.
* Backup two chars and try again */
- if ( LIKELY(s > s0)
+ if ( LIKELY(s > s_start)
&& UNLIKELY(is_THREE_CHAR_FOLD_utf8_safe(prev_s, e)))
{
s = prev_s;
- s = (char *) utf8_hop_back((U8 *) s, -1, (U8 *) s0);
+ s = (char *) utf8_hop_back((U8 *) s, -1, (U8 *) s_start);
backed_up = TRUE;
continue;
}
splittable = TRUE;
break;
- } while (s > s0); /* End of loops backing up through the node */
+ } while (s > s_start); /* End of loops backing up through the node */
/* Here we either couldn't find a place to split the node,
* or else we broke out of the loop setting 'splittable' to
continue;
}
- if ( LIKELY(s > s0)
+ if ( LIKELY(s > s_start)
&& UNLIKELY(is_THREE_CHAR_FOLD_latin1_safe(s - 1, e)))
{
s -= 2;
splittable = TRUE;
break;
- } while (s > s0);
+ } while (s > s_start);
if (splittable) {
s++;
/* If we did find a place to split, reparse the entire node
* stopping where we have calculated. */
if (splittable) {
- upper_fill = s - s0;
+
+ /* If we created a temporary folded string under /l, we
+ * have to map that back to the original */
+ if (need_to_fold_loc) {
+ upper_fill = loc_correspondence[s - s_start];
+ Safefree(locfold_buf);
+ Safefree(loc_correspondence);
+
+ if (upper_fill == 0) {
+ FAIL2("panic: loc_correspondence[%d] is 0",
+ (int) (s - s_start));
+ }
+ }
+ else {
+ upper_fill = s - s0;
+ }
goto reparse;
}
+ else if (need_to_fold_loc) {
+ Safefree(locfold_buf);
+ Safefree(loc_correspondence);
+ }
/* Here the node consists entirely of non-final multi-char
* folds. (Likely it is all 'f's or all 's's.) There's no
UPDATE_WARNINGS_LOC(RExC_parse);
}
+PERL_STATIC_INLINE Size_t
+S_find_first_differing_byte_pos(const U8 * s1, const U8 * s2, const Size_t max)
+{
+ const U8 * const start = s1;
+ const U8 * const send = start + max;
+
+ PERL_ARGS_ASSERT_FIND_FIRST_DIFFERING_BYTE_POS;
+
+ while (s1 < send && *s1 == *s2) {
+ s1++; s2++;
+ }
+
+ return s1 - start;
+}
+
+
STATIC AV *
S_add_multi_match(pTHX_ AV* multi_char_matches, SV* multi_string, const STRLEN cp_count)
{
|= ANYOFL_FOLD
| ANYOFL_SHARED_UTF8_LOCALE_fold_HAS_MATCHES_nonfold_REQD;
}
- else if (cp_list) { /* Look to see if a 0-255 code point is in list */
- UV start, end;
- invlist_iterinit(cp_list);
- if (invlist_iternext(cp_list, &start, &end) && start < 256) {
- anyof_flags |= ANYOFL_FOLD;
- has_runtime_dependency |= HAS_L_RUNTIME_DEPENDENCY;
- }
- invlist_iterfinish(cp_list);
+ else if (cp_list && invlist_lowest(cp_list) < 256) {
+ /* If nothing is below 256, has no locale dependency; otherwise it
+ * does */
+ anyof_flags |= ANYOFL_FOLD;
+ has_runtime_dependency |= HAS_L_RUNTIME_DEPENDENCY;
}
}
else if ( DEPENDS_SEMANTICS
/* Only try if there are no more code points in the class than
* in the max possible fold */
- && partial_cp_count > 0 && partial_cp_count <= MAX_FOLD_FROMS + 1)
+ && inRANGE(partial_cp_count, 1, MAX_FOLD_FROMS + 1))
{
if (partial_cp_count == 1 && ! upper_latin1_only_utf8_matches)
{
* convert to UTF-8 if not already there */
if (value > 255) {
if (! UTF) {
-
SvREFCNT_dec(cp_list);;
REQUIRE_UTF8(flagp);
}
len = (UTF) ? UVCHR_SKIP(value) : 1;
- ret = regnode_guts(pRExC_state, op, len, "exact");
- FILL_NODE(ret, op);
- RExC_emit += 1 + STR_SZ(len);
- setSTR_LEN(REGNODE_p(ret), len);
- if (len == 1) {
- *STRING(REGNODE_p(ret)) = (U8) value;
- }
- else {
- uvchr_to_utf8((U8 *) STRING(REGNODE_p(ret)), value);
- }
- goto not_anyof;
+ ret = regnode_guts(pRExC_state, op, len, "exact");
+ FILL_NODE(ret, op);
+ RExC_emit += 1 + STR_SZ(len);
+ setSTR_LEN(REGNODE_p(ret), len);
+ if (len == 1) {
+ *STRINGs(REGNODE_p(ret)) = (U8) value;
+ }
+ else {
+ uvchr_to_utf8((U8 *) STRINGs(REGNODE_p(ret)), value);
+ }
+ goto not_anyof;
}
}
U8 low_utf8[UTF8_MAXBYTES+1];
UV highest_cp = invlist_highest(cp_list);
- op = ANYOFH;
-
/* Currently the maximum allowed code point by the system is
* IV_MAX. Higher ones are reserved for future internal use. This
* particular regnode can be used for higher ones, but we can't
* calculate the code point of those. IV_MAX suffices though, as
* it will be a large first byte */
- (void) uvchr_to_utf8(low_utf8, MIN(start[0], IV_MAX));
+ Size_t low_len = uvchr_to_utf8(low_utf8, MIN(start[0], IV_MAX))
+ - low_utf8;
/* We store the lowest possible first byte of the UTF-8
* representation, using the flags field. This allows for quick
* transformation would not rule out nearly so many things */
anyof_flags = NATIVE_UTF8_TO_I8(low_utf8[0]);
+ op = ANYOFH;
+
/* If the first UTF-8 start byte for the highest code point in the
* range is suitably small, we may be able to get an upper bound as
* well */
if (highest_cp <= IV_MAX) {
U8 high_utf8[UTF8_MAXBYTES+1];
-
- (void) uvchr_to_utf8(high_utf8, highest_cp);
+ Size_t high_len = uvchr_to_utf8(high_utf8, highest_cp)
+ - high_utf8;
/* If the lowest and highest are the same, we can get an exact
- * first byte instead of a just minimum. We signal this with a
- * different regnode */
+ * first byte instead of a just minimum or even a sequence of
+ * exact leading bytes. We signal these with different
+ * regnodes */
if (low_utf8[0] == high_utf8[0]) {
+ Size_t len = find_first_differing_byte_pos(low_utf8,
+ high_utf8,
+ MIN(low_len, high_len));
+
+ if (len == 1) {
- /* No need to convert to I8 for EBCDIC as this is an exact
- * match */
- anyof_flags = low_utf8[0];
- op = ANYOFHb;
+ /* No need to convert to I8 for EBCDIC as this is an
+ * exact match */
+ anyof_flags = low_utf8[0];
+ op = ANYOFHb;
+ }
+ else {
+ op = ANYOFHs;
+ ret = regnode_guts(pRExC_state, op,
+ regarglen[op] + STR_SZ(len),
+ "anyofhs");
+ FILL_NODE(ret, op);
+ ((struct regnode_anyofhs *) REGNODE_p(ret))->str_len
+ = len;
+ Copy(low_utf8, /* Add the common bytes */
+ ((struct regnode_anyofhs *) REGNODE_p(ret))->string,
+ len, U8);
+ RExC_emit += NODE_SZ_STR(REGNODE_p(ret));
+ set_ANYOF_arg(pRExC_state, REGNODE_p(ret), cp_list,
+ NULL, only_utf8_locale_list);
+ goto not_anyof;
+ }
}
else if (NATIVE_UTF8_TO_I8(high_utf8[0]) <= MAX_ANYOF_HRx_BYTE)
{
set_ANYOF_arg(pRExC_state, REGNODE_p(ret), cp_list,
(HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION)
- ? listsv : NULL,
+ ? listsv
+ : NULL,
only_utf8_locale_list);
+ SvREFCNT_dec(cp_list);;
+ SvREFCNT_dec(only_utf8_locale_list);
return ret;
not_anyof:
Set_Node_Offset_Length(REGNODE_p(ret), orig_parse - RExC_start,
RExC_parse - orig_parse);;
SvREFCNT_dec(cp_list);;
+ SvREFCNT_dec(only_utf8_locale_list);
return ret;
}
SV *rv;
if (cp_list) {
- av_store(av, INVLIST_INDEX, cp_list);
+ av_store(av, INVLIST_INDEX, SvREFCNT_inc_NN(cp_list));
}
if (only_utf8_locale_list) {
- av_store(av, ONLY_LOCALE_MATCHES_INDEX, only_utf8_locale_list);
+ av_store(av, ONLY_LOCALE_MATCHES_INDEX,
+ SvREFCNT_inc_NN(only_utf8_locale_list));
}
if (runtime_defns) {
- av_store(av, DEFERRED_USER_DEFINED_INDEX, SvREFCNT_inc(runtime_defns));
+ av_store(av, DEFERRED_USER_DEFINED_INDEX,
+ SvREFCNT_inc_NN(runtime_defns));
}
rv = newRV_noinc(MUTABLE_SV(av));
STATIC_ASSERT_STMT(ONLY_LOCALE_MATCHES_INDEX == 1 + INVLIST_INDEX);
STATIC_ASSERT_STMT(DEFERRED_USER_DEFINED_INDEX == 1 + ONLY_LOCALE_MATCHES_INDEX);
- av_store(av, INVLIST_INDEX, invlist);
+ ary[INVLIST_INDEX] = invlist;
av_fill(av, (ary[ONLY_LOCALE_MATCHES_INDEX])
- ? ONLY_LOCALE_MATCHES_INDEX:
- INVLIST_INDEX);
+ ? ONLY_LOCALE_MATCHES_INDEX
+ : INVLIST_INDEX);
si = NULL;
}
}
UV prev_cp = 0;
U8 count = 0;
- /* Ignore everything before the first new-line */
- while (*si_string != '\n' && remaining > 0) {
- si_string++;
- remaining--;
- }
- assert(remaining > 0);
-
+ /* Ignore everything before and including the first new-line */
+ si_string = (const char *) memchr(si_string, '\n', SvCUR(si));
+ assert (si_string != NULL);
si_string++;
- remaining--;
+ remaining = SvPVX(si) + SvCUR(si) - si_string;
while (remaining > 0) {
continue;
}
- /* Here, didn't find a legal hex number. Just add it from
- * here to the next \n */
+ /* Here, didn't find a legal hex number. Just add the text
+ * from here up to the next \n, omitting any trailing
+ * markers. */
remaining -= len;
- while (*(si_string + len) != '\n' && remaining > 0) {
- remaining--;
- len++;
- }
- if (*(si_string + len) == '\n') {
- len++;
- remaining--;
- }
+ len = strcspn(si_string,
+ DEFERRED_PROP_EXPANSION_MARKERs "\n");
+ remaining -= len;
if (matches_string) {
- sv_catpvn(matches_string, si_string, len - 1);
+ sv_catpvn(matches_string, si_string, len);
}
else {
- matches_string = newSVpvn(si_string, len - 1);
+ matches_string = newSVpvn(si_string, len);
}
- si_string += len;
sv_catpvs(matches_string, " ");
+
+ si_string += len;
+ if ( remaining
+ && UCHARAT(si_string)
+ == DEFERRED_PROP_EXPANSION_MARKERc)
+ {
+ si_string++;
+ remaining--;
+ }
+ if (remaining && UCHARAT(si_string) == '\n') {
+ si_string++;
+ remaining--;
+ }
} /* end of loop through the text */
assert(matches_string);
S_regnode_guts(pTHX_ RExC_state_t *pRExC_state, const U8 op, const STRLEN extra_size, const char* const name)
{
/* Allocate a regnode for 'op', with 'extra_size' extra (smallest) regnode
- * equivalents space. It aligns and increments RExC_size and RExC_emit
+ * equivalents space. It aligns and increments RExC_size
*
* It returns the regnode's offset into the regex engine program */
scan = REGNODE_OFFSET(temp);
}
+ assert(val >= scan);
if (reg_off_by_arg[OP(REGNODE_p(scan))]) {
assert((UV) (val - scan) <= U32_MAX);
ARG_SET(REGNODE_p(scan), val - scan);
/* And finally the matching, closing ']' */
Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]);
- if (inRANGE(OP(o), ANYOFH, ANYOFRb)) {
+ if (OP(o) == ANYOFHs) {
+ Perl_sv_catpvf(aTHX_ sv, " (Leading UTF-8 bytes=%s", _byte_dump_string((U8 *) ((struct regnode_anyofhs *) o)->string, FLAGS(o), 1));
+ }
+ else if (inRANGE(OP(o), ANYOFH, ANYOFRb)) {
U8 lowest = (OP(o) != ANYOFHr)
? FLAGS(o)
: LOWEST_ANYOF_HRx_BYTE(FLAGS(o));
else if ( op == PLUS || op == STAR) {
DUMPUNTIL(NEXTOPER(node), NEXTOPER(node) + 1);
}
- else if (PL_regkind[(U8)op] == EXACT) {
+ else if (PL_regkind[(U8)op] == EXACT || op == ANYOFHs) {
/* Literal string, where present. */
node += NODE_SZ_STR(node) - 1;
node = NEXTOPER(node);
{
dVAR;
+#ifdef DEBUGGING
+ char * dump_len_string;
+
+ dump_len_string = PerlEnv_getenv("PERL_DUMP_RE_MAX_LEN");
+ if ( ! dump_len_string
+ || ! grok_atoUV(dump_len_string, (UV *)&PL_dump_re_max_len, NULL))
+ {
+ PL_dump_re_max_len = 60; /* A reasonable default */
+ }
+#endif
+
PL_user_def_props = newHV();
#ifdef USE_ITHREADS
#endif
- /* Set up the inversion list global variables */
+ /* Set up the inversion list interpreter-level variables */
PL_XPosix_ptrs[_CC_ASCII] = _new_invlist_C_array(uni_prop_ptrs[UNI_ASCII]);
PL_XPosix_ptrs[_CC_ALPHANUMERIC] = _new_invlist_C_array(uni_prop_ptrs[UNI_XPOSIXALNUM]);
PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
PL_SCX_invlist = _new_invlist_C_array(_Perl_SCX_invlist);
+ PL_InBitmap = _new_invlist_C_array(InBitmap_invlist);
PL_AboveLatin1 = _new_invlist_C_array(AboveLatin1_invlist);
PL_Latin1 = _new_invlist_C_array(Latin1_invlist);
PL_UpperLatin1 = _new_invlist_C_array(UpperLatin1_invlist);
* Other parameters will be set on return as described below */
const char * const name, /* The first non-blank in the \p{}, \P{} */
- const Size_t name_len, /* Its length in bytes, not including any
+ Size_t name_len, /* Its length in bytes, not including any
trailing space */
const bool is_utf8, /* ? Is 'name' encoded in UTF-8 */
const bool to_fold, /* ? Is this under /i */
qualified name */
bool invert_return = FALSE; /* ? Do we need to complement the result before
returning it */
+ bool stripped_utf8_pkg = FALSE; /* Set TRUE if the input includes an
+ explicit utf8:: package that we strip
+ off */
PERL_ARGS_ASSERT_PARSE_UNIPROP_STRING;
break;
}
+ /* If this looks like it is a marker we inserted at compile time,
+ * ignore it; otherwise keep it as it would have been user input. */
+ if ( UNLIKELY(cur == DEFERRED_PROP_EXPANSION_MARKERc)
+ && ! deferrable
+ && could_be_user_defined
+ && i == name_len - 1)
+ {
+ name_len--;
+ continue;
+ }
+
/* Otherwise, this character is part of the name. */
lookup_name[j++] = cur;
lookup_name += STRLENs("utf8::");
j -= STRLENs("utf8::");
equals_pos -= STRLENs("utf8::");
+ stripped_utf8_pkg = TRUE;
}
/* Here, we are either done with the whole property name, if it was simple;
/* Most punctuation after the equals indicates a subpattern, like
* \p{foo=/bar/} */
if ( isPUNCT_A(name[i])
- && name[i] != '-'
- && name[i] != '+'
- && name[i] != '_'
- && name[i] != '{')
+ && name[i] != '-'
+ && name[i] != '+'
+ && name[i] != '_'
+ && name[i] != '{'
+ /* A backslash means the real delimitter is the next character,
+ * but it must be punctuation */
+ && (name[i] != '\\' || (i < name_len && isPUNCT_A(name[i+1]))))
{
/* Find the property. The table includes the equals sign, so we
* use 'j' as-is */
const char * pos_in_brackets;
bool escaped = 0;
- /* A backslash means the real delimitter is the next character.
- * */
+ /* Backslash => delimitter is the character following. We
+ * already checked that it is punctuation */
if (open == '\\') {
open = name[i++];
escaped = 1;
* set of closing is so that if the opening is something like
* ']', the closing will be that as well. Something similar is
* done in toke.c */
- pos_in_brackets = strchr("([<)]>)]>", open);
+ pos_in_brackets = memCHRs("([<)]>)]>", open);
close = (pos_in_brackets) ? pos_in_brackets[3] : open;
if ( i >= name_len
|| name[name_len-1] != close
- || (escaped && name[name_len-2] != '\\'))
+ || (escaped && name[name_len-2] != '\\')
+ /* Also make sure that there are enough characters.
+ * e.g., '\\\' would show up incorrectly as legal even
+ * though it is too short */
+ || (SSize_t) (name_len - i - 1 - escaped) < 0)
{
sv_catpvs(msg, "Unicode property wildcard not terminated");
goto append_name_to_msg;
/* Here, the name could be for a user defined property, which are
* implemented as subs. */
user_sub = get_cvn_flags(name, name_len, 0);
- if (user_sub) {
+ if (! user_sub) {
+
+ /* Here, the property name could be a user-defined one, but there
+ * is no subroutine to handle it (as of now). Defer handling it
+ * until runtime. Otherwise, a block defined by Unicode in a later
+ * release would get the synonym InFoo added for it, and existing
+ * code that used that name would suddenly break if it referred to
+ * the property before the sub was declared. See [perl #134146] */
+ if (deferrable) {
+ goto definition_deferred;
+ }
+
+ /* If we haven't already stripped the package name (if one), do so
+ * now so can look for an official property with the stripped name.
+ * */
+ if (! stripped_utf8_pkg) {
+ lookup_name += non_pkg_begin;
+ j -= non_pkg_begin;
+ }
+
+ /* Drop down to look up in the official properties */
+ }
+ else {
const char insecure[] = "Insecure user-defined property";
/* Here, there is a sub by the correct name. Normally we call it
definition_deferred:
- /* Here it could yet to be defined, so defer evaluation of this
- * until its needed at runtime. We need the fully qualified property name
- * to avoid ambiguity, and a trailing newline */
- if (! fq_name) {
- fq_name = S_get_fq_name(aTHX_ name, name_len, is_utf8,
- non_pkg_begin != 0 /* If has "::" */
- );
- }
- sv_catpvs(fq_name, "\n");
+ {
+ bool is_qualified = non_pkg_begin != 0; /* If has "::" */
- *user_defined_ptr = TRUE;
- return fq_name;
+ /* Here it could yet to be defined, so defer evaluation of this until
+ * its needed at runtime. We need the fully qualified property name to
+ * avoid ambiguity */
+ if (! fq_name) {
+ fq_name = S_get_fq_name(aTHX_ name, name_len, is_utf8,
+ is_qualified);
+ }
+
+ /* If it didn't come with a package, or the package is utf8::, this
+ * actually could be an official Unicode property whose inclusion we
+ * are deferring until runtime to make sure that it isn't overridden by
+ * a user-defined property of the same name (which we haven't
+ * encountered yet). Add a marker to indicate this possibility, for
+ * use at such time when we first need the definition during pattern
+ * matching execution */
+ if (! is_qualified || memBEGINPs(name, non_pkg_begin, "utf8::")) {
+ sv_catpvs(fq_name, DEFERRED_PROP_EXPANSION_MARKERs);
+ }
+
+ /* We also need a trailing newline */
+ sv_catpvs(fq_name, "\n");
+
+ *user_defined_ptr = TRUE;
+ return fq_name;
+ }
}
#endif
char string[1];
};
+struct regnode_anyofhs { /* Constructed this way to keep the string aligned. */
+ U8 str_len;
+ U8 type;
+ U16 next_off;
+ U32 arg1; /* set by set_ANYOF_arg() */
+ char string[1];
+};
+
/* Argument bearing node - workhorse,
arg1 is often for the data field */
struct regnode_1 {
U16 arg2;
};
-/* This give the number of code points that can be in the bitmap of an ANYOF
- * node. The shift number must currently be one of: 8..12. It can't be less
- * than 8 (256) because some code relies on it being at least that. Above 12
- * (4096), and you start running into warnings that some data structure widths
- * have been exceeded, though the test suite as of this writing still passes
- * for up through 16, which is as high as anyone would ever want to go,
- * encompassing all of the Unicode BMP, and thus including all the economically
- * important world scripts. At 12 most of them are: including Arabic,
- * Cyrillic, Greek, Hebrew, Indian subcontinent, Latin, and Thai; but not Han,
- * Japanese, nor Korean. (The regarglen structure in regnodes.h is a U8, and
- * the trie types TRIEC and AHOCORASICKC are larger than U8 for shift values
- * above 12.) Be sure to benchmark before changing, as larger sizes do
- * significantly slow down the test suite */
-#define NUM_ANYOF_CODE_POINTS (1 << 8)
-
#define ANYOF_BITMAP_SIZE (NUM_ANYOF_CODE_POINTS / 8) /* 8 bits/Byte */
/* Note that these form structs which are supersets of the next smaller one, by
#define NODE_STEP_REGNODE 1 /* sizeof(regnode)/sizeof(regnode) */
#define EXTRA_STEP_2ARGS EXTRA_SIZE(struct regnode_2)
-#define NODE_STEP_B 4
-
#define NEXTOPER(p) ((p) + NODE_STEP_REGNODE)
#define PREVOPER(p) ((p) - NODE_STEP_REGNODE)
# SUSPEND BRANCHJ, off 1 V 1 ; "Independent" sub-RE.
# IFTHEN BRANCHJ, off 1 V 1 ; Switch, should be preceded by switcher.
# GROUPP GROUPP, num 1 ; Whether the group matched.
+#
+# If we were to start running out of regnodes, many of the ones that are
+# complements could be combined with their non-complement mates. For example,
+# POSIXU could have the flags field have the bottom bit mean do we complement
+# or not, and the type be shifted left 1 bit. Then all that would be needed to
+# extract which to do is a mask for the complement bit, and a right shift for
+# the other, an inconsequential increase in instructions. It might actually be
+# clearer and slightly faster given the case statement and assignment are
+# removed. Note that not everything could be collapsed: NPOSIXA, for example,
+# would require special handling for performance.
#* Exit points
# in regcomp.c uses the enum value of the modifier as an offset from the /d
# version. The complements must come after the non-complements.
# BOUND, POSIX and their complements are affected, as well as EXACTF.
-BOUND BOUND, no ; Like BOUNDA for non-utf8, otherwise match "" between any Unicode \w\W or \W\w
+BOUND BOUND, no ; Like BOUNDA for non-utf8, otherwise like BOUNDU
BOUNDL BOUND, no ; Like BOUND/BOUNDU, but \w and \W are defined by current locale
BOUNDU BOUND, no ; Match "" at any boundary of a given type using /u rules.
BOUNDA BOUND, no ; Match "" at any boundary between \w\W or \W\w, where \w is [_a-zA-Z0-9]
# All NBOUND nodes are required by code in regexec.c to be greater than all BOUND ones
-NBOUND NBOUND, no ; Like NBOUNDA for non-utf8, otherwise match "" between any Unicode \w\w or \W\W
+NBOUND NBOUND, no ; Like NBOUNDA for non-utf8, otherwise like BOUNDU
NBOUNDL NBOUND, no ; Like NBOUND/NBOUNDU, but \w and \W are defined by current locale
NBOUNDU NBOUND, no ; Match "" at any non-boundary of a given type using using /u rules.
NBOUNDA NBOUND, no ; Match "" betweeen any \w\w or \W\W, where \w is [_a-zA-Z0-9]
ANYOFH ANYOF, sv 1 S ; Like ANYOF, but only has "High" matches, none in the bitmap; the flags field contains the lowest matchable UTF-8 start byte
ANYOFHb ANYOF, sv 1 S ; Like ANYOFH, but all matches share the same UTF-8 start byte, given in the flags field
ANYOFHr ANYOF, sv 1 S ; Like ANYOFH, but the flags field contains packed bounds for all matchable UTF-8 start bytes.
+ANYOFHs ANYOF, sv 1 S ; Like ANYOFHb, but has a string field that gives the leading matchable UTF-8 bytes; flags field is len
ANYOFR ANYOFR, packed 1 S ; Matches any character in the range given by its packed args: upper 12 bits is the max delta from the base lower 20; the flags field contains the lowest matchable UTF-8 start byte
ANYOFRb ANYOFR, packed 1 S ; Like ANYOFR, but all matches share the same UTF-8 start byte, given in the flags field
# There is no ANYOFRr because khw doesn't think there are likely to be real-world cases where such a large range is used.
my @perl_extended_utf8_dfa;
my @i8 = (
+ # 0 1 2 3 4 5 6 7 8 9 A B C D E F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 00-0F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 10-1F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 20-2F
# N2
# N6 Start byte is F[357]. Continuation byte BF transitions to N12;
# other continuations to N2
- # N5 Start byte is F8. Continuation bytes A[0-7] are illegal
+ # N7 Start byte is F8. Continuation bytes A[0-7] are illegal
# (overlong); continuations A[9BDF] and B[13579BDF] transition to
# N14; the other continuations to N3
# N8 Start byte is F9. Continuation byte A0 transitions to N3; A1
# illegal (non-chars); the other continuations are legal
# N12 Initial sequence is F[357] BF. Continuation bytes BF
# transitions to N13; the other continuations to N1
- # N13 Initial sequence is F[1357] BF BF or F8 x BF (where x is
- # something that can lead to a non-char. Continuation bytes BE
- # and BF are illegal (non-chars); the other continuations are
+ # N13 Initial sequence is F[1357] BF BF or F8 x y BF (where x and y
+ # are something that can lead to a non-char. Continuation bytes
+ # BE and BF are illegal (non-chars); the other continuations are
# legal
# N14 Initial sequence is F8 A[9BDF]; or F8 B[13579BDF]; or F9 A1.
- # Continuation byte BF transitions to N13; the other
+ # Continuation byte BF transitions to N15; the other
+ # continuations to N2
+ # N15 Initial sequence is F8 A[9BDF] BF; or F8 B[13579BDF] BF; or
+ # F9 A1 BF. Continuation byte BF transitions to N16; the other
# continuations to N2
+ # N16 Initial sequence is F8 A[9BDF] BF BF; or F8 B[13579BDF] BF BF;
+ # or F9 A1 BF BF. Continuation bytes BE and BF are illegal
+ # (non-chars); the other continuations are legal
# 1 Reject. All transitions not mentioned above (except the single
# byte ones (as they are always legal) are to this state.
my $N12 = $N11 + $NUM_CLASSES;
my $N13 = $N12 + $NUM_CLASSES;
my $N14 = $N13 + $NUM_CLASSES;
+ my $N15 = $N14 + $NUM_CLASSES;
my @strict_utf8_dfa;
my @i8 = (
+ # 0 1 2 3 4 5 6 7 8 9 A B C D E F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 00-0F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 10-1F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 20-2F
1,1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, # N11
1,1, 1, 1, 1, 1, 1, 1, 1, 1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1,$N13, # N12
1,1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, # N13
- 1,1, 1, 1, 1, 1, 1, 1, 1, 1, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2,$N13, # N14
+ 1,1, 1, 1, 1, 1, 1, 1, 1, 1, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2, $N2,$N15, # N14
+ 1,1, 1, 1, 1, 1, 1, 1, 1, 1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1, $N1,$N13, # N15
);
output_table(\@strict_utf8_dfa, "PL_strict_utf8_dfa_tab", $NUM_CLASSES);
}
my @C9_utf8_dfa;
my @i8 = (
+ # 0 1 2 3 4 5 6 7 8 9 A B C D E F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 00-0F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 10-1F
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, # 20-2F
unicode_strings => 'unicode',
fc => 'fc',
signatures => 'signatures',
+ isa => 'isa',
);
# NOTE: If a feature is ever enabled in a non-contiguous range of Perl
}
print $pm ");\n\n";
-print $pm "\nmy %feature_bits = (\n";
-for (sort keys %feature_bits) {
- printf $pm " %-*s => %#06x,\n", $width, $_, $feature_bits{$_};
-}
-print $pm ");\n\n";
-
print $pm "our %feature_bundle = (\n";
my $bund_width = length longest values %UniqueBundles;
for( sort { $UniqueBundles{$a} cmp $UniqueBundles{$b} }
}
#endif /* PERL_IN_OP_C */
+#ifdef PERL_IN_MG_C
+
+#define magic_sethint_feature(keysv, keypv, keylen, valsv, valbool) \\
+ S_magic_sethint_feature(aTHX_ (keysv), (keypv), (keylen), (valsv), (valbool))
+PERL_STATIC_INLINE void
+S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen,
+ SV *valsv, bool valbool) {
+ if (keysv)
+ keypv = SvPV_const(keysv, keylen);
+
+ if (memBEGINs(keypv, keylen, "feature_")) {
+ const char *subf = keypv + (sizeof("feature_")-1);
+ U32 mask = 0;
+ switch (*subf) {
+EOJ
+
+my %pref;
+for my $key (sort values %feature) {
+ push @{$pref{substr($key, 0, 1)}}, $key;
+}
+
+for my $pref (sort keys %pref) {
+ print $h <<EOS;
+ case '$pref':
+EOS
+ my $first = 1;
+ for my $subkey (@{$pref{$pref}}) {
+ my $rest = substr($subkey, 1);
+ my $if = $first ? "if" : "else if";
+ print $h <<EOJ;
+ $if (keylen == sizeof("feature_$subkey")-1
+ && memcmp(subf+1, "$rest", keylen - sizeof("feature_")) == 0) {
+ mask = FEATURE_\U${subkey}\E_BIT;
+ break;
+ }
+EOJ
+
+ $first = 0;
+ }
+ print $h <<EOS;
+ return;
+
+EOS
+}
+
+print $h <<EOJ;
+ default:
+ return;
+ }
+ if (valsv ? SvTRUE(valsv) : valbool)
+ PL_compiling.cop_features |= mask;
+ else
+ PL_compiling.cop_features &= ~mask;
+ }
+}
+#endif /* PERL_IN_MG_C */
+
#endif /* PERL_FEATURE_H_ */
EOJ
__END__
package feature;
-our $VERSION = '1.56';
+our $VERSION = '1.57';
FEATURES
This feature is available from Perl 5.26 onwards.
+=head2 The 'isa' feature
+
+This allows the use of the C<isa> infix operator, which tests whether the
+scalar given by the left operand is an object of the class given by the
+right operand. See L<perlop/Class Instance Operator> for more details.
+
+This feature is available from Perl 5.32 onwards.
+
=head1 FEATURE BUNDLES
It's possible to load multiple features together, using
my $bundle_number = $^H & $hint_mask;
my $features = $bundle_number != $hint_mask
&& $feature_bundle{$hint_bundles[$bundle_number >> $hint_shift]};
- my $bits = ${^FEATURE_BITS};
if ($features) {
# Features are enabled implicitly via bundle hints.
# Delete any keys that may be left over from last time.
delete @^H{ values(%feature) };
- $bits = 0;
$^H |= $hint_mask;
for (@$features) {
$^H{$feature{$_}} = 1;
- $bits |= $feature_bits{$_};
$^H |= $hint_uni8bit if $_ eq 'unicode_strings';
}
}
}
if ($import) {
$^H{$feature{$name}} = 1;
- $bits |= $feature_bits{$name};
$^H |= $hint_uni8bit if $name eq 'unicode_strings';
} else {
delete $^H{$feature{$name}};
- $bits &= ~$feature_bits{$name};
$^H &= ~ $hint_uni8bit if $name eq 'unicode_strings';
}
}
- ${^FEATURE_BITS} = $bits;
}
sub unknown_feature {
evalbytes => 'evalbytes',
__SUB__ => '__SUB__',
fc => 'fc',
+ isa => 'isa',
);
my %pos = map { ($_ => 1) } @{$by_strength{'+'}};
-index
-int
-ioctl
+-isa
-join
-keys
-kill
print $out_fh "/* See the generating file for comments */\n\n";
+print $out_fh <<'EOF';
+/* This gives the number of code points that can be in the bitmap of an ANYOF
+ * node. The shift number must currently be one of: 8..12. It can't be less
+ * than 8 (256) because some code relies on it being at least that. Above 12
+ * (4096), and you start running into warnings that some data structure widths
+ * have been exceeded, though the test suite as of this writing still passes
+ * for up through 16, which is as high as anyone would ever want to go,
+ * encompassing all of the Unicode BMP, and thus including all the economically
+ * important world scripts. At 12 most of them are: including Arabic,
+ * Cyrillic, Greek, Hebrew, Indian subcontinent, Latin, and Thai; but not Han,
+ * Japanese, nor Korean. (The regarglen structure in regnodes.h is a U8, and
+ * the trie types TRIEC and AHOCORASICKC are larger than U8 for shift values
+ * above 12.) Be sure to benchmark before changing, as larger sizes do
+ * significantly slow down the test suite */
+
+EOF
+
+my $num_anyof_code_points = '(1 << 8)';
+
+print $out_fh "#define NUM_ANYOF_CODE_POINTS $num_anyof_code_points\n\n";
+
+$num_anyof_code_points = eval $num_anyof_code_points;
+
# enums that should be made public
my %public_enums = (
_Perl_SCX => 1
output_invlist("Latin1", [ 0, 256 ]);
output_invlist("AboveLatin1", [ 256 ]);
+if ($num_anyof_code_points == 256) { # Same as Latin1
+ print $out_fh
+ "\nstatic const UV * const InBitmap_invlist = Latin1_invlist;\n";
+}
+else {
+ output_invlist("InBitmap", [ 0, $num_anyof_code_points ]);
+}
+
end_file_pound_if;
# We construct lists for all the POSIX and backslash sequence character
lvrefslice lvalue ref assignment ck_null d@
lvavref lvalue array reference ck_null d%
anonconst anonymous constant ck_null ds1
+
+isa derived class test ck_isa s2
#
# This script is normally invoked from regen.pl.
-$VERSION = '1.45';
+$VERSION = '1.46';
BEGIN {
require './regen/regen_lib.pl';
[ 5.029, DEFAULT_ON ],
'experimental::vlb' =>
[ 5.029, DEFAULT_ON ],
+ 'experimental::isa' =>
+ [ 5.031, DEFAULT_ON ],
}],
'missing' => [ 5.021, DEFAULT_OFF],
}
break;
+ case ANYOFHs:
+ if (utf8_target) { /* Can't possibly match a non-UTF-8 target */
+ REXEC_FBC_CLASS_SCAN(TRUE,
+ ( strend -s >= FLAGS(c)
+ && memEQ(s, ((struct regnode_anyofhs *) c)->string, FLAGS(c))
+ && reginclass(prog, c, (U8*)s, (U8*) strend, utf8_target)));
+ }
+ break;
+
case ANYOFR:
if (utf8_target) {
REXEC_FBC_CLASS_SCAN(TRUE,
goto increment_locinput;
break;
+ case ANYOFHs:
+ if ( ! utf8_target
+ || NEXTCHR_IS_EOS
+ || loceol - locinput < FLAGS(scan)
+ || memNE(locinput, ((struct regnode_anyofhs *) scan)->string, FLAGS(scan))
+ || ! reginclass(rex, scan, (U8*)locinput, (U8*) loceol,
+ utf8_target))
+ {
+ sayNO;
+ }
+ goto increment_locinput;
+ break;
+
case ANYOFR:
if (NEXTCHR_IS_EOS) {
sayNO;
}
break;
+ case ANYOFHs:
+ if (utf8_target) { /* ANYOFH only can match UTF-8 targets */
+ while ( hardcount < max
+ && scan + FLAGS(p) < this_eol
+ && memEQ(scan, ((struct regnode_anyofhs *) p)->string, FLAGS(p))
+ && reginclass(prog, p, (U8*)scan, (U8*) this_eol, TRUE))
+ {
+ scan += UTF8SKIP(scan);
+ hardcount++;
+ }
+ }
+ break;
+
case ANYOFR:
if (utf8_target) {
while ( hardcount < max
S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const p, const U8* const p_end, const bool utf8_target)
{
dVAR;
- const char flags = (inRANGE(OP(n), ANYOFH, ANYOFHr))
+ const char flags = (inRANGE(OP(n), ANYOFH, ANYOFHs))
? 0
: ANYOF_FLAGS(n);
bool match = FALSE;
#ifndef PERL_IN_XSUB_RE
bool
-Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, const UV cp)
+Perl_is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, const UV cp)
{
/* Temporary helper function for toke.c. Verify that the code point 'cp'
* is a stand-alone grapheme. The UTF-8 for 'cp' begins at position 's' in
* the larger string bounded by 'strbeg' and 'strend'.
*
- * 'cp' needs to be assigned (if not a future version of the Unicode
+ * 'cp' needs to be assigned (if not, a future version of the Unicode
* Standard could make it something that combines with adjacent characters,
* so code using it would then break), and there has to be a GCB break
* before and after the character. */
GCB_enum cp_gcb_val, prev_cp_gcb_val, next_cp_gcb_val;
const U8 * prev_cp_start;
- PERL_ARGS_ASSERT__IS_GRAPHEME;
+ PERL_ARGS_ASSERT_IS_GRAPHEME;
if ( UNLIKELY(UNICODE_IS_SUPER(cp))
|| UNLIKELY(UNICODE_IS_NONCHAR(cp)))
/* Regops and State definitions */
-#define REGNODE_MAX 107
-#define REGMATCH_STATE_MAX 147
+#define REGNODE_MAX 108
+#define REGMATCH_STATE_MAX 148
#define END 0 /* 0000 End of program. */
#define SUCCEED 1 /* 0x01 Return from a subroutine, basically. */
#define MEOL 5 /* 0x05 Same, assuming multiline: /$/m */
#define EOS 6 /* 0x06 Match "" at end of string: /\z/ */
#define GPOS 7 /* 0x07 Matches where last m//g left off. */
-#define BOUND 8 /* 0x08 Like BOUNDA for non-utf8, otherwise match "" between any Unicode \w\W or \W\w */
+#define BOUND 8 /* 0x08 Like BOUNDA for non-utf8, otherwise like BOUNDU */
#define BOUNDL 9 /* 0x09 Like BOUND/BOUNDU, but \w and \W are defined by current locale */
#define BOUNDU 10 /* 0x0a Match "" at any boundary of a given type using /u rules. */
#define BOUNDA 11 /* 0x0b Match "" at any boundary between \w\W or \W\w, where \w is [_a-zA-Z0-9] */
-#define NBOUND 12 /* 0x0c Like NBOUNDA for non-utf8, otherwise match "" between any Unicode \w\w or \W\W */
+#define NBOUND 12 /* 0x0c Like NBOUNDA for non-utf8, otherwise like BOUNDU */
#define NBOUNDL 13 /* 0x0d Like NBOUND/NBOUNDU, but \w and \W are defined by current locale */
#define NBOUNDU 14 /* 0x0e Match "" at any non-boundary of a given type using using /u rules. */
#define NBOUNDA 15 /* 0x0f Match "" betweeen any \w\w or \W\W, where \w is [_a-zA-Z0-9] */
#define ANYOFH 22 /* 0x16 Like ANYOF, but only has "High" matches, none in the bitmap; the flags field contains the lowest matchable UTF-8 start byte */
#define ANYOFHb 23 /* 0x17 Like ANYOFH, but all matches share the same UTF-8 start byte, given in the flags field */
#define ANYOFHr 24 /* 0x18 Like ANYOFH, but the flags field contains packed bounds for all matchable UTF-8 start bytes. */
-#define ANYOFR 25 /* 0x19 Matches any character in the range given by its packed args: upper 12 bits is the max delta from the base lower 20; the flags field contains the lowest matchable UTF-8 start byte */
-#define ANYOFRb 26 /* 0x1a Like ANYOFR, but all matches share the same UTF-8 start byte, given in the flags field */
-#define ANYOFM 27 /* 0x1b Like ANYOF, but matches an invariant byte as determined by the mask and arg */
-#define NANYOFM 28 /* 0x1c complement of ANYOFM */
-#define POSIXD 29 /* 0x1d Some [[:class:]] under /d; the FLAGS field gives which one */
-#define POSIXL 30 /* 0x1e Some [[:class:]] under /l; the FLAGS field gives which one */
-#define POSIXU 31 /* 0x1f Some [[:class:]] under /u; the FLAGS field gives which one */
-#define POSIXA 32 /* 0x20 Some [[:class:]] under /a; the FLAGS field gives which one */
-#define NPOSIXD 33 /* 0x21 complement of POSIXD, [[:^class:]] */
-#define NPOSIXL 34 /* 0x22 complement of POSIXL, [[:^class:]] */
-#define NPOSIXU 35 /* 0x23 complement of POSIXU, [[:^class:]] */
-#define NPOSIXA 36 /* 0x24 complement of POSIXA, [[:^class:]] */
-#define CLUMP 37 /* 0x25 Match any extended grapheme cluster sequence */
-#define BRANCH 38 /* 0x26 Match this alternative, or the next... */
-#define EXACT 39 /* 0x27 Match this string (flags field is the length). */
-#define LEXACT 40 /* 0x28 Match this long string (preceded by length; flags unused). */
-#define EXACTL 41 /* 0x29 Like EXACT, but /l is in effect (used so locale-related warnings can be checked for) */
-#define EXACTF 42 /* 0x2a Like EXACT, but match using /id rules; (string not UTF-8, ASCII folded; non-ASCII not) */
-#define EXACTFL 43 /* 0x2b Like EXACT, but match using /il rules; (string not likely to be folded) */
-#define EXACTFU 44 /* 0x2c Like EXACT, but match using /iu rules; (string folded) */
-#define EXACTFAA 45 /* 0x2d Like EXACT, but match using /iaa rules; (string folded except in non-UTF8 patterns: MICRO, SHARP S; folded length <= unfolded) */
-#define EXACTFUP 46 /* 0x2e Like EXACT, but match using /iu rules; (string not UTF-8, folded except MICRO, SHARP S: hence Problematic) */
-#define EXACTFLU8 47 /* 0x2f Like EXACTFU, but use /il, UTF-8, (string is folded, and everything in it is above 255 */
-#define EXACTFAA_NO_TRIE 48 /* 0x30 Like EXACT, but match using /iaa rules (string not UTF-8, not guaranteed to be folded, not currently trie-able) */
-#define EXACT_REQ8 49 /* 0x31 Like EXACT, but only UTF-8 encoded targets can match */
-#define LEXACT_REQ8 50 /* 0x32 Like LEXACT, but only UTF-8 encoded targets can match */
-#define EXACTFU_REQ8 51 /* 0x33 Like EXACTFU, but only UTF-8 encoded targets can match */
-#define EXACTFU_S_EDGE 52 /* 0x34 /di rules, but nothing in it precludes /ui, except begins and/or ends with [Ss]; (string not UTF-8; compile-time only) */
-#define NOTHING 53 /* 0x35 Match empty string. */
-#define TAIL 54 /* 0x36 Match empty string. Can jump here from outside. */
-#define STAR 55 /* 0x37 Match this (simple) thing 0 or more times. */
-#define PLUS 56 /* 0x38 Match this (simple) thing 1 or more times. */
-#define CURLY 57 /* 0x39 Match this simple thing {n,m} times. */
-#define CURLYN 58 /* 0x3a Capture next-after-this simple thing */
-#define CURLYM 59 /* 0x3b Capture this medium-complex thing {n,m} times. */
-#define CURLYX 60 /* 0x3c Match this complex thing {n,m} times. */
-#define WHILEM 61 /* 0x3d Do curly processing and see if rest matches. */
-#define OPEN 62 /* 0x3e Mark this point in input as start of #n. */
-#define CLOSE 63 /* 0x3f Close corresponding OPEN of #n. */
-#define SROPEN 64 /* 0x40 Same as OPEN, but for script run */
-#define SRCLOSE 65 /* 0x41 Close preceding SROPEN */
-#define REF 66 /* 0x42 Match some already matched string */
-#define REFF 67 /* 0x43 Match already matched string, using /di rules. */
-#define REFFL 68 /* 0x44 Match already matched string, using /li rules. */
-#define REFFU 69 /* 0x45 Match already matched string, usng /ui. */
-#define REFFA 70 /* 0x46 Match already matched string, using /aai rules. */
-#define REFN 71 /* 0x47 Match some already matched string */
-#define REFFN 72 /* 0x48 Match already matched string, using /di rules. */
-#define REFFLN 73 /* 0x49 Match already matched string, using /li rules. */
-#define REFFUN 74 /* 0x4a Match already matched string, using /ui rules. */
-#define REFFAN 75 /* 0x4b Match already matched string, using /aai rules. */
-#define LONGJMP 76 /* 0x4c Jump far away. */
-#define BRANCHJ 77 /* 0x4d BRANCH with long offset. */
-#define IFMATCH 78 /* 0x4e Succeeds if the following matches; non-zero flags "f", next_off "o" means lookbehind assertion starting "f..(f-o)" characters before current */
-#define UNLESSM 79 /* 0x4f Fails if the following matches; non-zero flags "f", next_off "o" means lookbehind assertion starting "f..(f-o)" characters before current */
-#define SUSPEND 80 /* 0x50 "Independent" sub-RE. */
-#define IFTHEN 81 /* 0x51 Switch, should be preceded by switcher. */
-#define GROUPP 82 /* 0x52 Whether the group matched. */
-#define EVAL 83 /* 0x53 Execute some Perl code. */
-#define MINMOD 84 /* 0x54 Next operator is not greedy. */
-#define LOGICAL 85 /* 0x55 Next opcode should set the flag only. */
-#define RENUM 86 /* 0x56 Group with independently numbered parens. */
-#define TRIE 87 /* 0x57 Match many EXACT(F[ALU]?)? at once. flags==type */
-#define TRIEC 88 /* 0x58 Same as TRIE, but with embedded charclass data */
-#define AHOCORASICK 89 /* 0x59 Aho Corasick stclass. flags==type */
-#define AHOCORASICKC 90 /* 0x5a Same as AHOCORASICK, but with embedded charclass data */
-#define GOSUB 91 /* 0x5b recurse to paren arg1 at (signed) ofs arg2 */
-#define GROUPPN 92 /* 0x5c Whether the group matched. */
-#define INSUBP 93 /* 0x5d Whether we are in a specific recurse. */
-#define DEFINEP 94 /* 0x5e Never execute directly. */
-#define ENDLIKE 95 /* 0x5f Used only for the type field of verbs */
-#define OPFAIL 96 /* 0x60 Same as (?!), but with verb arg */
-#define ACCEPT 97 /* 0x61 Accepts the current matched string, with verbar */
-#define VERB 98 /* 0x62 Used only for the type field of verbs */
-#define PRUNE 99 /* 0x63 Pattern fails at this startpoint if no-backtracking through this */
-#define MARKPOINT 100 /* 0x64 Push the current location for rollback by cut. */
-#define SKIP 101 /* 0x65 On failure skip forward (to the mark) before retrying */
-#define COMMIT 102 /* 0x66 Pattern fails outright if backtracking through this */
-#define CUTGROUP 103 /* 0x67 On failure go to the next alternation in the group */
-#define KEEPS 104 /* 0x68 $& begins here. */
-#define LNBREAK 105 /* 0x69 generic newline pattern */
-#define OPTIMIZED 106 /* 0x6a Placeholder for dump. */
-#define PSEUDO 107 /* 0x6b Pseudo opcode for internal use. */
+#define ANYOFHs 25 /* 0x19 Like ANYOFHb, but has a string field that gives the leading matchable UTF-8 bytes; flags field is len */
+#define ANYOFR 26 /* 0x1a Matches any character in the range given by its packed args: upper 12 bits is the max delta from the base lower 20; the flags field contains the lowest matchable UTF-8 start byte */
+#define ANYOFRb 27 /* 0x1b Like ANYOFR, but all matches share the same UTF-8 start byte, given in the flags field */
+#define ANYOFM 28 /* 0x1c Like ANYOF, but matches an invariant byte as determined by the mask and arg */
+#define NANYOFM 29 /* 0x1d complement of ANYOFM */
+#define POSIXD 30 /* 0x1e Some [[:class:]] under /d; the FLAGS field gives which one */
+#define POSIXL 31 /* 0x1f Some [[:class:]] under /l; the FLAGS field gives which one */
+#define POSIXU 32 /* 0x20 Some [[:class:]] under /u; the FLAGS field gives which one */
+#define POSIXA 33 /* 0x21 Some [[:class:]] under /a; the FLAGS field gives which one */
+#define NPOSIXD 34 /* 0x22 complement of POSIXD, [[:^class:]] */
+#define NPOSIXL 35 /* 0x23 complement of POSIXL, [[:^class:]] */
+#define NPOSIXU 36 /* 0x24 complement of POSIXU, [[:^class:]] */
+#define NPOSIXA 37 /* 0x25 complement of POSIXA, [[:^class:]] */
+#define CLUMP 38 /* 0x26 Match any extended grapheme cluster sequence */
+#define BRANCH 39 /* 0x27 Match this alternative, or the next... */
+#define EXACT 40 /* 0x28 Match this string (flags field is the length). */
+#define LEXACT 41 /* 0x29 Match this long string (preceded by length; flags unused). */
+#define EXACTL 42 /* 0x2a Like EXACT, but /l is in effect (used so locale-related warnings can be checked for) */
+#define EXACTF 43 /* 0x2b Like EXACT, but match using /id rules; (string not UTF-8, ASCII folded; non-ASCII not) */
+#define EXACTFL 44 /* 0x2c Like EXACT, but match using /il rules; (string not likely to be folded) */
+#define EXACTFU 45 /* 0x2d Like EXACT, but match using /iu rules; (string folded) */
+#define EXACTFAA 46 /* 0x2e Like EXACT, but match using /iaa rules; (string folded except in non-UTF8 patterns: MICRO, SHARP S; folded length <= unfolded) */
+#define EXACTFUP 47 /* 0x2f Like EXACT, but match using /iu rules; (string not UTF-8, folded except MICRO, SHARP S: hence Problematic) */
+#define EXACTFLU8 48 /* 0x30 Like EXACTFU, but use /il, UTF-8, (string is folded, and everything in it is above 255 */
+#define EXACTFAA_NO_TRIE 49 /* 0x31 Like EXACT, but match using /iaa rules (string not UTF-8, not guaranteed to be folded, not currently trie-able) */
+#define EXACT_REQ8 50 /* 0x32 Like EXACT, but only UTF-8 encoded targets can match */
+#define LEXACT_REQ8 51 /* 0x33 Like LEXACT, but only UTF-8 encoded targets can match */
+#define EXACTFU_REQ8 52 /* 0x34 Like EXACTFU, but only UTF-8 encoded targets can match */
+#define EXACTFU_S_EDGE 53 /* 0x35 /di rules, but nothing in it precludes /ui, except begins and/or ends with [Ss]; (string not UTF-8; compile-time only) */
+#define NOTHING 54 /* 0x36 Match empty string. */
+#define TAIL 55 /* 0x37 Match empty string. Can jump here from outside. */
+#define STAR 56 /* 0x38 Match this (simple) thing 0 or more times. */
+#define PLUS 57 /* 0x39 Match this (simple) thing 1 or more times. */
+#define CURLY 58 /* 0x3a Match this simple thing {n,m} times. */
+#define CURLYN 59 /* 0x3b Capture next-after-this simple thing */
+#define CURLYM 60 /* 0x3c Capture this medium-complex thing {n,m} times. */
+#define CURLYX 61 /* 0x3d Match this complex thing {n,m} times. */
+#define WHILEM 62 /* 0x3e Do curly processing and see if rest matches. */
+#define OPEN 63 /* 0x3f Mark this point in input as start of #n. */
+#define CLOSE 64 /* 0x40 Close corresponding OPEN of #n. */
+#define SROPEN 65 /* 0x41 Same as OPEN, but for script run */
+#define SRCLOSE 66 /* 0x42 Close preceding SROPEN */
+#define REF 67 /* 0x43 Match some already matched string */
+#define REFF 68 /* 0x44 Match already matched string, using /di rules. */
+#define REFFL 69 /* 0x45 Match already matched string, using /li rules. */
+#define REFFU 70 /* 0x46 Match already matched string, usng /ui. */
+#define REFFA 71 /* 0x47 Match already matched string, using /aai rules. */
+#define REFN 72 /* 0x48 Match some already matched string */
+#define REFFN 73 /* 0x49 Match already matched string, using /di rules. */
+#define REFFLN 74 /* 0x4a Match already matched string, using /li rules. */
+#define REFFUN 75 /* 0x4b Match already matched string, using /ui rules. */
+#define REFFAN 76 /* 0x4c Match already matched string, using /aai rules. */
+#define LONGJMP 77 /* 0x4d Jump far away. */
+#define BRANCHJ 78 /* 0x4e BRANCH with long offset. */
+#define IFMATCH 79 /* 0x4f Succeeds if the following matches; non-zero flags "f", next_off "o" means lookbehind assertion starting "f..(f-o)" characters before current */
+#define UNLESSM 80 /* 0x50 Fails if the following matches; non-zero flags "f", next_off "o" means lookbehind assertion starting "f..(f-o)" characters before current */
+#define SUSPEND 81 /* 0x51 "Independent" sub-RE. */
+#define IFTHEN 82 /* 0x52 Switch, should be preceded by switcher. */
+#define GROUPP 83 /* 0x53 Whether the group matched. */
+#define EVAL 84 /* 0x54 Execute some Perl code. */
+#define MINMOD 85 /* 0x55 Next operator is not greedy. */
+#define LOGICAL 86 /* 0x56 Next opcode should set the flag only. */
+#define RENUM 87 /* 0x57 Group with independently numbered parens. */
+#define TRIE 88 /* 0x58 Match many EXACT(F[ALU]?)? at once. flags==type */
+#define TRIEC 89 /* 0x59 Same as TRIE, but with embedded charclass data */
+#define AHOCORASICK 90 /* 0x5a Aho Corasick stclass. flags==type */
+#define AHOCORASICKC 91 /* 0x5b Same as AHOCORASICK, but with embedded charclass data */
+#define GOSUB 92 /* 0x5c recurse to paren arg1 at (signed) ofs arg2 */
+#define GROUPPN 93 /* 0x5d Whether the group matched. */
+#define INSUBP 94 /* 0x5e Whether we are in a specific recurse. */
+#define DEFINEP 95 /* 0x5f Never execute directly. */
+#define ENDLIKE 96 /* 0x60 Used only for the type field of verbs */
+#define OPFAIL 97 /* 0x61 Same as (?!), but with verb arg */
+#define ACCEPT 98 /* 0x62 Accepts the current matched string, with verbar */
+#define VERB 99 /* 0x63 Used only for the type field of verbs */
+#define PRUNE 100 /* 0x64 Pattern fails at this startpoint if no-backtracking through this */
+#define MARKPOINT 101 /* 0x65 Push the current location for rollback by cut. */
+#define SKIP 102 /* 0x66 On failure skip forward (to the mark) before retrying */
+#define COMMIT 103 /* 0x67 Pattern fails outright if backtracking through this */
+#define CUTGROUP 104 /* 0x68 On failure go to the next alternation in the group */
+#define KEEPS 105 /* 0x69 $& begins here. */
+#define LNBREAK 106 /* 0x6a generic newline pattern */
+#define OPTIMIZED 107 /* 0x6b Placeholder for dump. */
+#define PSEUDO 108 /* 0x6c Pseudo opcode for internal use. */
/* ------------ States ------------- */
#define TRIE_next (REGNODE_MAX + 1) /* state for TRIE */
#define TRIE_next_fail (REGNODE_MAX + 2) /* state for TRIE */
ANYOF, /* ANYOFH */
ANYOF, /* ANYOFHb */
ANYOF, /* ANYOFHr */
+ ANYOF, /* ANYOFHs */
ANYOFR, /* ANYOFR */
ANYOFR, /* ANYOFRb */
ANYOFM, /* ANYOFM */
EXTRA_SIZE(struct regnode_1), /* ANYOFH */
EXTRA_SIZE(struct regnode_1), /* ANYOFHb */
EXTRA_SIZE(struct regnode_1), /* ANYOFHr */
+ EXTRA_SIZE(struct regnode_1), /* ANYOFHs */
EXTRA_SIZE(struct regnode_1), /* ANYOFR */
EXTRA_SIZE(struct regnode_1), /* ANYOFRb */
EXTRA_SIZE(struct regnode_1), /* ANYOFM */
0, /* ANYOFH */
0, /* ANYOFHb */
0, /* ANYOFHr */
+ 0, /* ANYOFHs */
0, /* ANYOFR */
0, /* ANYOFRb */
0, /* ANYOFM */
"ANYOFH", /* 0x16 */
"ANYOFHb", /* 0x17 */
"ANYOFHr", /* 0x18 */
- "ANYOFR", /* 0x19 */
- "ANYOFRb", /* 0x1a */
- "ANYOFM", /* 0x1b */
- "NANYOFM", /* 0x1c */
- "POSIXD", /* 0x1d */
- "POSIXL", /* 0x1e */
- "POSIXU", /* 0x1f */
- "POSIXA", /* 0x20 */
- "NPOSIXD", /* 0x21 */
- "NPOSIXL", /* 0x22 */
- "NPOSIXU", /* 0x23 */
- "NPOSIXA", /* 0x24 */
- "CLUMP", /* 0x25 */
- "BRANCH", /* 0x26 */
- "EXACT", /* 0x27 */
- "LEXACT", /* 0x28 */
- "EXACTL", /* 0x29 */
- "EXACTF", /* 0x2a */
- "EXACTFL", /* 0x2b */
- "EXACTFU", /* 0x2c */
- "EXACTFAA", /* 0x2d */
- "EXACTFUP", /* 0x2e */
- "EXACTFLU8", /* 0x2f */
- "EXACTFAA_NO_TRIE", /* 0x30 */
- "EXACT_REQ8", /* 0x31 */
- "LEXACT_REQ8", /* 0x32 */
- "EXACTFU_REQ8", /* 0x33 */
- "EXACTFU_S_EDGE", /* 0x34 */
- "NOTHING", /* 0x35 */
- "TAIL", /* 0x36 */
- "STAR", /* 0x37 */
- "PLUS", /* 0x38 */
- "CURLY", /* 0x39 */
- "CURLYN", /* 0x3a */
- "CURLYM", /* 0x3b */
- "CURLYX", /* 0x3c */
- "WHILEM", /* 0x3d */
- "OPEN", /* 0x3e */
- "CLOSE", /* 0x3f */
- "SROPEN", /* 0x40 */
- "SRCLOSE", /* 0x41 */
- "REF", /* 0x42 */
- "REFF", /* 0x43 */
- "REFFL", /* 0x44 */
- "REFFU", /* 0x45 */
- "REFFA", /* 0x46 */
- "REFN", /* 0x47 */
- "REFFN", /* 0x48 */
- "REFFLN", /* 0x49 */
- "REFFUN", /* 0x4a */
- "REFFAN", /* 0x4b */
- "LONGJMP", /* 0x4c */
- "BRANCHJ", /* 0x4d */
- "IFMATCH", /* 0x4e */
- "UNLESSM", /* 0x4f */
- "SUSPEND", /* 0x50 */
- "IFTHEN", /* 0x51 */
- "GROUPP", /* 0x52 */
- "EVAL", /* 0x53 */
- "MINMOD", /* 0x54 */
- "LOGICAL", /* 0x55 */
- "RENUM", /* 0x56 */
- "TRIE", /* 0x57 */
- "TRIEC", /* 0x58 */
- "AHOCORASICK", /* 0x59 */
- "AHOCORASICKC", /* 0x5a */
- "GOSUB", /* 0x5b */
- "GROUPPN", /* 0x5c */
- "INSUBP", /* 0x5d */
- "DEFINEP", /* 0x5e */
- "ENDLIKE", /* 0x5f */
- "OPFAIL", /* 0x60 */
- "ACCEPT", /* 0x61 */
- "VERB", /* 0x62 */
- "PRUNE", /* 0x63 */
- "MARKPOINT", /* 0x64 */
- "SKIP", /* 0x65 */
- "COMMIT", /* 0x66 */
- "CUTGROUP", /* 0x67 */
- "KEEPS", /* 0x68 */
- "LNBREAK", /* 0x69 */
- "OPTIMIZED", /* 0x6a */
- "PSEUDO", /* 0x6b */
+ "ANYOFHs", /* 0x19 */
+ "ANYOFR", /* 0x1a */
+ "ANYOFRb", /* 0x1b */
+ "ANYOFM", /* 0x1c */
+ "NANYOFM", /* 0x1d */
+ "POSIXD", /* 0x1e */
+ "POSIXL", /* 0x1f */
+ "POSIXU", /* 0x20 */
+ "POSIXA", /* 0x21 */
+ "NPOSIXD", /* 0x22 */
+ "NPOSIXL", /* 0x23 */
+ "NPOSIXU", /* 0x24 */
+ "NPOSIXA", /* 0x25 */
+ "CLUMP", /* 0x26 */
+ "BRANCH", /* 0x27 */
+ "EXACT", /* 0x28 */
+ "LEXACT", /* 0x29 */
+ "EXACTL", /* 0x2a */
+ "EXACTF", /* 0x2b */
+ "EXACTFL", /* 0x2c */
+ "EXACTFU", /* 0x2d */
+ "EXACTFAA", /* 0x2e */
+ "EXACTFUP", /* 0x2f */
+ "EXACTFLU8", /* 0x30 */
+ "EXACTFAA_NO_TRIE", /* 0x31 */
+ "EXACT_REQ8", /* 0x32 */
+ "LEXACT_REQ8", /* 0x33 */
+ "EXACTFU_REQ8", /* 0x34 */
+ "EXACTFU_S_EDGE", /* 0x35 */
+ "NOTHING", /* 0x36 */
+ "TAIL", /* 0x37 */
+ "STAR", /* 0x38 */
+ "PLUS", /* 0x39 */
+ "CURLY", /* 0x3a */
+ "CURLYN", /* 0x3b */
+ "CURLYM", /* 0x3c */
+ "CURLYX", /* 0x3d */
+ "WHILEM", /* 0x3e */
+ "OPEN", /* 0x3f */
+ "CLOSE", /* 0x40 */
+ "SROPEN", /* 0x41 */
+ "SRCLOSE", /* 0x42 */
+ "REF", /* 0x43 */
+ "REFF", /* 0x44 */
+ "REFFL", /* 0x45 */
+ "REFFU", /* 0x46 */
+ "REFFA", /* 0x47 */
+ "REFN", /* 0x48 */
+ "REFFN", /* 0x49 */
+ "REFFLN", /* 0x4a */
+ "REFFUN", /* 0x4b */
+ "REFFAN", /* 0x4c */
+ "LONGJMP", /* 0x4d */
+ "BRANCHJ", /* 0x4e */
+ "IFMATCH", /* 0x4f */
+ "UNLESSM", /* 0x50 */
+ "SUSPEND", /* 0x51 */
+ "IFTHEN", /* 0x52 */
+ "GROUPP", /* 0x53 */
+ "EVAL", /* 0x54 */
+ "MINMOD", /* 0x55 */
+ "LOGICAL", /* 0x56 */
+ "RENUM", /* 0x57 */
+ "TRIE", /* 0x58 */
+ "TRIEC", /* 0x59 */
+ "AHOCORASICK", /* 0x5a */
+ "AHOCORASICKC", /* 0x5b */
+ "GOSUB", /* 0x5c */
+ "GROUPPN", /* 0x5d */
+ "INSUBP", /* 0x5e */
+ "DEFINEP", /* 0x5f */
+ "ENDLIKE", /* 0x60 */
+ "OPFAIL", /* 0x61 */
+ "ACCEPT", /* 0x62 */
+ "VERB", /* 0x63 */
+ "PRUNE", /* 0x64 */
+ "MARKPOINT", /* 0x65 */
+ "SKIP", /* 0x66 */
+ "COMMIT", /* 0x67 */
+ "CUTGROUP", /* 0x68 */
+ "KEEPS", /* 0x69 */
+ "LNBREAK", /* 0x6a */
+ "OPTIMIZED", /* 0x6b */
+ "PSEUDO", /* 0x6c */
/* ------------ States ------------- */
"TRIE_next", /* REGNODE_MAX +0x01 */
"TRIE_next_fail", /* REGNODE_MAX +0x02 */
EXTCONST U8 PL_varies_bitmask[];
#else
EXTCONST U8 PL_varies_bitmask[] = {
- 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x80, 0x3F, 0xFC, 0x2F, 0x03, 0x00, 0x00, 0x00
+ 0x00, 0x00, 0x00, 0x00, 0xC0, 0x00, 0x00, 0x7F, 0xF8, 0x5F, 0x06, 0x00, 0x00, 0x00
};
#endif /* DOINIT */
#else
EXTCONST U8 PL_simple[] __attribute__deprecated__ = {
REG_ANY, SANY, ANYOF, ANYOFD, ANYOFL, ANYOFPOSIXL, ANYOFH, ANYOFHb,
- ANYOFHr, ANYOFR, ANYOFRb, ANYOFM, NANYOFM, POSIXD, POSIXL, POSIXU,
- POSIXA, NPOSIXD, NPOSIXL, NPOSIXU, NPOSIXA,
+ ANYOFHr, ANYOFHs, ANYOFR, ANYOFRb, ANYOFM, NANYOFM, POSIXD, POSIXL,
+ POSIXU, POSIXA, NPOSIXD, NPOSIXL, NPOSIXU, NPOSIXA,
0
};
#endif /* DOINIT */
EXTCONST U8 PL_simple_bitmask[];
#else
EXTCONST U8 PL_simple_bitmask[] = {
- 0x00, 0x00, 0xFF, 0xFF, 0x1F, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
+ 0x00, 0x00, 0xFF, 0xFF, 0x3F, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
};
#endif /* DOINIT */
#ifdef NO_TAINT_SUPPORT
PERL_UNUSED_VAR(was);
#else
- if (UNLIKELY(a0.any_ptr == &(TAINT_get))) {
+ if (UNLIKELY(a0.any_ptr == &(PL_tainted))) {
/* If we don't update <was>, to reflect what was saved on the
* stack for PL_tainted, then we will overwrite this attempt to
* restore it when we exit this routine. Note that this won't
C<sv_catpvn> and C<sv_catpvn_nomg> are implemented
in terms of this function.
+=for apidoc Amnh||SV_CATUTF8
+=for apidoc Amnh||SV_CATBYTES
+=for apidoc Amnh||SV_SMAGIC
+
=cut
*/
=for apidoc sv_isa
Returns a boolean indicating whether the SV is blessed into the specified
-class. This does not check for subtypes; use C<sv_derived_from> to verify
-an inheritance relationship.
+class.
+
+This does not check for subtypes or method overloading. Use C<sv_isa_sv> to
+verify an inheritance relationship in the same way as the C<isa> operator by
+respecting any C<isa()> method overloading; or C<sv_derived_from_sv> to test
+directly on the actual object type.
=cut
*/
goto string;
}
- if (vectorize && !strchr("BbDdiOouUXx", c))
+ if (vectorize && !memCHRs("BbDdiOouUXx", c))
goto unknown;
/* get next arg (individual branches do their own va_arg()
PL_setlocale_buf = NULL;
PL_setlocale_bufsize = 0;
+ /* Unicode inversion lists */
+
+ PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param);
+ PL_Assigned_invlist = sv_dup_inc(proto_perl->IAssigned_invlist, param);
+ PL_GCB_invlist = sv_dup_inc(proto_perl->IGCB_invlist, param);
+ PL_HasMultiCharFold = sv_dup_inc(proto_perl->IHasMultiCharFold, param);
+ PL_InMultiCharFold = sv_dup_inc(proto_perl->IInMultiCharFold, param);
+ PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param);
+ PL_LB_invlist = sv_dup_inc(proto_perl->ILB_invlist, param);
+ PL_SB_invlist = sv_dup_inc(proto_perl->ISB_invlist, param);
+ PL_SCX_invlist = sv_dup_inc(proto_perl->ISCX_invlist, param);
+ PL_UpperLatin1 = sv_dup_inc(proto_perl->IUpperLatin1, param);
+ PL_in_some_fold = sv_dup_inc(proto_perl->Iin_some_fold, param);
+ PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param);
+ PL_utf8_idstart = sv_dup_inc(proto_perl->Iutf8_idstart, param);
+ PL_utf8_perl_idcont = sv_dup_inc(proto_perl->Iutf8_perl_idcont, param);
+ PL_utf8_perl_idstart = sv_dup_inc(proto_perl->Iutf8_perl_idstart, param);
+ PL_utf8_xidcont = sv_dup_inc(proto_perl->Iutf8_xidcont, param);
+ PL_utf8_xidstart = sv_dup_inc(proto_perl->Iutf8_xidstart, param);
+ PL_WB_invlist = sv_dup_inc(proto_perl->IWB_invlist, param);
+ for (i = 0; i < POSIX_CC_COUNT; i++) {
+ PL_XPosix_ptrs[i] = sv_dup_inc(proto_perl->IXPosix_ptrs[i], param);
+ if (i != _CC_CASED && i != _CC_VERTSPACE) {
+ PL_Posix_ptrs[i] = sv_dup_inc(proto_perl->IPosix_ptrs[i], param);
+ }
+ }
+ PL_Posix_ptrs[_CC_CASED] = PL_Posix_ptrs[_CC_ALPHA];
+ PL_Posix_ptrs[_CC_VERTSPACE] = NULL;
+
+ PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper, param);
+ PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle, param);
+ PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower, param);
+ PL_utf8_tofold = sv_dup_inc(proto_perl->Iutf8_tofold, param);
+ PL_utf8_tosimplefold = sv_dup_inc(proto_perl->Iutf8_tosimplefold, param);
+ PL_utf8_charname_begin = sv_dup_inc(proto_perl->Iutf8_charname_begin, param);
+ PL_utf8_charname_continue = sv_dup_inc(proto_perl->Iutf8_charname_continue, param);
+ PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param);
+ PL_InBitmap = sv_dup_inc(proto_perl->IInBitmap, param);
+ PL_CCC_non0_non230 = sv_dup_inc(proto_perl->ICCC_non0_non230, param);
+ PL_Private_Use = sv_dup_inc(proto_perl->IPrivate_Use, param);
+
#if 0
PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param);
#endif
=for apidoc Am|bool|SvIOK_UV|SV* sv
Returns a boolean indicating whether the SV contains an integer that must be
interpreted as unsigned. A non-negative integer whose value is within the
-range of both an IV and a UV may be be flagged as either C<SvUOK> or C<SVIOK>.
+range of both an IV and a UV may be be flagged as either C<SvUOK> or C<SvIOK>.
=for apidoc Am|bool|SvUOK|SV* sv
Returns a boolean indicating whether the SV contains an integer that must be
interpreted as unsigned. A non-negative integer whose value is within the
-range of both an IV and a UV may be be flagged as either C<SvUOK> or C<SVIOK>.
+range of both an IV and a UV may be be flagged as either C<SvUOK> or C<SvIOK>.
=for apidoc Am|bool|SvIOK_notUV|SV* sv
Returns a boolean indicating whether the SV contains a signed integer.
d_atanh='undef'
d_atolf='undef'
d_atoll='undef'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='undef'
d_wait4='undef'
d_waitpid='undef'
+d_wcrtomb='undef'
d_wcscmp='undef'
d_wcstombs='undef'
d_wcsxfrm='undef'
$x = '0';
-$x eq $x && (print "ok 1\n");
-$x ne $x && (print "not ok 1\n");
-$x eq $x || (print "not ok 2\n");
-$x ne $x || (print "ok 2\n");
+$x eq $x && (print "ok 1 - operator eq\n");
+$x ne $x && (print "not ok 1 - operator ne\n");
+$x eq $x || (print "not ok 2 - operator eq\n");
+$x ne $x || (print "ok 2 - operator ne\n");
-$x == $x && (print "ok 3\n");
-$x != $x && (print "not ok 3\n");
-$x == $x || (print "not ok 4\n");
-$x != $x || (print "ok 4\n");
+$x == $x && (print "ok 3 - operator ==\n");
+$x != $x && (print "not ok 3 - operator !=\n");
+$x == $x || (print "not ok 4 - operator ==\n");
+$x != $x || (print "ok 4 - operator !=\n");
# first test to see if we can run the tests.
$x = 'test';
-if ($x eq $x) { print "ok 1\n"; } else { print "not ok 1\n";}
-if ($x ne $x) { print "not ok 2\n"; } else { print "ok 2\n";}
+if ($x eq $x) { print "ok 1 - if eq\n"; } else { print "not ok 1 - if eq\n";}
+if ($x ne $x) { print "not ok 2 - if ne\n"; } else { print "ok 2 - if ne\n";}
print "# $@" if $@;
}
-# https://rt.perl.org/rt3/Ticket/Display.html?id=56880
+# https://github.com/Perl/perl5/issues/9415
my $counter = 0;
eval 'v23: $counter++; goto v23 unless $counter == 2';
print "not " unless $counter == 2;
# first test to see if we can run the tests.
$_ = 'test';
-if (/^test/) { print "ok 1\n"; } else { print "not ok 1\n";}
-if (/^foo/) { print "not ok 2\n"; } else { print "ok 2\n";}
+if (/^test/) { print "ok 1 - match regex\n"; } else { print "not ok 1 - match regex\n";}
+if (/^foo/) { print "not ok 2 - match regex\n"; } else { print "ok 2 - match regex\n";}
=head1 NAME
-rt26188 - benchmark speed for keys() on empty hashes
+gh7094 - benchmark speed for keys() on empty hashes
=head1 DESCRIPTION
=head1 REFERENCE
-This test tests against RT ticket #26188
+This test tests against GitHub ticket #7094
-L<https://rt.perl.org/rt3/Public/Bug/Display.html?id=26188>
+L<https://github.com/Perl/perl5/issues/7094>
=cut
# the set of 256 characters which is usually called Latin1. However, they
# will work properly with any character input, not just Latin1.
-sub native_to_uni($) {
+*native_to_uni = ($::IS_ASCII)
+ ? sub { return shift }
+ : sub {
my $string = shift;
- return $string if $::IS_ASCII;
my $output = "";
for my $i (0 .. length($string) - 1) {
$output .= chr(utf8::native_to_unicode(ord(substr($string, $i, 1))));
utf8::upgrade($output) if utf8::is_utf8($string);
return $output;
-}
+};
-sub uni_to_native($) {
+*uni_to_native = ($::IS_ASCII)
+ ? sub { return shift }
+ : sub {
my $string = shift;
- return $string if $::IS_ASCII;
my $output = "";
for my $i (0 .. length($string) - 1) {
$output .= chr(utf8::unicode_to_native(ord(substr($string, $i, 1))));
utf8::upgrade($output) if utf8::is_utf8($string);
return $output;
-}
+};
-sub byte_utf8a_to_utf8n {
- # Convert a UTF-8 byte sequence into the platform's native UTF-8
- # equivalent, currently only UTF-8 and UTF-EBCDIC.
+my @utf8_skip;
- my @utf8_skip = (
- # This translates a utf-8-encoded byte into how many bytes the full utf8
- # character occupies.
+if ($::IS_EBCDIC) {
+ @utf8_skip = (
+ # This translates a utf-8-encoded byte into how many bytes the full utf8
+ # character occupies.
- # 0 1 2 3 4 5 6 7 8 9 A B C D E F
+ # 0 1 2 3 4 5 6 7 8 9 A B C D E F
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 0
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 1
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, # 2
3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, # E
4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 6, 6, 7,13, # F
);
+}
+
+*byte_utf8a_to_utf8n = ($::IS_ASCII)
+ ? sub { return shift }
+ : sub {
+ # Convert a UTF-8 byte sequence into the platform's native UTF-8
+ # equivalent, currently only UTF-8 and UTF-EBCDIC.
my $string = shift;
die "Input to byte_utf8a-to_utf8n() must not be flagged UTF-8"
if utf8::is_utf8($string);
- return $string if $::IS_ASCII;
die "Expecting ASCII or EBCDIC" unless $::IS_EBCDIC;
my $length = length($string);
utf8::encode($out); # Turn off utf8 flag.
#diag($out);
return $out;
-}
+};
my @i8_to_native = ( # Only code page 1047 so far.
# _0 _1 _2 _3 _4 _5 _6 _7 _8 _9 _A _B _C _D _E _F
done_testing();
__END__
-# https://rt.perl.org/rt3/Ticket/Display.html?id=28106#txn-82657
+# https://github.com/Perl/perl5/issues/7207#issuecomment-543940952
while (<DATA>) {
chomp;
print "$.: '$_'\n";
2: '2'
3: '3'
########
-# https://rt.perl.org/rt3/Ticket/Display.html?id=28106#txn-83113
+# https://github.com/Perl/perl5/issues/7207#issuecomment-543940955
my $line1 = <DATA>;
`echo foo`;
my $line2 = <DATA>;
ok 1
ok 2
########
-# https://rt.perl.org/rt3/Ticket/Attachment/828796/403048/perlbug.rep.txt
+# https://github.com/Perl/perl5/issues/7207#issuecomment-543940992
my @data_positions = tell(DATA);
while (<DATA>){
if (/^__DATA__$/) {
#!./perl
# print should not return EINTR
-# fails under 5.14.x see https://rt.perl.org/rt3/Ticket/Display.html?id=119097
+# fails under 5.14.x see https://github.com/Perl/perl5/issues/13142
# also fails under 5.8.x
BEGIN {
# vim: ts=4 sts=4 sw=4:
# $! may not be set if EOF was reached without any error.
-# https://rt.perl.org/rt3/Ticket/Display.html?id=39060
+# https://github.com/Perl/perl5/issues/8431
use strict;
use Config;
--- /dev/null
+# for use by caller.t for GH #15109
+package Apack;
+use Bpack;
+1;
--- /dev/null
+# for use by caller.t for GH #15109
+package Bpack;
+use Cpack;
+1;
--- /dev/null
+# for use by caller.t for GH #15109
+package Cpack;
+
+
+my $i = 0;
+
+while (my ($package, $file, $line) = caller($i++)) {
+ push @Cpack::callers, "$file:$line";
+}
+
+1;
--- /dev/null
+Test specifically for things that cop_features broke
+
+__END__
+# NAME check clearing $^H clears the bits
+use feature 'say';
+BEGIN { %^H = () }
+say "Fail";
+EXPECT
+String found where operator expected at - line 3, near "say "Fail""
+ (Do you need to predeclare say?)
+syntax error at - line 3, near "say "Fail""
+Execution of - aborted due to compilation errors.
+########
+# NAME check copying $^H restores the bits
+use feature 'say';
+say "Hello";
+BEGIN { our %work = %^H; }
+no feature 'say';
+BEGIN { %^H = our %work }
+say "Goodbye";
+EXPECT
+Hello
+Goodbye
+########
+# NAME check deleting entries (via feature.pm) clears the bits
+use feature 'say';
+say "Hello";
+no feature 'say';
+say "Goodbye";
+EXPECT
+String found where operator expected at - line 4, near "say "Goodbye""
+ (Do you need to predeclare say?)
+syntax error at - line 4, near "say "Goodbye""
+Execution of - aborted due to compilation errors.
+########
+# NAME check deleting entries (bypass feature.pm) clears the bits
+use feature 'say';
+say "Hello";
+BEGIN { delete $^H{feature_say}; }
+say "Goodbye";
+EXPECT
+String found where operator expected at - line 4, near "say "Goodbye""
+ (Do you need to predeclare say?)
+syntax error at - line 4, near "say "Goodbye""
+Execution of - aborted due to compilation errors.
_trylocale("C", $categories, \@Locale, $allow_incompatible);
_trylocale("POSIX", $categories, \@Locale, $allow_incompatible);
- if ($Config{d_has_C_UTF8} eq 'true') {
+ if ($Config{d_has_C_UTF8} && $Config{d_has_C_UTF8} eq 'true') {
_trylocale("C.UTF-8", $categories, \@Locale, $allow_incompatible);
}
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
- plan( tests => 97 ); # some tests are run in a BEGIN block
+ plan( tests => 109 ); # some tests are run in a BEGIN block
}
my @c;
do './op/caller.pl' or die $@;
+# GH #15109
+# See that callers within a nested series of 'use's gets the right
+# filenames.
+{
+ local @INC = 'lib/GH_15109/';
+ # Apack use's Bpack which use's Cpack which populates @Cpack::caller
+ # with the file:N of all the callers
+ eval 'use Apack; 1';
+ is($@, "", "GH #15109 - eval");
+ is (scalar(@Cpack::callers), 10, "GH #15109 - callers count");
+ like($Cpack::callers[$_], qr{GH_15109/Bpack.pm:3}, "GH #15109 level $_") for 0..2;
+ like($Cpack::callers[$_], qr{GH_15109/Apack.pm:3}, "GH #15109 level $_") for 3..5;
+ like($Cpack::callers[$_], qr{\(eval \d+\):1}, "GH #15109 level $_") for 6..8;
+ like($Cpack::callers[$_], qr{caller\.t}, "GH #15109 level $_") for 9;
+}
+
{
package RT129239;
BEGIN {
#line 12345 "virtually/op/caller.t"
}
}
+
AUTOLOAD BEGIN CHECK CORE DESTROY END INIT UNITCHECK
__DATA__ __END__
and cmp default do dump else elsif eq eval for foreach format ge given goto
- grep gt if last le local lt m map my ne next no or our package print printf
- q qq qr qw qx redo require return s say sort state sub tr unless until use
- when while x xor y
+ grep gt if isa last le local lt m map my ne next no or our package print
+ printf q qq qr qw qx redo require return s say sort state sub tr unless
+ until use when while x xor y
);
open my $kh, $keywords_file
or die "$0 cannot open $keywords_file: $!";
my %unsupported = map +($_=>1), qw (
__DATA__ __END__ AUTOLOAD BEGIN UNITCHECK CORE DESTROY END INIT CHECK and
cmp default do dump else elsif eq eval for foreach
- format ge given goto grep gt if last le local lt m map my ne next
+ format ge given goto grep gt if isa last le local lt m map my ne next
no or our package print printf q qq qr qw qx redo require
return s say sort state sub tr unless until use
when while x xor y
plan tests => 21;
+use utf8; # Tell EBCDIC translator to make this UTF-8,
+
eval {
eval {
die "Horribly\n";
my $val = *x{FILEHANDLE};
# deprecation warning removed in v5.23 -- rjbs, 2015-12-31
- # https://rt.perl.org/Ticket/Display.html?id=127060
+ # https://github.com/Perl/perl5/issues/15105
print {*x{IO}} (! defined $warn
? "ok $test\n" : "not ok $test\n");
curr_test(++$test);
--- /dev/null
+#!./perl
+
+BEGIN {
+ chdir 't' if -d 't';
+ require './test.pl';
+ set_up_inc('../lib');
+ require Config;
+}
+
+use strict;
+use feature 'isa';
+no warnings 'experimental::isa';
+
+plan 11;
+
+package BaseClass {}
+package DerivedClass { our @ISA = qw(BaseClass) }
+package CustomClass {
+ sub isa { length($_[1]) == 9; }
+}
+
+my $baseobj = bless {}, "BaseClass";
+my $derivedobj = bless {}, "DerivedClass";
+my $customobj = bless {}, "CustomClass";
+
+# Bareword package name
+ok($baseobj isa BaseClass, '$baseobj isa BaseClass');
+ok(not($baseobj isa Another::Class), '$baseobj is not Another::Class');
+
+# String package name
+ok($baseobj isa "BaseClass", '$baseobj isa BaseClass');
+ok(not($baseobj isa "DerivedClass"), '$baseobj is not DerivedClass');
+
+ok($derivedobj isa "DerivedClass", '$derivedobj isa DerivedClass');
+ok($derivedobj isa "BaseClass", '$derivedobj isa BaseClass');
+
+# Expression giving a package name
+my $classname = "DerivedClass";
+ok($derivedobj isa $classname, '$derivedobj isa DerivedClass via SV');
+
+# Invoked on instance which overrides ->isa
+ok($customobj isa "Something", '$customobj isa Something');
+ok(not($customobj isa "SomethingElse"), '$customobj isa SomethingElse');
+
+ok(not(undef isa "BaseClass"), 'undef is not BaseClass');
+ok(not([] isa "BaseClass"), 'ARRAYref is not BaseClass');
+
+# TODO: Consider
+# LHS = other class
chdir 't' if -d 't';
require './test.pl';
set_up_inc( '../lib' );
- plan (tests => 195); # some tests are run in BEGIN block
+ plan (tests => 192); # some tests are run in BEGIN block
}
# Test that defined() returns true for magic variables created on the fly,
}
# Check that we don't auto-load packages
-foreach (['powie::!', 'Errno'],
- ['powie::+', 'Tie::Hash::NamedCapture']) {
+foreach (['powie::!', 'Errno']) {
my ($symbol, $package) = @$_;
SKIP: {
(my $extension = $package) =~ s|::|/|g;
}
SKIP: {
- skip_if_miniperl("No XS in miniperl", 2);
+ skip_if_miniperl("No XS in miniperl", 1);
- for ( [qw( %- Tie::Hash::NamedCapture )],
- [qw( %! Errno )] ) {
+ for ( [qw( %! Errno )] ) {
my ($var, $mod) = @$_;
my $modfile = $mod =~ s|::|/|gr . ".pm";
fresh_perl_is
isnt("$fh", "$fh{abc}");
# See that perl does not segfault upon readdir($x=".");
-# https://rt.perl.org/rt3/Ticket/Display.html?id=68182
-fresh_perl_like(<<'EOP', qr/^no crash/, {}, 'RT #68182');
+# https://github.com/Perl/perl5/issues/9813
+fresh_perl_like(<<'EOP', qr/^no crash/, {}, 'GH #9813');
eval {
my $x = ".";
my @files = readdir($x);
# Going to try to switch away from root. Might not work.
my $olduid = $>;
eval { $> = 1; };
- skip "Can't test if an admin user in miniperl", 2,
- if $Is_Cygwin && is_miniperl();
skip "Can't test -r or -w meaningfully if you're superuser", 2
- if ($> == 0);
+ if ($Is_Cygwin ? _ingroup(544, 1) : $> == 0);
SKIP: {
skip "Can't test -r meaningfully?", 1 if $Is_Dos;
chmod 0666, $tmpfile;
unlink_all $tmpfile;
}
+
+sub _ingroup {
+ my ($gid, $eff) = @_;
+
+ $^O eq "VMS" and return $_[0] == $);
+
+ my ($egid, @supp) = split " ", $);
+ my ($rgid) = split " ", $(;
+
+ $gid == ($eff ? $egid : $rgid) and return 1;
+ grep $gid == $_, @supp and return 1;
+
+ return "";
+}
# This syntax error used to cause a crash, double free, or a least
# a bad read.
# See the long-winded explanation at:
-# https://rt.perl.org/rt3/Ticket/Display.html?id=43425#txn-1144500
+# https://github.com/Perl/perl5/issues/8953#issuecomment-543978716
eval q|
format =
@
elsif( $ENV{GITHUB_ACTIONS} && defined $ENV{GITHUB_HEAD_REF} ) {
# Same as above, except for Github Actions
# https://help.github.com/en/actions/automating-your-workflow-with-github-actions/using-environment-variables
- $revision_range = join '..', $ENV{GITHUB_BASE_REF}, $ENV{GITHUB_HEAD_REF};
+
+ # This hardcoded origin/ isn't great, but I'm not sure how to better fix it
+ my $common_ancestor = `git merge-base origin/$ENV{GITHUB_BASE_REF} $ENV{GITHUB_HEAD_REF}`;
+ $common_ancestor =~ s!\s+!!g;
+
+ # We want one before the GITHUB_SHA, as the github-SHA is a merge commit
+ $revision_range = join '..', $common_ancestor, $ENV{GITHUB_SHA} . '^2';
}
# This is the subset of "pretty=fuller" that checkAUTHORS.pl actually needs:
# code on CPAN, and can break cflags.SH.
#
# Why do we test this?
-# See https://rt.perl.org/rt3/Ticket/Display.html?id=116989
+# See https://github.com/Perl/perl5/issues/12824
#
# It's broken - how do I fix it?
# You added an initializer or static function to a header file that
splain
sprintf(3)
stat(2)
+strchr(3)
strftime(3)
strictures
String::Base
set_up_inc('../lib', '.', '../ext/re');
}
-skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
skip_all_without_unicode_tables();
-plan tests => 966; # Update this when adding/deleting tests.
+plan tests => 1014; # Update this when adding/deleting tests.
run_tests() unless caller;
SKIP:
{ # Long Monsters
- skip('limited memory', 20) if $ENV{'PERL_SKIP_BIG_MEM_TESTS'};
+ my @trials = (125, 140, 250, 270, 300000, 30);
- for my $l (125, 140, 250, 270, 300000, 30) { # Ordered to free memory
+ skip('limited memory', @trials * 4) if $ENV{'PERL_SKIP_BIG_MEM_TESTS'};
+
+ for my $l (@trials) { # Ordered to free memory
my $a = 'a' x $l;
my $message = "Long monster, length = $l";
like("ba$a=", qr/a$a=/, $message);
SKIP:
{ # 20000 nodes, each taking 3 words per string, and 1 per branch
- skip('limited memory', 20) if $ENV{'PERL_SKIP_BIG_MEM_TESTS'};
-
- my $long_constant_len = join '|', 12120 .. 32645;
- my $long_var_len = join '|', 8120 .. 28645;
my %ans = ( 'ax13876y25677lbc' => 1,
'ax13876y25677mcb' => 0, # not b.
'ax13876y35677nbc' => 0, # Num too big
'ax13876y25677y21378y21378y21378kbc' => 0, # 5 runs
);
+ skip('limited memory', 2 * scalar keys %ans) if $ENV{'PERL_SKIP_BIG_MEM_TESTS'};
+
+ my $long_constant_len = join '|', 12120 .. 32645;
+ my $long_var_len = join '|', 8120 .. 28645;
+
for (keys %ans) {
my $message = "20000 nodes, const-len '$_'";
ok !($ans{$_} xor /a(?=([yx]($long_constant_len)){2,4}[k-o]).*b./o), $message;
{ # Test that it avoids spllitting a multi-char fold across nodes.
# These all fold to things that are like 'ss', which, if split across
# nodes could fail to match a single character that folds to the
- # combination.
+ # combination. 1F0 byte expands when folded;
my $utf8_locale = find_utf8_ctype_locale();
- for my $char('F', $sharp_s, "\x{FB00}") {
+ for my $char('F', $sharp_s, "\x{1F0}", "\x{FB00}") {
my $length = 260; # Long enough to overflow an EXACTFish regnode
my $p = $char x $length;
- my $s = ($char eq $sharp_s) ? 'ss' : 'ff';
+ my $s = ($char eq $sharp_s) ? 'ss'
+ : $char eq "\x{1F0}"
+ ? "j\x{30c}"
+ : 'ff';
$s = $s x $length;
for my $charset (qw(u d l aa)) {
for my $utf8 (0..1) {
- SKIP:
for my $locale ('C', $utf8_locale) {
- skip "test skipped for non-C locales", 2
+ SKIP:
+ {
+ skip "test skipped for non-C locales", 2
if $charset ne 'l'
&& (! defined $locale || $locale ne 'C');
- if ($charset eq 'l') {
- if (! defined $locale) {
- skip "No UTF-8 locale", 2;
+ if ($charset eq 'l') {
+ if (! defined $locale) {
+ skip "No UTF-8 locale", 2;
+ }
+ skip "Can't test in miniperl",2
+ if is_miniperl();
+
+ require POSIX;
+ POSIX::setlocale(&LC_CTYPE, $locale);
}
- use POSIX;
- POSIX::setlocale(&LC_CTYPE, $locale);
+ my $pat = $p;
+ utf8::upgrade($pat) if $utf8;
+ my $should_pass =
+ ( $charset eq 'u'
+ || ($charset eq 'd' && $utf8)
+ || ($charset eq 'd' && ( $char =~ /[[:ascii:]]/
+ || ord $char > 255))
+ || ($charset eq 'aa' && $char =~ /[[:ascii:]]/)
+ || ($charset eq 'l' && $locale ne 'C')
+ || ($charset eq 'l' && $char =~ /[[:ascii:]]/)
+ );
+ my $name = "(?i$charset), utf8=$utf8, locale=$locale,"
+ . " char=" . sprintf "%x", ord $char;
+ no warnings 'locale';
+ is (eval " '$s' =~ qr/(?i$charset)$pat/;",
+ $should_pass, $name);
+ fail "$name: $@" if $@;
+ is (eval " 'a$s' =~ qr/(?i$charset)a$pat/;",
+ $should_pass, "extra a, $name");
+ fail "$name: $@" if $@;
}
-
- my $pat = $p;
- utf8::upgrade($pat) if $utf8;
- my $should_pass =
- ( $charset eq 'u'
- || ($charset eq 'd' && $utf8)
- || ($charset eq 'd' && ( $char =~ /[[:ascii:]]/
- || ord $char > 255))
- || ($charset eq 'aa' && $char =~ /[[:ascii:]]/)
- || ($charset eq 'l' && $locale ne 'C')
- || ($charset eq 'l' && $char =~ /[[:ascii:]]/)
- );
- my $name = "(?i$charset), utf8=$utf8, locale=$locale,"
- . " char=" . sprintf "%x", ord $char;
- no warnings 'locale';
- is (eval " '$s' =~ qr/(?i$charset)$pat/;",
- $should_pass, $name);
- fail "$name: $@" if $@;
- is (eval " 'a$s' =~ qr/(?i$charset)a$pat/;",
- $should_pass, "extra a, $name");
- fail "$name: $@" if $@;
}
}
}
}
}
+ SKIP:
{
+ skip "no re debug", 5 if is_miniperl;
my $s = ("0123456789" x 26214) x 2; # Should fill 2 LEXACTS, plus
# small change
my $pattern_prefix = "use utf8; use re qw(Debug COMPILE)";
"test that we handle things like m/\\888888888/ without infinite loops" );
}
+ SKIP:
{ # Test that we handle some malformed UTF-8 without looping [perl
# #123562]
-
+ skip "no Encode", 1 if is_miniperl;
my $code='
BEGIN{require q(./test.pl);}
use Encode qw(_utf8_on);
{ # [perl #133871], ASAN/valgrind out-of-bounds access
fresh_perl_like('qr/(?|(())|())|//', qr/syntax error/, {}, "[perl #133871]");
}
+ { # [perl #133871], ASAN/valgrind out-of-bounds access
+ fresh_perl_like('qr/\p{nv:NAnq}/', qr/Can't find Unicode property definition/, {}, "GH #17367");
+ }
+ { # GH #17370, ASAN/valgrind out-of-bounds access
+ fresh_perl_like('qr/\p{nv:qnan}/', qr/Can't find Unicode property definition/, {}, "GH #17370");
+ }
+ { # GH #17371, segfault
+ fresh_perl_like('qr/\p{nv=\\\\\}(?0)|\337ss|\337ss//', qr/Unicode property wildcard not terminated/, {}, "GH #17371");
+ }
+
+ SKIP:
{ # [perl #133921], segfault
+ skip "Not valid for EBCDIC", 5 if $::IS_EBCDIC;
+
fresh_perl_is('qr\ 40||ß+p00000F00000ù\Q00000ÿ00000x00000x0c0e0\Qx0\Qx0\x{0c!}\;\;î0\x\0ÿÿÿþ\0\0\0ù\Q`\Qx`\0\ 1{0c!}\ 1e;\0\0\0ù\ò`\Qm`\x{0c!}\;\;îçÿ \0\7fç\0\0\0!\0F\ 5\0\0/;îçÿù\Q\0\ 1\0\0x\10ÿÿÿÿ\0\0\0ù\0\0\0\7f`x{0c!}\ 1e;\0\0\0ù\Q`\Qx`\x{c!}\;\;îç!}\;îçÿù\Q\87 \x\0ÿÿÿÿ\0\0>=\Qx`\Qx`\0\0ù\ò`\Qx`\x{0c!};\;îçÿ \0F\ 5\0n0t0\0c \0\80\ 1d;t \0\0\0ù \0\7fç\80\0\0!00000000000000000000000m/00000000000000000000\ e00000000000m/\10\10\10\10\x{){} \10\10\10\10)|\10\10\ 4i', "", {}, "[perl #133921]");
fresh_perl_is('\ 4|ß+W0ü0r0\Qx0\Qx0x0c0G00000000000000000O000000000x0x0x0c!}\;îçÿù\Q0 \x\0ÿÿÿÿ\0\0\0ù\Q`\Qx`\0\ 1{0d ;\0\0\0ù\ò`\Qm`\x{0c!}\;\;îçÿ \0\7fç\0\0\0!\0F\ 5\0\0/;îçÿù\Q\0\ 1\0\0x\10ÿÿÿÿ\0\0\0ù\0\0\0\7f`x{0c!}\ 1;\0\0\0ù\Q`\Qq`\x{c!}\;\;îç!}\;îçÿù\Q\87 \x\0ÿÿÿÿ\0\0>=\Qx`\Qx`\0\0ù\ò`\Qx`\x{0c!};\;îçÿ \00000000F\ 5\0m0t0\0c \0\80\ 1d;t \0\0\0ù \0\7fç\80\0\0!00000000000000000000000m/00000000000000000000\ e00000000000m/\10\10\10\10\x{){} \10\10\10\10)|\10\10\ 4\ 4i', "", {}, "[perl #133921]");
"Assertion failure matching /il on single char folding to multi");
}
+ { # Test ANYOFHs
+ my $pat = qr/[\x{4000001}\x{4000003}\x{4000005}]+/;
+ unlike("\x{4000000}", $pat, "4000000 isn't in pattern");
+ like("\x{4000001}", $pat, "4000001 is in pattern");
+ unlike("\x{4000002}", $pat, "4000002 isn't in pattern");
+ like("\x{4000003}", $pat, "4000003 is in pattern");
+ unlike("\x{4000004}", $pat, "4000004 isn't in pattern");
+ like("\x{4000005}", $pat, "4000005 is in pattern");
+ unlike("\x{4000006}", $pat, "4000006 isn't in pattern");
+
+ # gh #17319
+ $pat = qr/[\N{U+200D}\N{U+2000}]()/;
+ unlike("\x{1FFF}", $pat, "1FFF isn't in pattern");
+ like("\x{2000}", $pat, "2000 is in pattern");
+ unlike("\x{2001}", $pat, "2001 isn't in pattern");
+ unlike("\x{200C}", $pat, "200C isn't in pattern");
+ like("\x{200D}", $pat, "200 is in pattern");
+ unlike("\x{200E}", $pat, "200E isn't in pattern");
+ }
+
} # End of sub run_tests
1;
'/\x{100}(?(/' => 'Unknown switch condition (?(...)) {#} m/\\x{100}(?({#}/', # [perl #133896]
'/(?[\N{KEYCAP DIGIT NINE}/' => '\N{} here is restricted to one character {#} m/(?[\\N{U+39.FE0F.20E3{#}}/', # [perl #133988]
'/0000000000000000[\N{U+0.00}0000/' => 'Unmatched [ {#} m/0000000000000000[{#}\N{U+0.00}0000/', # [perl #134059]
+ '/\p{nv=\b5\b}/' => 'Can\'t find Unicode property definition "nv=\\b5\\b" {#} m/\\p{nv=\\b5\\b}{#}/',
);
# These are messages that are death under 'use re "strict"', and may or may
# translated again.
my $first_already_converted_test_num = @tests + 1;
-sub convert_from_ascii {
- my $string = shift;
+sub convert_from_ascii_guts {
+ my $string_ref = shift;
- return $string if ord("A") == 65;
- return $string if $test_num >= $first_already_converted_test_num;
+ return if $test_num >= $first_already_converted_test_num;
- #my $save = $string;
+ #my $save = $string_ref;
# Convert \x{...}, \o{...}
- $string =~ s/ (?<! \\ ) \\x\{ ( .*? ) } / "\\x{" . sprintf("%X", utf8::unicode_to_native(hex $1)) . "}" /gex;
- $string =~ s/ (?<! \\ ) \\o\{ ( .*? ) } / "\\o{" . sprintf("%o", utf8::unicode_to_native(oct $1)) . "}" /gex;
+ $$string_ref =~ s/ (?<! \\ ) \\x\{ ( .*? ) } / "\\x{" . sprintf("%X", utf8::unicode_to_native(hex $1)) . "}" /gex;
+ $$string_ref =~ s/ (?<! \\ ) \\o\{ ( .*? ) } / "\\o{" . sprintf("%o", utf8::unicode_to_native(oct $1)) . "}" /gex;
# Convert \xAB
- $string =~ s/ (?<! \\ ) \\x ( [A-Fa-f0-9]{2} ) / "\\x" . sprintf("%02X", utf8::unicode_to_native(hex $1)) /gex;
+ $$string_ref =~ s/ (?<! \\ ) \\x ( [A-Fa-f0-9]{2} ) / "\\x" . sprintf("%02X", utf8::unicode_to_native(hex $1)) /gex;
# Convert \xA
- $string =~ s/ (?<! \\ ) \\x ( [A-Fa-f0-9] ) (?! [A-Fa-f0-9] ) / "\\x" . sprintf("%X", utf8::unicode_to_native(hex $1)) /gex;
+ $$string_ref =~ s/ (?<! \\ ) \\x ( [A-Fa-f0-9] ) (?! [A-Fa-f0-9] ) / "\\x" . sprintf("%X", utf8::unicode_to_native(hex $1)) /gex;
- #print STDERR __LINE__, ": $save\n$string\n" if $save ne $string;
- return $string;
+ #print STDERR __LINE__, ": $save\n$string_ref\n" if $save ne $string_ref;
+ return;
}
+*convert_from_ascii = (ord("A") == 65)
+ ? sub { 1; }
+ : convert_from_ascii_guts;
+
$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable.
$ffff = chr(0xff) x 2;
$nulnul = "\0" x 2;
my $input = join(':',$pat,$subject,$result,$repl,$expect);
# the double '' below keeps simple syntax highlighters from going crazy
- $pat = "'$pat'" unless $pat =~ /^[:''\/]/;
+ $pat = "'$pat'" unless $pat =~ /^[:''\/]/;
$pat =~ s/(\$\{\w+\})/$1/eeg;
$pat =~ s/\\n/\n/g unless $regex_sets;
- $pat = convert_from_ascii($pat);
+ convert_from_ascii(\$pat);
my $no_null_pat;
if ($no_null && $pat =~ /^'(.*)'\z/) {
$no_null_pat = XS::APItest::string_without_null($1);
}
- $subject = convert_from_ascii($subject);
+ convert_from_ascii(\$subject);
$subject = eval qq("$subject"); die $@ if $@;
- $expect = convert_from_ascii($expect);
+ convert_from_ascii(\$expect);
$expect = eval qq("$expect"); die $@ if $@;
$expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/;
#
# Tests that have to do with checking whether characters have (or not have)
# certain Unicode properties; belong (or not belong) to blocks, scripts, etc.
+# including user-defined properties
#
use strict;
Dash => ['-'],
ASCII_Hex_Digit => ['!-', 'A'],
IsAsciiHexAndDash => ['-', 'A'],
+ InLatin1 => ['\x{0100}', '!\x{00FF}'],
);
@USER_CASELESS_PROPERTIES = (
}
}
-# These override the official ones, so if found before defined, the official
-# ones prevail, so can't test deferred definition
-my @OVERRIDING_USER_DEFINED_PROPERTIES = (
- InLatin1 => ['\x{0100}', '!\x{00FF}'],
-);
-
#
# From the short properties we populate POSIX-like classes.
#
push @CLASSES => "# Short properties" => %SHORT_PROPERTIES,
"# POSIX like properties" => %d,
- "# User defined properties" => @USER_DEFINED_PROPERTIES,
- "# Overriding user defined properties" => @OVERRIDING_USER_DEFINED_PROPERTIES;
+ "# User defined properties" => @USER_DEFINED_PROPERTIES;
#
my $val = *Ẋ{FILEHANDLE};
# deprecation warning removed in v5.23 -- rjbs, 2015-12-31
- # https://rt.perl.org/Ticket/Display.html?id=127060
+ # https://github.com/Perl/perl5/issues/15105
print {*Ẋ{IO}} (! defined $warn
? "ok $test\n" : "not ok $test\n");
curr_test(++$test);
{
# Bleadperl v5.17.9-109-g3283393 breaks ZEFRAM/Module-Runtime-0.013.tar.gz
- # https://rt.perl.org/rt3/Public/Bug/Display.html?id=117101
+ # https://github.com/Perl/perl5/issues/12841
no strict;
local $@;
{
# bleadperl v5.17.9-109-g3283393 breaks JEREMY/File-Signature-1.009.tar.gz
- # https://rt.perl.org/rt3/Ticket/Display.html?id=117145
+ # https://github.com/Perl/perl5/issues/12849
local $@;
my $var = 10;
eval ' ${ var }';
#endif
if (t < e && isWORDCHAR(*t))
t++;
- while (t < e && (isWORDCHAR(*t) || strchr("-_.+", *t)))
+ while (t < e && (isWORDCHAR(*t) || memCHRs("-_.+", *t)))
t++;
if (t < e) {
TAINT;
/* In variables named $^X, these are the legal values for X.
* 1999-02-27 mjd-perl-patch@plover.com */
-#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
+#define isCONTROLVAR(x) (isUPPER(x) || memCHRs("[\\]^_?", (x)))
#define SPACE_OR_TAB(c) isBLANK_A(c)
to be inserted is available as a Perl scalar, the L</lex_stuff_sv>
function is more convenient.
+=for apidoc Amnh||LEX_STUFF_UTF8
+
=cut
*/
Returns true if some new text was added to the buffer, or false if the
buffer has reached the end of the input text.
+=for apidoc Amnh||LEX_KEEP_PREVIOUS
+
=cut
*/
if (must_be_last)
proto_after_greedy_proto = TRUE;
if (underscore) {
- if (!strchr(";@%", *p))
+ if (!memCHRs(";@%", *p))
bad_proto_after_underscore = TRUE;
underscore = FALSE;
}
- if (!strchr("$@%*;[]&\\_+", *p) || *p == '\0') {
+ if (!memCHRs("$@%*;[]&\\_+", *p) || *p == '\0') {
bad_proto = TRUE;
}
else {
static int
S_postderef(pTHX_ int const funny, char const next)
{
- assert(funny == DOLSHARP || strchr("$@%&*", funny));
+ assert(funny == DOLSHARP || memCHRs("$@%&*", funny));
if (next == '*') {
PL_expect = XOPERATOR;
if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
{
break;
}
- if (strchr(":'{$", s[1]))
+ if (memCHRs(":'{$", s[1]))
break;
if (!PL_lex_inpat && (s[1] == '+' || s[1] == '-'))
break; /* in regexp, neither @+ nor @- are interpolated */
else if (*s == '$') {
if (!PL_lex_inpat) /* not a regexp, so $ must be var */
break;
- if (s + 1 < send && !strchr("()| \r\n\t", s[1])) {
+ if (s + 1 < send && !memCHRs("()| \r\n\t", s[1])) {
if (s[1] == '\\') {
Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Possible unintended interpolation of $\\ in regex");
}
/* string-change backslash escapes */
- if (PL_lex_inwhat != OP_TRANS && *s && strchr("lLuUEQF", *s)) {
+ if (PL_lex_inwhat != OP_TRANS && *s && memCHRs("lLuUEQF", *s)) {
--s;
break;
}
if (*s == '-' && s[1] == '>'
&& FEATURE_POSTDEREF_QQ_IS_ENABLED
&& ( (s[2] == '$' && (s[3] == '*' || (s[3] == '#' && s[4] == '*')))
- ||(s[2] == '@' && strchr("*[{",s[3])) ))
+ ||(s[2] == '@' && memCHRs("*[{",s[3])) ))
return TRUE;
if (*s != '{' && *s != '[')
return FALSE;
}
else if (*s == '$'
&& s[1]
- && strchr("[#!%*<>()-=",s[1]))
+ && memCHRs("[#!%*<>()-=",s[1]))
{
- if (/*{*/ strchr("])} =",s[2]))
+ if (/*{*/ memCHRs("])} =",s[2]))
weight -= 10;
else
weight -= 1;
case '\\':
un_char = 254;
if (s[1]) {
- if (strchr("wds]",s[1]))
+ if (memCHRs("wds]",s[1]))
weight += 100;
else if (seen[(U8)'\''] || seen[(U8)'"'])
weight += 1;
- else if (strchr("rnftbxcav",s[1]))
+ else if (memCHRs("rnftbxcav",s[1]))
weight += 40;
else if (isDIGIT(s[1])) {
weight += 40;
case '-':
if (s[1] == '\\')
weight += 50;
- if (strchr("aA01! ",last_un_char))
+ if (memCHRs("aA01! ",last_un_char))
weight += 30;
- if (strchr("zZ79~",s[1]))
+ if (memCHRs("zZ79~",s[1]))
weight += 30;
if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
weight -= 5; /* cope with negative subscript */
STATIC bool
S_word_takes_any_delimiter(char *p, STRLEN len)
{
- return (len == 1 && strchr("msyq", p[0]))
+ return (len == 1 && memCHRs("msyq", p[0]))
|| (len == 2
&& ((p[0] == 't' && p[1] == 'r')
- || (p[0] == 'q' && strchr("qwxr", p[1]))));
+ || (p[0] == 'q' && memCHRs("qwxr", p[1]))));
}
static void
return;
}
while ( isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF)
- || (*s && strchr(" \t$#+-'\"", *s)))
+ || (*s && memCHRs(" \t$#+-'\"", *s)))
{
s += UTF ? UTF8SKIP(s) : 1;
}
case '@':
case '%':
/* spot stuff that looks like an prototype */
- if (strchr("$:@%&*;\\[]", *s)) {
+ if (memCHRs("$:@%&*;\\[]", *s)) {
yyerror("Illegal character following sigil in a subroutine signature");
break;
}
/* parse the = for the default ourselves to avoid '+=' etc being accepted here
* as the ASSIGNOP, and exclude other tokens that start with =
*/
- if (*s == '=' && (!s[1] || strchr("=~>", s[1]) == 0)) {
+ if (*s == '=' && (!s[1] || memCHRs("=~>", s[1]) == 0)) {
/* save now to report with the same context as we did when
* all ASSIGNOPS were accepted */
PL_oldbufptr = s;
if ( s[1] == '#'
&& ( isIDFIRST_lazy_if_safe(s+2, PL_bufend, UTF)
- || strchr("{$:+-@", s[2])))
+ || memCHRs("{$:+-@", s[2])))
{
PL_tokenbuf[0] = '@';
s = scan_ident(s + 1, PL_tokenbuf + 1,
const bool islop = (PL_last_lop == PL_oldoldbufptr);
if (!islop || PL_last_lop_op == OP_GREPSTART)
PL_expect = XOPERATOR;
- else if (strchr("$@\"'`q", *s))
+ else if (memCHRs("$@\"'`q", *s))
PL_expect = XTERM; /* e.g. print $fh "foo" */
- else if ( strchr("&*<%", *s)
+ else if ( memCHRs("&*<%", *s)
&& isIDFIRST_lazy_if_safe(s+1, PL_bufend, UTF))
{
PL_expect = XTERM; /* e.g. print $fh &sub */
s = skipspace(s);
if (((*s == '$' || *s == '&') && s[1] == '*')
||(*s == '$' && s[1] == '#' && s[2] == '*')
- ||((*s == '@' || *s == '%') && strchr("*[{", s[1]))
+ ||((*s == '@' || *s == '%') && memCHRs("*[{", s[1]))
||(*s == '*' && (s[1] == '*' || s[1] == '{'))
)
{
}
term = *t;
open = term;
- if (term && (tmps = strchr("([{< )]}> )]}>",term)))
+ if (term && (tmps = memCHRs("([{< )]}> )]}>",term)))
term = tmps[5];
close = term;
if (open == close)
*/
if (d && *s != '#') {
const char *c = ipath;
- while (*c && !strchr("; \t\r\n\f\v#", *c))
+ while (*c && !memCHRs("; \t\r\n\f\v#", *c))
c++;
if (c < d)
d = NULL; /* "perl" not in first word; ignore */
case KEY_ioctl:
LOP(OP_IOCTL,XTERM);
+ case KEY_isa:
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__ISA), "isa is experimental");
+ Rop(OP_ISA);
+
case KEY_join:
LOP(OP_JOIN,XTERM);
char *d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
for (t=d; isSPACE(*t);)
t++;
- if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
+ if ( *t && memCHRs("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
/* [perl #16184] */
&& !(t[0] == '=' && t[1] == '>')
&& !(t[0] == ':' && t[1] == ':')
if (tmp == '~')
PMop(OP_MATCH);
if (tmp && isSPACE(*s) && ckWARN(WARN_SYNTAX)
- && strchr("+-*/%.^&|<",tmp))
+ && memCHRs("+-*/%.^&|<",tmp))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Reversed %c= operator",(int)tmp);
s--;
* block / parens, boolean operators (&&, ||, //) and branch
* constructs (or, and, if, until, unless, while, err, for).
* Not a very solid hack... */
- if (!*w || !strchr(";&/|})]oaiuwef!=", *w))
+ if (!*w || !memCHRs(";&/|})]oaiuwef!=", *w))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"%s (...) interpreted as function",name);
}
}
else {
termcode = utf8_to_uvchr_buf((U8*)s, (U8*)PL_bufend, &termlen);
- if (UTF && UNLIKELY(! _is_grapheme((U8 *) start,
+ if (UTF && UNLIKELY(! is_grapheme((U8 *) start,
(U8 *) s,
(U8 *) PL_bufend,
termcode)))
&& memEQ(s + 1, (char*)termstr + 1, termlen - 1))
{
if ( UTF
- && UNLIKELY(! _is_grapheme((U8 *) start,
+ && UNLIKELY(! is_grapheme((U8 *) start,
(U8 *) s,
(U8 *) PL_bufend,
termcode)))
/* read exponent part, if present */
if ((isALPHA_FOLD_EQ(*s, 'e')
|| UNLIKELY(hexfp && isALPHA_FOLD_EQ(*s, 'p')))
- && strchr("+-0123456789_", s[1]))
+ && memCHRs("+-0123456789_", s[1]))
{
int exp_digits = 0;
const char *save_s = s;
which covers all the compilation errors that occurred. Some compilation
errors, however, will throw an exception immediately.
+=for apidoc Amnh||PARSE_OPTIONAL
+
=cut
+
*/
OP *
/* HAS_REGCOMP:
* This symbol, if defined, indicates that the regcomp() routine is
- * available to do some regular patern matching (usually on POSIX.2
+ * available to do some regular pattern matching (usually on POSIX.2
* conforming systems).
*/
#define HAS_REGCOMP /* POSIX.2 */
/*#define HASATTRIBUTE_PURE / **/
/*#define HASATTRIBUTE_UNUSED / **/
/*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/
+/*#define HASATTRIBUTE_ALWAYS_INLINE / **/
/* HAS_BACKTRACE:
* This symbol, if defined, indicates that the backtrace() routine is
/*#define HAS_TTYNAME_R / **/
#define TTYNAME_R_PROTO 0 /**/
+/* HAS_WCRTOMB:
+ * This symbol, if defined, indicates that the wcrtomb routine is
+ * available to convert a wide character into a multi-byte character.
+ */
+/*#define HAS_WCRTOMB / **/
+
/* I_MACH_CTHREADS:
* This symbol, if defined, indicates to the C program that it should
* include <mach/cthreads.h>.
#endif
/* Generated from:
- * e3dbc17ac938c9df0df81930ccebf94a0425dbff9d20c3edd18a84075eff4fc2 config_h.SH
- * a11d95f56af200907b9285ed0da243a4c20db34f5684af313d18195eaba2b18b uconfig.sh
+ * 8762a3dfdfab48d1fe29cf7b27dfa150e1eec38b0d1f0f441d7cd9f5abef7dc8 config_h.SH
+ * 31c25f95118efbf99e358f81091058e6723b4cccb8474dfbc6d06c2b7d46ff17 uconfig.sh
* ex: set ro: */
d_atanh='undef'
d_atolf='undef'
d_atoll='undef'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='undef'
d_wait4='undef'
d_waitpid='undef'
+d_wcrtomb='undef'
d_wcscmp='undef'
d_wcstombs='undef'
d_wcsxfrm='undef'
d_atanh='undef'
d_atolf='undef'
d_atoll='undef'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='undef'
d_wait4='undef'
d_waitpid='undef'
+d_wcrtomb='undef'
d_wcscmp='undef'
d_wcstombs='undef'
d_wcsxfrm='undef'
* 78e2600e24fa7d5ab62117de50b382f8b31b08401c37a0782c38dacb340b64e7 lib/unicore/extracted/DLineBreak.txt
* 1bde4ad73e271c6349fbd1972e54f38bba5cc1900c28f678e79b9e8909b31793 lib/unicore/extracted/DNumType.txt
* 6278722699123f3890e4b1cc42011e96d8960e4958a3b93484361530983d2611 lib/unicore/extracted/DNumValues.txt
- * 08071cd168b1ac72bf01f13a82c4d0470a391e2bdd0b706e9fe20ab17cc861c8 lib/unicore/mktables
+ * 498da0b9ef6a52bfd71bda5771005bbe4cfc37b456d9d350cd840991eb80c8b1 lib/unicore/mktables
* a712c758275b460d18fa77a26ed3589689bb3f69dcc1ea99b913e32db92a5cd2 lib/unicore/version
* 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl
* e9283c761c5a95e3379384ca47c13a284f08d743c2be6e5091f1152b1b6b7a37 regen/mk_PL_charclass.pl
- * 74442760b048f85cf5e9e87c3baffc94e861ba397dda0d33f4c22b40ef7efbe6 regen/mk_invlists.pl
+ * bddfa92837a1e11b3c74c80512e0492dc325a15ee9e2d768f246ddb3ef3bcef9 regen/mk_invlists.pl
* cf1d68efb7d919d302c4005641eae8d36da6d7850816ad374b0c00b45e609f43 regen/mph.pl
* ex: set ro: */
}
/*
+=for apidoc sv_isa_sv
+
+Returns a boolean indicating whether the SV is an object reference and is
+derived from the specified class, respecting any C<isa()> method overloading
+it may have. Returns false if C<sv> is not a reference to an object, or is
+not derived from the specified class.
+
+This is the function used to implement the behaviour of the C<isa> operator.
+
+Does not invoke magic on C<sv>.
+
+Not to be confused with the older C<sv_isa> function, which does not use an
+overloaded C<isa()> method, nor will check subclassing.
+
+=cut
+
+*/
+
+bool
+Perl_sv_isa_sv(pTHX_ SV *sv, SV *namesv)
+{
+ GV *isagv;
+
+ PERL_ARGS_ASSERT_SV_ISA_SV;
+
+ if(!SvROK(sv) || !SvOBJECT(SvRV(sv)))
+ return FALSE;
+
+ /* This abuse of gv_fetchmeth_pv() with level = 1 skips the UNIVERSAL
+ * lookup
+ * TODO: Consider if we want a NOUNIVERSAL flag for requesting this in a
+ * more obvious way
+ */
+ isagv = gv_fetchmeth_pvn(SvSTASH(SvRV(sv)), "isa", 3, 1, 0);
+ if(isagv) {
+ dSP;
+ CV *isacv = isGV(isagv) ? GvCV(isagv) : (CV *)isagv;
+ SV *retsv;
+ bool ret;
+
+ PUTBACK;
+
+ ENTER;
+ SAVETMPS;
+
+ EXTEND(SP, 2);
+ PUSHMARK(SP);
+ PUSHs(sv);
+ PUSHs(namesv);
+ PUTBACK;
+
+ call_sv((SV *)isacv, G_SCALAR);
+
+ SPAGAIN;
+ retsv = POPs;
+ ret = SvTRUE(retsv);
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ return ret;
+ }
+
+ /* TODO: Support namesv being an HV ref to the stash directly? */
+
+ return sv_derived_from_sv(sv, namesv, 0);
+}
+
+/*
=for apidoc sv_does_sv
Returns a boolean indicating whether the SV performs a specific, named role.
#endif
+XS(XS_NamedCapture_tie_it)
+{
+ dXSARGS;
+
+ if (items != 1)
+ croak_xs_usage(cv, "sv");
+ {
+ SV *sv = ST(0);
+ GV * const gv = (GV *)sv;
+ HV * const hv = GvHVn(gv);
+ SV *rv = newSV_type(SVt_IV);
+ const char *gv_name = GvNAME(gv);
+
+ SvRV_set(rv, newSVuv(
+ strEQ(gv_name, "-") || strEQ(gv_name, "\003APTURE_ALL")
+ ? RXapif_ALL : RXapif_ONE));
+ SvROK_on(rv);
+ sv_bless(rv, GvSTASH(CvGV(cv)));
+
+ sv_unmagic((SV *)hv, PERL_MAGIC_tied);
+ sv_magic((SV *)hv, rv, PERL_MAGIC_tied, NULL, 0);
+ SvREFCNT_dec(rv); /* As sv_magic increased it by one. */
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_NamedCapture_TIEHASH)
+{
+ dVAR; dXSARGS;
+ if (items < 1)
+ croak_xs_usage(cv, "package, ...");
+ {
+ const char * package = (const char *)SvPV_nolen(ST(0));
+ UV flag = RXapif_ONE;
+ mark += 2;
+ while(mark < sp) {
+ STRLEN len;
+ const char *p = SvPV_const(*mark, len);
+ if(memEQs(p, len, "all"))
+ flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE;
+ mark += 2;
+ }
+ ST(0) = sv_2mortal(newSV_type(SVt_IV));
+ sv_setuv(newSVrv(ST(0), package), flag);
+ }
+ XSRETURN(1);
+}
+
+/* These are tightly coupled to the RXapif_* flags defined in regexp.h */
+#define UNDEF_FATAL 0x80000
+#define DISCARD 0x40000
+#define EXPECT_SHIFT 24
+#define ACTION_MASK 0x000FF
+
+#define FETCH_ALIAS (RXapif_FETCH | (2 << EXPECT_SHIFT))
+#define STORE_ALIAS (RXapif_STORE | (3 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
+#define DELETE_ALIAS (RXapif_DELETE | (2 << EXPECT_SHIFT) | UNDEF_FATAL)
+#define CLEAR_ALIAS (RXapif_CLEAR | (1 << EXPECT_SHIFT) | UNDEF_FATAL | DISCARD)
+#define EXISTS_ALIAS (RXapif_EXISTS | (2 << EXPECT_SHIFT))
+#define SCALAR_ALIAS (RXapif_SCALAR | (1 << EXPECT_SHIFT))
+
+XS(XS_NamedCapture_FETCH)
+{
+ dVAR; dXSARGS;
+ dXSI32;
+ PERL_UNUSED_VAR(cv); /* -W */
+ PERL_UNUSED_VAR(ax); /* -Wall */
+ SP -= items;
+ {
+ REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
+ U32 flags;
+ SV *ret;
+ const U32 action = ix & ACTION_MASK;
+ const int expect = ix >> EXPECT_SHIFT;
+ if (items != expect)
+ croak_xs_usage(cv, expect == 2 ? "$key"
+ : (expect == 3 ? "$key, $value"
+ : ""));
+
+ if (!rx || !SvROK(ST(0))) {
+ if (ix & UNDEF_FATAL)
+ Perl_croak_no_modify();
+ else
+ XSRETURN_UNDEF;
+ }
+
+ flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
+
+ PUTBACK;
+ ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL,
+ expect >= 3 ? ST(2) : NULL, flags | action);
+ SPAGAIN;
+
+ if (ix & DISCARD) {
+ /* Called with G_DISCARD, so our return stack state is thrown away.
+ Hence if we were returned anything, free it immediately. */
+ SvREFCNT_dec(ret);
+ } else {
+ PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
+ }
+ PUTBACK;
+ return;
+ }
+}
+
+
+XS(XS_NamedCapture_FIRSTKEY)
+{
+ dVAR; dXSARGS;
+ dXSI32;
+ PERL_UNUSED_VAR(cv); /* -W */
+ PERL_UNUSED_VAR(ax); /* -Wall */
+ SP -= items;
+ {
+ REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
+ U32 flags;
+ SV *ret;
+ const int expect = ix ? 2 : 1;
+ const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY;
+ if (items != expect)
+ croak_xs_usage(cv, expect == 2 ? "$lastkey" : "");
+
+ if (!rx || !SvROK(ST(0)))
+ XSRETURN_UNDEF;
+
+ flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0))));
+
+ PUTBACK;
+ ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx),
+ expect >= 2 ? ST(1) : NULL,
+ flags | action);
+ SPAGAIN;
+
+ PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
+ PUTBACK;
+ return;
+ }
+}
+
+/* is this still needed? */
+XS(XS_NamedCapture_flags)
+{
+ dVAR; dXSARGS;
+ PERL_UNUSED_VAR(cv); /* -W */
+ PERL_UNUSED_VAR(ax); /* -Wall */
+ SP -= items;
+ {
+ EXTEND(SP, 2);
+ mPUSHu(RXapif_ONE);
+ mPUSHu(RXapif_ALL);
+ PUTBACK;
+ return;
+ }
+}
+
#include "vutil.h"
#include "vxs.inc"
const char *name;
XSUBADDR_t xsub;
const char *proto;
+ int ix;
};
static const struct xsub_details these_details[] = {
- {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
- {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
- {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
+ {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL, 0 },
+ {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL, 0 },
+ {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL, 0 },
#define VXS_XSUB_DETAILS
#include "vxs.inc"
#undef VXS_XSUB_DETAILS
- {"utf8::is_utf8", XS_utf8_is_utf8, NULL},
- {"utf8::valid", XS_utf8_valid, NULL},
- {"utf8::encode", XS_utf8_encode, NULL},
- {"utf8::decode", XS_utf8_decode, NULL},
- {"utf8::upgrade", XS_utf8_upgrade, NULL},
- {"utf8::downgrade", XS_utf8_downgrade, NULL},
- {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
- {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
- {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
- {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
- {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
- {"constant::_make_const", XS_constant__make_const, "\\[$@]"},
- {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
- {"re::is_regexp", XS_re_is_regexp, "$"},
- {"re::regname", XS_re_regname, ";$$"},
- {"re::regnames", XS_re_regnames, ";$"},
- {"re::regnames_count", XS_re_regnames_count, ""},
- {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
+ {"utf8::is_utf8", XS_utf8_is_utf8, NULL, 0 },
+ {"utf8::valid", XS_utf8_valid, NULL, 0 },
+ {"utf8::encode", XS_utf8_encode, NULL, 0 },
+ {"utf8::decode", XS_utf8_decode, NULL, 0 },
+ {"utf8::upgrade", XS_utf8_upgrade, NULL, 0 },
+ {"utf8::downgrade", XS_utf8_downgrade, NULL, 0 },
+ {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL, 0 },
+ {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL, 0 },
+ {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$", 0 },
+ {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$", 0 },
+ {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%", 0 },
+ {"constant::_make_const", XS_constant__make_const, "\\[$@]", 0 },
+ {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@", 0 },
+ {"re::is_regexp", XS_re_is_regexp, "$", 0 },
+ {"re::regname", XS_re_regname, ";$$", 0 },
+ {"re::regnames", XS_re_regnames, ";$", 0 },
+ {"re::regnames_count", XS_re_regnames_count, "", 0 },
+ {"re::regexp_pattern", XS_re_regexp_pattern, "$", 0 },
#ifdef HAS_GETCWD
- {"Internals::getcwd", XS_Internals_getcwd, ""},
+ {"Internals::getcwd", XS_Internals_getcwd, "", 0 },
#endif
+ {"Tie::Hash::NamedCapture::_tie_it", XS_NamedCapture_tie_it, NULL, 0 },
+ {"Tie::Hash::NamedCapture::TIEHASH", XS_NamedCapture_TIEHASH, NULL, 0 },
+ {"Tie::Hash::NamedCapture::FETCH", XS_NamedCapture_FETCH, NULL, FETCH_ALIAS },
+ {"Tie::Hash::NamedCapture::STORE", XS_NamedCapture_FETCH, NULL, STORE_ALIAS },
+ {"Tie::Hash::NamedCapture::DELETE", XS_NamedCapture_FETCH, NULL, DELETE_ALIAS },
+ {"Tie::Hash::NamedCapture::CLEAR", XS_NamedCapture_FETCH, NULL, CLEAR_ALIAS },
+ {"Tie::Hash::NamedCapture::EXISTS", XS_NamedCapture_FETCH, NULL, EXISTS_ALIAS },
+ {"Tie::Hash::NamedCapture::SCALAR", XS_NamedCapture_FETCH, NULL, SCALAR_ALIAS },
+ {"Tie::Hash::NamedCapture::FIRSTKEY", XS_NamedCapture_FIRSTKEY, NULL, 0 },
+ {"Tie::Hash::NamedCapture::NEXTKEY", XS_NamedCapture_FIRSTKEY, NULL, 1 },
+ {"Tie::Hash::NamedCapture::flags", XS_NamedCapture_flags, NULL, 0 },
};
STATIC OP*
const struct xsub_details *end = C_ARRAY_END(these_details);
do {
- newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
+ CV *cv = newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
+ XSANY.any_i32 = xsub->ix;
} while (++xsub < end);
#ifndef EBCDIC
use and those yet to be assigned, are never considered malformed and never
warn.
+=for apidoc Amnh||UTF8_CHECK_ONLY
+=for apidoc Amnh||UTF8_DISALLOW_ILLEGAL_INTERCHANGE
+=for apidoc Amnh||UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE
+=for apidoc Amnh||UTF8_DISALLOW_SURROGATE
+=for apidoc Amnh||UTF8_DISALLOW_NONCHAR
+=for apidoc Amnh||UTF8_DISALLOW_SUPER
+=for apidoc Amnh||UTF8_WARN_ILLEGAL_INTERCHANGE
+=for apidoc Amnh||UTF8_WARN_ILLEGAL_C9_INTERCHANGE
+=for apidoc Amnh||UTF8_WARN_SURROGATE
+=for apidoc Amnh||UTF8_WARN_NONCHAR
+=for apidoc Amnh||UTF8_WARN_SUPER
+=for apidoc Amnh||UTF8_WARN_PERL_EXTENDED
+=for apidoc Amnh||UTF8_DISALLOW_PERL_EXTENDED
+
=cut
Also implemented as a macro in utf8.h
}
/*
-No = here because currently externally undocumented
-for apidoc bytes_from_utf8_loc
+=for comment
+skip apidoc
+This is not currently externally documented because we don't want people to use
+it for now. XXX Perhaps that is too paranoid, and it should be documented?
+
+=for apidoc bytes_from_utf8_loc
Like C<L</bytes_from_utf8>()>, but takes an extra parameter, a pointer to where
to store the location of the first character in C<"s"> that cannot be
((UTF_CONTINUATION_MARK >> UTF_ACCUMULATION_SHIFT) | UTF_START_MARK(2))
/* Is the byte 'c' the first byte of a multi-byte UTF8-8 encoded sequence?
- * This doesn't catch invariants (they are single-byte). It also excludes the
+ * This excludes invariants (they are single-byte). It also excludes the
* illegal overlong sequences that begin with C0 and C1 on ASCII platforms, and
- * C0-C4 I8 start bytes on EBCDIC ones */
-#define UTF8_IS_START(c) (__ASSERT_(FITS_IN_8_BITS(c)) \
+ * C0-C4 I8 start bytes on EBCDIC ones. On EBCDIC E0 can't start a
+ * non-overlong sequence, so we define a base macro and for those platforms,
+ * extend it to also exclude E0 */
+#define UTF8_IS_START_base(c) (__ASSERT_(FITS_IN_8_BITS(c)) \
(NATIVE_UTF8_TO_I8(c) >= UTF_MIN_START_BYTE))
+#ifdef EBCDIC
+# define UTF8_IS_START(c) \
+ (UTF8_IS_START_base(c) && (c) != I8_TO_NATIVE_UTF8(0xE0))
+#else
+# define UTF8_IS_START(c) UTF8_IS_START_base(c)
+#endif
#define UTF_MIN_ABOVE_LATIN1_BYTE \
((0x100 >> UTF_ACCUMULATION_SHIFT) | UTF_START_MARK(2))
* beginning of a utf8 character. Now that foo_utf8() determines that itself,
* no need to do it again here
*/
-#define isIDFIRST_lazy_if(p,UTF) \
- _is_utf8_FOO(_CC_IDFIRST, (const U8 *) p, "isIDFIRST_lazy_if", \
- "isIDFIRST_lazy_if_safe", \
- cBOOL(UTF && ! IN_BYTES), 0, __FILE__,__LINE__)
-
#define isIDFIRST_lazy_if_safe(p, e, UTF) \
((IN_BYTES || !UTF) \
? isIDFIRST(*(p)) \
: isIDFIRST_utf8_safe(p, e))
-
-#define isWORDCHAR_lazy_if(p,UTF) \
- _is_utf8_FOO(_CC_IDFIRST, (const U8 *) p, "isWORDCHAR_lazy_if", \
- "isWORDCHAR_lazy_if_safe", \
- cBOOL(UTF && ! IN_BYTES), 0, __FILE__,__LINE__)
-
#define isWORDCHAR_lazy_if_safe(p, e, UTF) \
((IN_BYTES || !UTF) \
? isWORDCHAR(*(p)) \
: isWORDCHAR_utf8_safe((U8 *) p, (U8 *) e))
-
-#define isALNUM_lazy_if(p,UTF) \
- _is_utf8_FOO(_CC_IDFIRST, (const U8 *) p, "isALNUM_lazy_if", \
- "isWORDCHAR_lazy_if_safe", \
- cBOOL(UTF && ! IN_BYTES), 0, __FILE__,__LINE__)
+#define isALNUM_lazy_if_safe(p, e, UTF) isWORDCHAR_lazy_if_safe(p, e, UTF)
#define UTF8_MAXLEN UTF8_MAXBYTES
envstr = S_env_alloc(NULL, nlen, vlen, 2, 1);
my_setenv_format(envstr, nam, nlen, val, vlen);
(void)PerlEnv_putenv(envstr);
- Safefree(envstr);
+ safesysfree(envstr);
}
# endif /* WIN32 || NETWARE */
return FALSE;
len = strlen(format);
/* minimum length three: %Qg */
- if (len < 3 || strchr("efgaEFGA", format[len - 1]) == NULL)
+ if (len < 3 || memCHRs("efgaEFGA", format[len - 1]) == NULL)
return FALSE;
if (format[len - 2] != 'Q')
return FALSE;
else
while (isDIGIT(*q)) q++;
}
- if (strchr("efgaEFGA", *q)) /* Would have needed 'Q' in front. */
+ if (memCHRs("efgaEFGA", *q)) /* Would have needed 'Q' in front. */
return TRUE;
p = q + 1;
}
(*(f) == '/' \
|| (strchr(f,':') \
|| ((*(f) == '[' || *(f) == '<') \
- && (isWORDCHAR((f)[1]) || strchr("$-_]>",(f)[1])))))
+ && (isWORDCHAR((f)[1]) || memCHRs("$-_]>",(f)[1])))))
#elif defined(WIN32) || defined(__CYGWIN__)
# define PERL_FILE_IS_ABSOLUTE(f) \
Harassing or flaming them is likely to have the opposite effect of the
one you want.)
-Feel free to update the ticket about your bug on https://rt.perl.org
+Feel free to update the ticket about your bug on
+L<https://github.com/Perl/perl5/issues>
if a new version of Perl is released and your bug is still present.
=head1 OPTIONS
extra.pods : miniperl
@ @extra_pods.com
-PERLDELTA_CURRENT = [.pod]perl5316delta.pod
+PERLDELTA_CURRENT = [.pod]perl5317delta.pod
$(PERLDELTA_CURRENT) : [.pod]perldelta.pod
Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT)
/* Don't escape again if following character is
* already something we escape.
*/
- if (strchr(".!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) {
+ if (memCHRs(".!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) {
*outspec = *inspec;
*output_cnt = 1;
return 1;
/* Don't escape again if following character is
* already something we escape.
*/
- if (strchr("\"`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) {
+ if (memCHRs("\"`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) {
*(cp1++) = *(cp2++);
break;
}
for (cp = av[i]+1; *cp; cp++) {
if (*cp == 'T') { will_taint = 1; break; }
else if ( (*cp == 'd' || *cp == 'V') && *(cp+1) == ':' ||
- strchr("DFIiMmx",*cp)) break;
+ memCHRs("DFIiMmx",*cp)) break;
}
if (will_taint) break;
}
# define VXS_CLASS "version"
# define VXSp(name) XS_##name
/* VXSXSDP = XSUB Details Proto */
-# define VXSXSDP(x) x
+# define VXSXSDP(x) x, 0
#else
# define VXS_CLASS "version::vxs"
# define VXSp(name) VXS_##name
#define WARN_EXPERIMENTAL__UNIPROP_WILDCARDS 71
#define WARN_EXPERIMENTAL__VLB 72
+/* Warnings Categories added in Perl 5.031 */
+
+#define WARN_EXPERIMENTAL__ISA 73
+
/*
=for apidoc Amnh||WARN_ALL
=for apidoc Amnh||WARN_EXPERIMENTAL__PRIVATE_USE
=for apidoc Amnh||WARN_EXPERIMENTAL__UNIPROP_WILDCARDS
=for apidoc Amnh||WARN_EXPERIMENTAL__VLB
+=for apidoc Amnh||WARN_EXPERIMENTAL__ISA
=cut
*/
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER := \5.31.6
+#INST_VER := \5.31.7
#
# Comment this out if you DON'T want your perl installation to have
GCCVER3 := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%k)
# If you are using GCC, 4.3 or later by default we add the -fwrapv option.
-# See https://rt.perl.org/Ticket/Display.html?id=121505
+# See https://github.com/Perl/perl5/issues/13690
#
GCCWRAPV := $(shell if "$(GCCVER1)"=="4" (if "$(GCCVER2)" geq "3" echo define) else if "$(GCCVER1)" geq "5" (echo define))
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perldelta.pod ..\pod\perl5316delta.pod
+ copy ..\pod\perldelta.pod ..\pod\perl5317delta.pod
$(MINIPERL) -I..\lib $(PL2BAT) $(UTILS)
$(MINIPERL) -I..\lib ..\autodoc.pl ..
$(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q ..
-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
-cd $(PODDIR) && del /f *.html *.bat roffitall \
- perl5316delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+ perl5317delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \
perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER = \5.31.6
+#INST_VER = \5.31.7
#
# Comment this out if you DON'T want your perl installation to have
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perldelta.pod ..\pod\perl5316delta.pod
+ copy ..\pod\perldelta.pod ..\pod\perl5317delta.pod
cd ..\win32
$(PERLEXE) $(PL2BAT) $(UTILS)
$(MINIPERL) -I..\lib ..\autodoc.pl ..
-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
-cd $(PODDIR) && del /f *.html *.bat roffitall \
- perl5316delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+ perl5317delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \
perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
d_atanh='define'
d_atolf='undef'
d_atoll='undef'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='define'
d_wait4='undef'
d_waitpid='define'
+d_wcrtomb='undef'
d_wcscmp='define'
d_wcstombs='define'
d_wcsxfrm='define'
d_atanh='undef'
d_atolf='undef'
d_atoll='undef'
+d_attribute_always_inline='undef'
d_attribute_deprecated='undef'
d_attribute_format='undef'
d_attribute_malloc='undef'
d_vsnprintf='define'
d_wait4='undef'
d_waitpid='define'
+d_wcrtomb='undef'
d_wcscmp='define'
d_wcstombs='define'
d_wcsxfrm='define'
/* HAS_REGCOMP:
* This symbol, if defined, indicates that the regcomp() routine is
- * available to do some regular patern matching (usually on POSIX.2
+ * available to do some regular pattern matching (usually on POSIX.2
* conforming systems).
*/
/*#define HAS_REGCOMP / * POSIX.2 */
/* HAS_REGCOMP:
* This symbol, if defined, indicates that the regcomp() routine is
- * available to do some regular patern matching (usually on POSIX.2
+ * available to do some regular pattern matching (usually on POSIX.2
* conforming systems).
*/
/*#define HAS_REGCOMP / * POSIX.2 */
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER *= \5.31.6
+#INST_VER *= \5.31.7
#
# Comment this out if you DON'T want your perl installation to have
#
# If you are using GCC, 4.3 or later by default we add the -fwrapv option.
-# See https://rt.perl.org/Ticket/Display.html?id=121505
+# See https://github.com/Perl/perl5/issues/13690
#
#GCCWRAPV *= define
GCCVER3:= $(shell for /f "delims=. tokens=1,2,3" %i in ('gcc -dumpversion') do @echo %k)
# If you are using GCC, 4.3 or later by default we add the -fwrapv option.
-# See https://rt.perl.org/Ticket/Display.html?id=121505
+# See https://github.com/Perl/perl5/issues/13690
#
GCCWRAPV *= $(shell if "$(GCCVER1)"=="4" (if "$(GCCVER2)" geq "3" echo define) else if "$(GCCVER1)" geq "5" (echo define))
copy ..\README.tw ..\pod\perltw.pod
copy ..\README.vos ..\pod\perlvos.pod
copy ..\README.win32 ..\pod\perlwin32.pod
- copy ..\pod\perldelta.pod ..\pod\perl5316delta.pod
+ copy ..\pod\perldelta.pod ..\pod\perl5317delta.pod
$(MINIPERL) -I..\lib $(PL2BAT) $(UTILS)
$(MINIPERL) -I..\lib ..\autodoc.pl ..
$(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q ..
-if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
-if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
-cd $(PODDIR) && del /f *.html *.bat roffitall \
- perl5316delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+ perl5317delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \
perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
perl5314delta.pod \
perl5315delta.pod \
perl5316delta.pod \
+ perl5317delta.pod \
perl561delta.pod \
perl56delta.pod \
perl581delta.pod \
perl5314delta.man \
perl5315delta.man \
perl5316delta.man \
+ perl5317delta.man \
perl561delta.man \
perl56delta.man \
perl581delta.man \
perl5314delta.html \
perl5315delta.html \
perl5316delta.html \
+ perl5317delta.html \
perl561delta.html \
perl56delta.html \
perl581delta.html \
perl5314delta.tex \
perl5315delta.tex \
perl5316delta.tex \
+ perl5317delta.tex \
perl561delta.tex \
perl56delta.tex \
perl581delta.tex \
* caching reasons, and the child thread was attached to a different CPU
* therefore there is no workload on that CPU and Sleep(0) returns control
* without yielding the time slot.
- * https://rt.perl.org/rt3/Ticket/Display.html?id=88840
+ * https://github.com/Perl/perl5/issues/11267
*/
Sleep(0);
win32_async_check(aTHX);
projects / platform / upstream / perl.git / commitdiff