Casey R. Tweten <crt@kiski.net>
Casey West <casey@geeknest.com>
Castor Fu
+Chad Granum <chad.granum@dreamhost.com>
Chaim Frenkel <chaimf@pobox.com>
Charles Bailey <bailey@newman.upenn.edu>
Charles F. Randall <crandall@free.click-n-call.com>
Sullivan Beck <sbeck@cpan.org>
Sven Strickroth <sven.strickroth@tu-clausthal.de>
Sven Verdoolaege <skimo@breughel.ufsia.ac.be>
+syber <syber@crazypanda.ru>
SynaptiCAD, Inc. <sales@syncad.com>
Takis Psarogiannakopoulos <takis@xfree86.org>
Taro KAWAGISHI
Vishal Bhatia <vishal@deja.com>
Vlad Harchev <hvv@hippo.ru>
Vladimir Alexiev <vladimir@cs.ualberta.ca>
+Vladimir Marek <vlmarek@volny.cz>
Vladimir Timofeev <vovkasm@gmail.com>
Volker Schatz <perldoc@volkerschatz.com>
W. Geoffrey Rommel <grommel@sears.com>
d_killpg=''
d_lchown=''
d_ldbl_dig=''
+d_ldexpl=''
d_libm_lib_version=''
d_link=''
d_localtime_r=''
d_locconv=''
d_lockf=''
d_longdbl=''
+longdblkind=''
longdblsize=''
d_longlong=''
longlongsize=''
esac
case "$less" in
'') ;;
-*) if $less -R </dev/null >/dev/null; then
+*) if $less -R </dev/null >/dev/null 2>&1; then
echo "Substituting less -R for less."
less="$less -R"
_less=$less
set d_ldbl_dig
eval $setvar
+: see if ldexpl exists
+set ldexpl d_ldexpl
+eval $inlibc
+
: see if this is a math.h system
set math.h i_math
eval $inhdr
message="$message frexpl"
fi
fi
+ if $test "$d_ldexpl" != "$define"; then
+ message="$message ldexpl"
+ fi
if $test "$message" != ""; then
$cat <<EOM >&4
$echo "(UV will be "$uvtype", $uvsize bytes)"
$echo "(NV will be "$nvtype", $nvsize bytes)"
+$echo "Checking the kind of long doubles you have..." >&4
+: volatile so that the compiler has to store it out to memory.
+if test X"$d_volatile" = X"$define"; then
+ volatile=volatile
+fi
+case "$d_longdbl" in
+define)
+$cat <<EOP >try.c
+#$i_float I_FLOAT
+#$i_stdlib I_STDLIB
+#define LONGDBLSIZE $longdblsize
+#ifdef I_FLOAT
+#include <float.h>
+#endif
+#ifdef I_STDLIB
+#include <stdlib.h>
+#endif
+#include <stdio.h>
+static const long double d = -0.1L;
+int main() {
+ unsigned const char* b = (unsigned const char*)(&d);
+#if LDBL_MANT_DIG == 113 && LONGDBLSIZE == 16
+ if (b[0] == 0x9A && b[1] == 0x99 && b[15] == 0xBF) {
+ /* IEEE 754 128-bit little-endian */
+ printf("1\n");
+ exit(0);
+ }
+ if (b[0] == 0xBF && b[14] == 0x99 && b[15] == 0x9A) {
+ /* IEEE 128-bit big-endian, e.g. solaris sparc */
+ printf("2\n");
+ exit(0);
+ }
+#endif
+#if LDBL_MANT_DIG == 64 && (LONGDBLSIZE == 16 || LONGDBLSIZE == 12)
+ if (b[0] == 0xCD && b[9] == 0xBF && b[10] == 0x00) {
+ /* x86 80-bit little-endian, sizeof 12 (ILP32, Solaris x86)
+ * or 16 (LP64, Linux and OS X), 4 or 6 bytes of padding.
+ * Also known as "extended precision". */
+ printf("3\n");
+ exit(0);
+ }
+ if (b[LONGDBLSIZE - 11] == 0x00 && b[LONGDBLSIZE - 10] == 0xBF &&
+ b[LONGDBLSIZE - 1] == 0xCD) {
+ /* is there ever big-endian 80-bit, really? */
+ printf("4\n");
+ exit(0);
+ }
+#endif
+#if LDBL_MANT_DIG == 106 && LONGDBLSIZE == 16
+ /* software "double double", the 106 is 53+53 */
+ if (b[0] == 0x9A && b[7] == 0x3C && b[8] == 0x9A && b[15] == 0xBF) {
+ /* double double 128-bit little-endian,
+ * 9a 99 99 99 99 99 59 3c 9a 99 99 99 99 99 b9 bf */
+ printf("5\n");
+ exit(0);
+ }
+ if (b[0] == 0xBF && b[7] == 0x9A && b[8] == 0x3C && b[15] == 0x9A) {
+ /* double double 128-bit big-endian, e.g. PPC/Power and MIPS:
+ * bf b9 99 99 99 99 99 9a 3c 59 99 99 99 99 99 9a */
+ printf("6\n");
+ exit(0);
+ }
+#endif
+ printf("-1\n"); /* unknown */
+ exit(0);
+}
+EOP
+set try
+if eval $compile; then
+ longdblkind=`$run ./try`
+else
+ longdblkind=-1
+fi
+;;
+*) longdblkind=0 ;;
+esac
+case "$longdblkind" in
+0) echo "Your long doubles are doubles." >&4 ;;
+1) echo "You have IEEE 754 128-bit little endian long doubles." >&4 ;;
+2) echo "You have IEEE 754 128-bit big endian long doubles." >&4 ;;
+3) echo "You have x86 80-bit little endian long doubles." >& 4 ;;
+*) echo "Cannot figure out your long double." >&4 ;;
+esac
+$rm_try
+
$cat >try.c <<EOCP
#$i_inttypes I_INTTYPES
#ifdef I_INTTYPES
z8000 zarch
EOSH
# Maybe put other stuff here too.
-cat <<EOSH >>Cppsym.know
+./tr '-' '_' <<EOSH >>Cppsym.know
$osname
EOSH
./tr '[a-z]' '[A-Z]' < Cppsym.know > Cppsym.a
d_killpg='$d_killpg'
d_lchown='$d_lchown'
d_ldbl_dig='$d_ldbl_dig'
+d_ldexpl='$d_ldexpl'
d_libm_lib_version='$d_libm_lib_version'
d_libname_unique='$d_libname_unique'
d_link='$d_link'
localtime_r_proto='$localtime_r_proto'
locincpth='$locincpth'
loclibpth='$loclibpth'
+longdblkind='$longdblkind'
longdblsize='$longdblsize'
longlongsize='$longlongsize'
longsize='$longsize'
ansi2knr=''
aphostname='/bin/hostname'
api_revision='5'
-api_subversion='2'
+api_subversion='3'
api_version='21'
-api_versionstring='5.21.2'
+api_versionstring='5.21.3'
ar='ar'
-archlib='/usr/lib/perl5/5.21.2/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.21.2/armv4l-linux'
+archlib='/usr/lib/perl5/5.21.3/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.21.3/armv4l-linux'
archname64=''
archname='armv4l-linux'
archobjs=''
cat='cat'
cc='cc'
cccdlflags='-fpic'
-ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.21.2/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.21.3/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_killpg='define'
d_lchown='define'
d_ldbl_dig='define'
+d_ldexpl='define'
d_libm_lib_version='define'
d_link='define'
d_localtime64='undef'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.21.2/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.21.3/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.21.2'
+installprivlib='./install_me_here/usr/lib/perl5/5.21.3'
installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.21.2/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.21.3/armv4l-linux'
installsitebin='./install_me_here/usr/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.21.2'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.21.3'
installsiteman1dir='./install_me_here/usr/share/man/man1'
installsiteman3dir='./install_me_here/usr/share/man/man3'
installsitescript='./install_me_here/usr/bin'
localtime_r_proto='0'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblkind='0'
longdblsize='8'
longlongsize='8'
longsize='4'
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/usr/lib/perl5/5.21.2'
-privlibexp='/usr/lib/perl5/5.21.2'
+privlib='/usr/lib/perl5/5.21.3'
+privlibexp='/usr/lib/perl5/5.21.3'
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.21.2/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.21.2/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.21.3/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.21.3/armv4l-linux'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.21.2'
+sitelib='/usr/lib/perl5/site_perl/5.21.3'
sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.21.2'
+sitelibexp='/usr/lib/perl5/site_perl/5.21.3'
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='2'
+subversion='3'
sysman='/usr/share/man/man1'
tail=''
tar=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.21.2'
-version_patchlevel_string='version 21 subversion 2'
+version='5.21.3'
+version_patchlevel_string='version 21 subversion 3'
versiononly='undef'
vi=''
xlibpth='/usr/lib/386 /lib/386'
config_argc=0
PERL_REVISION=5
PERL_VERSION=21
-PERL_SUBVERSION=2
+PERL_SUBVERSION=3
PERL_API_REVISION=5
PERL_API_VERSION=21
-PERL_API_SUBVERSION=2
+PERL_API_SUBVERSION=3
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
ansi2knr=''
aphostname='/bin/hostname'
api_revision='5'
-api_subversion='2'
+api_subversion='3'
api_version='21'
-api_versionstring='5.21.2'
+api_versionstring='5.21.3'
ar='ar'
-archlib='/usr/lib/perl5/5.21.2/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.21.2/armv4l-linux'
+archlib='/usr/lib/perl5/5.21.3/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.21.3/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.21.2/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.21.3/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'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.21.2/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.21.3/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.21.2'
+installprivlib='./install_me_here/usr/lib/perl5/5.21.3'
installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.21.2/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.21.3/armv4l-linux'
installsitebin='./install_me_here/usr/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.21.2'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.21.3'
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.21.2'
-privlibexp='/usr/lib/perl5/5.21.2'
+privlib='/usr/lib/perl5/5.21.3'
+privlibexp='/usr/lib/perl5/5.21.3'
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.21.2/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.21.2/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.21.3/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.21.3/armv4l-linux'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.21.2'
+sitelib='/usr/lib/perl5/site_perl/5.21.3'
sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.21.2'
+sitelibexp='/usr/lib/perl5/site_perl/5.21.3'
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='2'
+subversion='3'
sysman='/usr/share/man/man1'
tail=''
tar=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.21.2'
-version_patchlevel_string='version 21 subversion 2'
+version='5.21.3'
+version_patchlevel_string='version 21 subversion 3'
versiononly='undef'
vi=''
xlibpth='/usr/lib/386 /lib/386'
config_argc=0
PERL_REVISION=5
PERL_VERSION=21
-PERL_SUBVERSION=2
+PERL_SUBVERSION=3
PERL_API_REVISION=5
PERL_API_VERSION=21
-PERL_API_SUBVERSION=2
+PERL_API_SUBVERSION=3
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
=item Directories for the perl distribution
-By default, Configure will use the following directories for 5.21.2.
+By default, Configure will use the following directories for 5.21.3.
$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.21.2 is not binary compatible with earlier versions of Perl.
+Perl 5.21.3 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 version of Perl (e.g.
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.21.2
+ sh Configure -Dprefix=/opt/perl5.21.3
-and adding /opt/perl5.21.2/bin to the shell PATH variable. Such users
+and adding /opt/perl5.21.3/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.
=head2 Upgrading from 5.21.1 or earlier
-B<Perl 5.21.2 may not be binary compatible with Perl 5.21.1 or
+B<Perl 5.21.3 may not be binary compatible with Perl 5.21.1 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.21.2. If you find you do need to rebuild an extension with
-5.21.2, you may safely do so without disturbing the older
+used with 5.21.3. If you find you do need to rebuild an extension with
+5.21.3, 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.21.2 is as follows (under $Config{prefix}):
+in Linux with perl-5.21.3 is as follows (under $Config{prefix}):
./bin/perl
- ./lib/perl5/5.21.2/strict.pm
- ./lib/perl5/5.21.2/warnings.pm
- ./lib/perl5/5.21.2/i686-linux/File/Glob.pm
- ./lib/perl5/5.21.2/feature.pm
- ./lib/perl5/5.21.2/XSLoader.pm
- ./lib/perl5/5.21.2/i686-linux/auto/File/Glob/Glob.so
+ ./lib/perl5/5.21.3/strict.pm
+ ./lib/perl5/5.21.3/warnings.pm
+ ./lib/perl5/5.21.3/i686-linux/File/Glob.pm
+ ./lib/perl5/5.21.3/feature.pm
+ ./lib/perl5/5.21.3/XSLoader.pm
+ ./lib/perl5/5.21.3/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 i386 version.
cpan/Compress-Raw-Zlib/zlib-src/zutil.c Compress::Raw::Zlib
cpan/Compress-Raw-Zlib/zlib-src/zutil.h Compress::Raw::Zlib
cpan/Compress-Raw-Zlib/Zlib.xs Compress::Raw::Zlib
-cpan/Config-Perl-V/t/00_pod.t Config::Perl::V
-cpan/Config-Perl-V/t/01_pod.t Config::Perl::V
cpan/Config-Perl-V/t/10_base.t Config::Perl::V
-cpan/Config-Perl-V/t/20_plv510.t Config::Perl::V
-cpan/Config-Perl-V/t/21_plv518.t Config::Perl::V
+cpan/Config-Perl-V/t/20_plv56.t Config::Perl::V
+cpan/Config-Perl-V/t/21_plv58.t Config::Perl::V
+cpan/Config-Perl-V/t/22_plv510.t Config::Perl::V
+cpan/Config-Perl-V/t/23_plv512.t Config::Perl::V
+cpan/Config-Perl-V/t/24_plv514.t Config::Perl::V
+cpan/Config-Perl-V/t/25_plv5162.t Config::Perl::V
+cpan/Config-Perl-V/t/25_plv516.t Config::Perl::V
+cpan/Config-Perl-V/t/26_plv5182.t Config::Perl::V
+cpan/Config-Perl-V/t/26_plv518.t Config::Perl::V
+cpan/Config-Perl-V/t/27_plv5200.t Config::Perl::V
cpan/Config-Perl-V/V.pm Config::Perl::V
cpan/CPAN/lib/App/Cpan.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/API/HOWTO.pod recipe book for programming with CPAN.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm
cpan/CPAN-Meta/lib/CPAN/Meta/History.pm
+cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm
cpan/CPAN-Meta/lib/CPAN/Meta.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
cpan/CPAN-Meta/t/data-valid/META-1_1.yml
cpan/CPAN-Meta/t/data-valid/scalar-meta-spec.yml
cpan/CPAN-Meta/t/load-bad.t
+cpan/CPAN-Meta/t/merge.t
cpan/CPAN-Meta/t/meta-obj.t
cpan/CPAN-Meta/t/no-index.t
cpan/CPAN-Meta/t/prereqs-finalize.t
cpan/encoding-warnings/t/4-lexical.t tests for encoding::warnings
cpan/experimental/lib/experimental.pm
cpan/experimental/t/basic.t
+cpan/ExtUtils-Command/lib/ExtUtils/Command.pm Utilities for Make on non-UNIX platforms
+cpan/ExtUtils-Command/t/cp.t See if ExtUtils::Command works
+cpan/ExtUtils-Command/t/eu_command.t See if ExtUtils::Command works
+cpan/ExtUtils-Command/t/lib/TieOut.pm Testing library to capture prints
cpan/ExtUtils-Constant/lib/ExtUtils/Constant/Base.pm generate XS code to import C header constants
cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm generate XS code to import C header constants
cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm generate XS code for proxy constants
cpan/ExtUtils-Constant/lib/ExtUtils/Constant/Utils.pm generate XS code to import C header constants
cpan/ExtUtils-Constant/lib/ExtUtils/Constant/XS.pm generate XS code to import C header constants
cpan/ExtUtils-Constant/t/Constant.t See if ExtUtils::Constant works
+cpan/ExtUtils-Install/Changes ExtUtils-Install change log
+cpan/ExtUtils-Install/lib/ExtUtils/Installed.pm Information on installed extensions
+cpan/ExtUtils-Install/lib/ExtUtils/Install.pm Handles 'make install' on extensions
+cpan/ExtUtils-Install/lib/ExtUtils/Packlist.pm Manipulates .packlist files
+cpan/ExtUtils-Install/t/can_write_dir.t Does the _can_write_dir function of ExtUtils::Install work properly?
+cpan/ExtUtils-Install/t/Installapi2.t See if new api for ExtUtils::Install::install() works
+cpan/ExtUtils-Install/t/Installed.t See if ExtUtils::Installed works
+cpan/ExtUtils-Install/t/Install.t See if ExtUtils::Install works
+cpan/ExtUtils-Install/t/InstallWithMM.t See if ExtUtils::Install works (related to EUMM/t/basic.t)
+cpan/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm MakeMaker test utilities
+cpan/ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm MakeMaker test utilities
+cpan/ExtUtils-Install/t/lib/TieOut.pm Testing library to capture prints
+cpan/ExtUtils-Install/t/Packlist.t See if Packlist works
cpan/ExtUtils-MakeMaker/bin/instmodsh Give information about installed extensions
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm Calling MM functions from the cmd line
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm Does the real work of the above
cpan/ExtUtils-MakeMaker/t/WriteEmptyMakefile.t See if WriteEmptyMakefile works
cpan/ExtUtils-MakeMaker/t/writemakefile_args.t See if WriteMakefile works
cpan/ExtUtils-MakeMaker/t/xs.t Part of MakeMaker's test suite
+cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files
+cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP The default MANIFEST.SKIP
+cpan/ExtUtils-Manifest/t/Manifest.t See if ExtUtils::Manifest works
cpan/File-Fetch/lib/File/Fetch.pm File::Fetch
cpan/File-Fetch/t/01_File-Fetch.t File::Fetch tests
cpan/File-Fetch/t/null_subclass.t
dist/ExtUtils-CBuilder/t/02-link.t tests for ExtUtils::CBuilder
dist/ExtUtils-CBuilder/t/03-cplusplus.t tests for ExtUtils::CBuilder
dist/ExtUtils-CBuilder/t/04-base.t tests for ExtUtils::CBuilder
-dist/ExtUtils-Command/lib/ExtUtils/Command.pm Utilities for Make on non-UNIX platforms
-dist/ExtUtils-Command/t/cp.t See if ExtUtils::Command works
-dist/ExtUtils-Command/t/eu_command.t See if ExtUtils::Command works
-dist/ExtUtils-Command/t/lib/TieOut.pm Testing library to capture prints
-dist/ExtUtils-Install/Changes ExtUtils-Install change log
-dist/ExtUtils-Install/lib/ExtUtils/Installed.pm Information on installed extensions
-dist/ExtUtils-Install/lib/ExtUtils/Install.pm Handles 'make install' on extensions
-dist/ExtUtils-Install/lib/ExtUtils/Packlist.pm Manipulates .packlist files
-dist/ExtUtils-Install/t/can_write_dir.t Does the _can_write_dir function of ExtUtils::Install work properly?
-dist/ExtUtils-Install/t/Installapi2.t See if new api for ExtUtils::Install::install() works
-dist/ExtUtils-Install/t/Installed.t See if ExtUtils::Installed works
-dist/ExtUtils-Install/t/Install.t See if ExtUtils::Install works
-dist/ExtUtils-Install/t/InstallWithMM.t See if ExtUtils::Install works (related to EUMM/t/basic.t)
-dist/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm MakeMaker test utilities
-dist/ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm MakeMaker test utilities
-dist/ExtUtils-Install/t/lib/TieOut.pm Testing library to capture prints
-dist/ExtUtils-Install/t/Packlist.t See if Packlist works
-dist/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm Utilities to write MANIFEST files
-dist/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP The default MANIFEST.SKIP
-dist/ExtUtils-Manifest/t/Manifest.t See if ExtUtils::Manifest works
dist/ExtUtils-ParseXS/Changes ExtUtils::ParseXS change log
dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm ExtUtils::ParseXS guts
dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm ExtUtils::ParseXS guts
dist/Safe/t/safeload.t Tests that some modules can be loaded by Safe
dist/Safe/t/safenamedcap.t Tests that Tie::Hash::NamedCapture can be loaded
dist/Safe/t/safeops.t Tests that all ops can be trapped by Safe
-dist/Safe/t/saferegexp.t
+dist/Safe/t/saferegexp.t Tests Safe with regular expressions
+dist/Safe/t/safesecurity.t Tests misc. security fixes in Safe
dist/Safe/t/safesort.t Tests Safe with sort
dist/Safe/t/safeuniversal.t Tests Safe with functions from universal.c
dist/Safe/t/safeutf8.t Tests Safe with utf8.pm
ext/POSIX/Makefile.PL POSIX extension makefile writer
ext/POSIX/POSIX.xs POSIX extension external subroutines
ext/POSIX/t/export.t Test @EXPORT and @EXPORT_OK
+ext/POSIX/t/iscrash See if POSIX isxxx() crashes with threads on Win32
ext/POSIX/t/is.t See if POSIX isxxx() work
ext/POSIX/t/math.t Basic math tests for POSIX
ext/POSIX/t/posix.t See if POSIX works
pod/perl5200delta.pod Perl changes in version 5.20.0
pod/perl5210delta.pod Perl changes in version 5.21.0
pod/perl5211delta.pod Perl changes in version 5.21.1
+pod/perl5212delta.pod Perl changes in version 5.21.2
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/op/hash.t See if the complexity attackers are repelled
t/op/hashwarn.t See if warnings for bad hash assignments work
t/op/heredoc.t See if heredoc edge and corner cases work
+t/op/hexfp.t See if hexadecimal float literals work
t/op/inccode.t See if coderefs work in @INC
t/op/inccode-tie.t See if tie to @INC works
t/op/incfilter.t See if the source filters in coderef-in-@INC work
t/op/repeat.t See if x operator works
t/op/require_37033.t See if require always closes rsfp
t/op/require_errors.t See if errors from require are reported correctly
+t/op/require_override.t See if require handles no argument properly
t/op/reset.t See if reset operator works
t/op/reverse.t See if reverse operator works
t/op/rt119311.t Test bug #119311 (die/DESTROY/recursion)
"perl5-porters@perl.org"
],
"dynamic_config" : 1,
- "generated_by" : "CPAN::Meta version 2.141520",
+ "generated_by" : "CPAN::Meta version 2.142060",
"license" : [
"perl_5"
],
"dist/Env",
"dist/Exporter",
"dist/ExtUtils-CBuilder",
- "dist/ExtUtils-Command",
- "dist/ExtUtils-Install",
- "dist/ExtUtils-Manifest",
"dist/ExtUtils-ParseXS",
"dist/Filter-Simple",
"dist/I18N-Collate",
"url" : "http://perl5.git.perl.org/"
}
},
- "version" : "5.021002"
+ "version" : "5.021003"
}
- perl5-porters@perl.org
build_requires: {}
dynamic_config: 1
-generated_by: 'CPAN::Meta version 2.141520, CPAN::Meta::Converter version 2.141520'
+generated_by: 'CPAN::Meta version 2.142060, CPAN::Meta::Converter version 2.142060'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- dist/Env
- dist/Exporter
- dist/ExtUtils-CBuilder
- - dist/ExtUtils-Command
- - dist/ExtUtils-Install
- - dist/ExtUtils-Manifest
- dist/ExtUtils-ParseXS
- dist/Filter-Simple
- dist/I18N-Collate
homepage: http://www.perl.org/
license: http://dev.perl.org/licenses/
repository: http://perl5.git.perl.org/
-version: '5.021002'
+version: '5.021003'
ndt_obj = $(obj0) $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
obj = $(ndt_obj) $(DTRACE_O)
-perltoc_pod_prereqs = extra.pods pod/perl5212delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod
+perltoc_pod_prereqs = extra.pods pod/perl5213delta.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
# it on the target system if we're cross-compiling.
# If it is defined, then we just run it locally.
case "$hostgenerate" in
-'')
+''|'undef')
$spitshell >>$Makefile <<!GROK!THIS!
bitcount.h: generate_uudmap\$(HOST_EXE_EXT)
$run ./generate_uudmap\$(HOST_EXE_EXT) \$(generated_headers)
pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST
$(MINIPERL) pod/perlmodlib.PL -q
-pod/perl5212delta.pod: pod/perldelta.pod
- $(RMS) pod/perl5212delta.pod
- $(LNS) perldelta.pod pod/perl5212delta.pod
+pod/perl5213delta.pod: pod/perldelta.pod
+ $(RMS) pod/perl5213delta.pod
+ $(LNS) perldelta.pod pod/perl5213delta.pod
extra.pods: $(MINIPERL_EXE)
-@test ! -f extra.pods || rm -f `cat extra.pods`
$to cpan/*/t
$to dist/*/t
$to ext/*/t
+ $to cpan/Archive-Tar/*
+ $to cpan/Module-Metadata/*
$to cpan/Term-Cap/test.pl
$to cpan/Pod-Usage/*
$to cpan/Pod-Parser/*
$to perl.h
$to cflags
$to *.h
+# --- For t/porting/customized.t
+ $to vutil.c
+ $to vxs.inc
# --- For t/TEST
$to config.sh
# --- For lib/diagnostics.t with -Duseshrplib
# Here comes the CW tools - TO BE FILLED TO BUILD WITH CW -
-MODULE_DESC = "Perl 5.21.2 for NetWare"
+MODULE_DESC = "Perl 5.21.3 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.21.2
+INST_VER = \5.21.3
#
# Comment this out if you DON'T want your perl installation to have
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='define'
+d_ldexpl='undef'
d_libm_lib_version='undef'
d_link='define'
d_localtime64='undef'
localtime_r_proto='0'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblkind='3'
longdblsize='10'
longlongsize='8'
longsize='4'
* 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.21.2\\lib\\NetWare-x86-multi-thread" /**/
+#define ARCHLIB "c:\\perl\\5.21.3\\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.21.2\\bin\\NetWare-x86-multi-thread" /**/
-#define BIN_EXP "c:\\perl\\5.21.2\\bin\\NetWare-x86-multi-thread" /**/
+#define BIN "c:\\perl\\5.21.3\\bin\\NetWare-x86-multi-thread" /**/
+#define BIN_EXP "c:\\perl\\5.21.3\\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.21.2\\lib\\NetWare-x86-multi-thread" /**/
+#define SITEARCH "c:\\perl\\site\\5.21.3\\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.21.2\\lib" /**/
+#define SITELIB "c:\\perl\\site\\5.21.3\\lib" /**/
/*#define SITELIB_EXP "" /**/
#define SITELIB_STEM "" /**/
header files provide LDBL_DIG, which is the number of significant
digits in a long double precision number.
+d_ldexpl (d_ldexpl.U):
+ This variable conditionally defines the HAS_LDEXPL symbol, which
+ indicates to the C program that the ldexpl() routine is available.
+
d_libm_lib_version (d_libm_lib_version.U):
This variable conditionally defines the LIBM_LIB_VERSION symbol,
which indicates to the C program that math.h defines _LIB_VERSION
libraries. It is prepended to libpth, and is intended to be easily
set from the command line.
+longdblkind (longdblkind.U):
+ This variable, if defined, encodes the type of a long double:
+ 0 = double, 1 = IEEE 754 128-bit big little endian,
+ 2 = IEEE 754 128-bit big big endian, 3 = x86 80-bit little endian,
+ 4 = x86 80-bit big endian, 5 = double-double 128-bit little endian,
+ 6 = double-double 128-bit big endian, -1 = unknown format.
+
longdblsize (d_longdbl.U):
This variable contains the value of the LONG_DOUBLESIZE symbol, which
indicates to the C program how many bytes there are in a long double,
},
'B::Debug' => {
- 'DISTRIBUTION' => 'RURBAN/B-Debug-1.19.tar.gz',
+ 'DISTRIBUTION' => 'RURBAN/B-Debug-1.21.tar.gz',
'FILES' => q[cpan/B-Debug],
'EXCLUDED' => ['t/pod.t'],
},
},
'Config::Perl::V' => {
- 'DISTRIBUTION' => 'HMBRAND/Config-Perl-V-0.20.tgz',
+ 'DISTRIBUTION' => 'HMBRAND/Config-Perl-V-0.22.tgz',
'FILES' => q[cpan/Config-Perl-V],
- 'EXCLUDED' => ['examples/show-v.pl'],
+ 'EXCLUDED' => [qw(
+ examples/show-v.pl
+ t/00_pod.t
+ t/01_pod.t
+ )],
},
'constant' => {
# Note: When updating CPAN-Meta the META.* files will need to be regenerated
# perl -Icpan/CPAN-Meta/lib Porting/makemeta
'CPAN::Meta' => {
- 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.141520.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.142060.tar.gz',
'FILES' => q[cpan/CPAN-Meta],
'EXCLUDED' => [
qw[t/00-report-prereqs.t],
+ qw[t/00-report-prereqs.dd],
qr{t/README-data.txt},
qr{^xt},
qr{^history},
},
'CPAN::Meta::Requirements' => {
- 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-Requirements-2.125.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-Requirements-2.126.tar.gz',
'FILES' => q[cpan/CPAN-Meta-Requirements],
'EXCLUDED' => [
+ qw(CONTRIBUTING.mkdn),
qw(t/00-compile.t),
qw(t/00-report-prereqs.t),
+ qw(t/00-report-prereqs.dd),
qr{^xt},
],
},
'ExtUtils::Command' => {
'DISTRIBUTION' => 'FLORA/ExtUtils-Command-1.18.tar.gz',
- 'FILES' => q[dist/ExtUtils-Command],
+ 'FILES' => q[cpan/ExtUtils-Command],
'EXCLUDED' => [qr{^t/release-}],
},
'ExtUtils::Install' => {
'DISTRIBUTION' => 'BINGOS/ExtUtils-Install-1.68.tar.gz',
- 'FILES' => q[dist/ExtUtils-Install],
+ 'FILES' => q[cpan/ExtUtils-Install],
'EXCLUDED' => [
qw( t/lib/Test/Builder.pm
t/lib/Test/Builder/Module.pm
},
'ExtUtils::Manifest' => {
- 'DISTRIBUTION' => 'BINGOS/ExtUtils-Manifest-1.64.tar.gz',
- 'FILES' => q[dist/ExtUtils-Manifest],
+ 'DISTRIBUTION' => 'BINGOS/ExtUtils-Manifest-1.65.tar.gz',
+ 'FILES' => q[cpan/ExtUtils-Manifest],
'EXCLUDED' => [qr(^xt/)],
},
},
'HTTP::Tiny' => {
- 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.043.tar.gz',
+ 'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.047.tar.gz',
'FILES' => q[cpan/HTTP-Tiny],
'EXCLUDED' => [
't/00-report-prereqs.t',
+ 't/00-report-prereqs.dd',
't/200_live.t',
't/200_live_local_ip.t',
't/210_live_ssl.t',
},
'Module::CoreList' => {
- 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.021001.tar.gz',
+ 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.021002.tar.gz',
'FILES' => q[dist/Module-CoreList],
},
},
'perlfaq' => {
- 'DISTRIBUTION' => 'LLAP/perlfaq-5.0150044.tar.gz',
+ 'DISTRIBUTION' => 'LLAP/perlfaq-5.0150045.tar.gz',
'FILES' => q[cpan/perlfaq],
'EXCLUDED' => [
qw( t/release-pod-syntax.t
ansi2knr=''
aphostname='/bin/hostname'
api_revision='5'
-api_subversion='2'
+api_subversion='3'
api_version='21'
-api_versionstring='5.21.2'
+api_versionstring='5.21.3'
ar='ar'
-archlib='/pro/lib/perl5/5.21.2/i686-linux-64int'
-archlibexp='/pro/lib/perl5/5.21.2/i686-linux-64int'
+archlib='/pro/lib/perl5/5.21.3/i686-linux-64int'
+archlibexp='/pro/lib/perl5/5.21.3/i686-linux-64int'
archname64='64int'
archname='i686-linux-64int'
archobjs=''
d_killpg='define'
d_lchown='define'
d_ldbl_dig='define'
+d_ldexpl='define'
d_libm_lib_version='define'
d_libname_unique='undef'
d_link='define'
incpth='/usr/lib/gcc/i586-suse-linux/4.8/include /usr/local/include /usr/lib/gcc/i586-suse-linux/4.8/include-fixed /usr/lib/gcc/i586-suse-linux/4.8/../../../../i586-suse-linux/include /usr/include'
inews=''
initialinstalllocation='/pro/bin'
-installarchlib='/pro/lib/perl5/5.21.2/i686-linux-64int'
+installarchlib='/pro/lib/perl5/5.21.3/i686-linux-64int'
installbin='/pro/bin'
installhtml1dir=''
installhtml3dir=''
installman3dir='/pro/local/man/man3'
installprefix='/pro'
installprefixexp='/pro'
-installprivlib='/pro/lib/perl5/5.21.2'
+installprivlib='/pro/lib/perl5/5.21.3'
installscript='/pro/bin'
-installsitearch='/pro/lib/perl5/site_perl/5.21.2/i686-linux-64int'
+installsitearch='/pro/lib/perl5/site_perl/5.21.3/i686-linux-64int'
installsitebin='/pro/bin'
installsitehtml1dir=''
installsitehtml3dir=''
-installsitelib='/pro/lib/perl5/site_perl/5.21.2'
+installsitelib='/pro/lib/perl5/site_perl/5.21.3'
installsiteman1dir='/pro/local/man/man1'
installsiteman3dir='/pro/local/man/man3'
installsitescript='/pro/bin'
localtime_r_proto='0'
locincpth='/pro/local/include'
loclibpth='/pro/local/lib'
+longdblkind='3'
longdblsize='12'
longlongsize='8'
longsize='4'
perl_static_inline='static __inline__'
perladmin='hmbrand@cpan.org'
perllibs='-lnsl -ldl -lm -lcrypt -lutil -lc'
-perlpath='/pro/bin/perl5.21.2'
+perlpath='/pro/bin/perl5.21.3'
pg='pg'
phostname='hostname'
pidtype='pid_t'
pr=''
prefix='/pro'
prefixexp='/pro'
-privlib='/pro/lib/perl5/5.21.2'
-privlibexp='/pro/lib/perl5/5.21.2'
+privlib='/pro/lib/perl5/5.21.3'
+privlibexp='/pro/lib/perl5/5.21.3'
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, 64, 6, 17, 29, 31, 0'
sig_size='69'
signal_t='void'
-sitearch='/pro/lib/perl5/site_perl/5.21.2/i686-linux-64int'
-sitearchexp='/pro/lib/perl5/site_perl/5.21.2/i686-linux-64int'
+sitearch='/pro/lib/perl5/site_perl/5.21.3/i686-linux-64int'
+sitearchexp='/pro/lib/perl5/site_perl/5.21.3/i686-linux-64int'
sitebin='/pro/bin'
sitebinexp='/pro/bin'
sitehtml1dir=''
sitehtml1direxp=''
sitehtml3dir=''
sitehtml3direxp=''
-sitelib='/pro/lib/perl5/site_perl/5.21.2'
+sitelib='/pro/lib/perl5/site_perl/5.21.3'
sitelib_stem='/pro/lib/perl5/site_perl'
-sitelibexp='/pro/lib/perl5/site_perl/5.21.2'
+sitelibexp='/pro/lib/perl5/site_perl/5.21.3'
siteman1dir='/pro/local/man/man1'
siteman1direxp='/pro/local/man/man1'
siteman3dir='/pro/local/man/man3'
ssizetype='ssize_t'
st_ino_sign='1'
st_ino_size='8'
-startperl='#!/pro/bin/perl5.21.2'
+startperl='#!/pro/bin/perl5.21.3'
startsh='#!/bin/sh'
static_ext=' '
stdchar='char'
strerror_r_proto='0'
strings='/usr/include/string.h'
submit=''
-subversion='2'
+subversion='3'
sysman='/usr/share/man/man1'
sysroot=''
tail=''
vendorprefixexp=''
vendorscript=''
vendorscriptexp=''
-version='5.21.2'
-version_patchlevel_string='version 21 subversion 2'
+version='5.21.3'
+version_patchlevel_string='version 21 subversion 3'
versiononly='define'
vi=''
xlibpth='/usr/lib/386 /lib/386'
zip='zip'
PERL_REVISION=5
PERL_VERSION=21
-PERL_SUBVERSION=2
+PERL_SUBVERSION=3
PERL_API_REVISION=5
PERL_API_VERSION=21
-PERL_API_SUBVERSION=2
+PERL_API_SUBVERSION=3
PERL_PATCHLEVEL=''
PERL_CONFIG_SH=true
: Variables propagated from previous config.sh file.
* 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 "/pro/lib/perl5/5.21.2/i686-linux-64int-ld" /**/
-#define ARCHLIB_EXP "/pro/lib/perl5/5.21.2/i686-linux-64int-ld" /**/
+#define ARCHLIB "/pro/lib/perl5/5.21.3/i686-linux-64int-ld" /**/
+#define ARCHLIB_EXP "/pro/lib/perl5/5.21.3/i686-linux-64int-ld" /**/
/* ARCHNAME:
* This symbol holds a string representing the architecture name.
* 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 "/pro/lib/perl5/5.21.2" /**/
-#define PRIVLIB_EXP "/pro/lib/perl5/5.21.2" /**/
+#define PRIVLIB "/pro/lib/perl5/5.21.3" /**/
+#define PRIVLIB_EXP "/pro/lib/perl5/5.21.3" /**/
/* PTRSIZE:
* This symbol contains the size of a pointer, so that the C preprocessor
* 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 "/pro/lib/perl5/site_perl/5.21.2/i686-linux-64int-ld" /**/
-#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.21.2/i686-linux-64int-ld" /**/
+#define SITEARCH "/pro/lib/perl5/site_perl/5.21.3/i686-linux-64int-ld" /**/
+#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.21.3/i686-linux-64int-ld" /**/
/* 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 "/pro/lib/perl5/site_perl/5.21.2" /**/
-#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.21.2" /**/
+#define SITELIB "/pro/lib/perl5/site_perl/5.21.3" /**/
+#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.21.3" /**/
#define SITELIB_STEM "/pro/lib/perl5/site_perl" /**/
/* SSize_t:
* script to make sure (one hopes) that it runs with perl and not
* some shell.
*/
-#define STARTPERL "#!/pro/bin/perl5.21.2" /**/
+#define STARTPERL "#!/pro/bin/perl5.21.3" /**/
/* HAS_STDIO_STREAM_ARRAY:
* This symbol, if defined, tells that there is an array
../cpan/Encode/t/jis7-fallback.t
../cpan/Encode/t/jperl.t
../cpan/Encode/t/mime-header.t
+../cpan/ExtUtils-Install/t/Installapi2.t
+../cpan/ExtUtils-Install/t/Packlist.t
+../cpan/ExtUtils-Install/t/can_write_dir.t
../cpan/ExtUtils-MakeMaker/t/arch_check.t
../cpan/ExtUtils-MakeMaker/t/min_perl_version.t
../cpan/ExtUtils-MakeMaker/t/xs.t
+../cpan/ExtUtils-Manifest/t/Manifest.t
../cpan/File-Path/t/taint.t
../cpan/File-Temp/t/object.t
../cpan/HTTP-Tiny/t/001_api.t
../dist/Data-Dumper/t/perl-74170.t
../dist/Data-Dumper/t/quotekeys.t
../dist/Exporter/t/Exporter.t
-../dist/ExtUtils-Install/t/Installapi2.t
-../dist/ExtUtils-Install/t/Packlist.t
-../dist/ExtUtils-Install/t/can_write_dir.t
-../dist/ExtUtils-Manifest/t/Manifest.t
../dist/Filter-Simple/t/data.t
../dist/I18N-LangTags/t/50_super.t
../dist/IO/t/io_file_export.t
=head1 EPIGRAPHS
+=head2 v5.21.2 - Neil Armstrong, Buzz Aldrin, Charlie Duke, Final minutes of communication of the first manned moon landing, July 20, 1969.
+
+L<Announced on 2014-07-20 by Abigail|http://www.nntp.perl.org/group/perl.perl5.porters/2014/07/msg217937.html>
+
+ Armstrong: Okay. Here's a...Looks like a good area here.
+ Aldrin: I got the shadow out there.
+ Aldrin: 250, down at 2 1/2, 19 forward.
+ Aldrin: Altitude, velocity lights.
+ Aldrin: 3 1/2 down, 220 feet, 13 forward.
+ Aldrin: 11 forward. Coming down nicely.
+ Armstrong: Gonna be right over that crater.
+ Aldrin: 200 feet, 4 1/2 down.
+ Aldrin: 5 1/2 down.
+ Armstrong: I got a good spot [garbled].
+ Aldrin: 160 feet, 6 1/2 down.
+ Aldrin: 5 1/2 down, 9 forward. You're looking good.
+ Aldrin: 120 feet.
+ Aldrin: 100 feet, 3 1/2 down, 9 forward. Five percent. Quantity light.
+ Aldrin: Okay. 75 feet. And it's looking good. Down a half, 6 forward.
+ Duke: 60 seconds.
+ Aldrin: Light's on.
+ Aldrin: 60 feet, down 2 1/2. 2 forward. 2 forward. That's good.
+ Aldrin: 40 feet, down 2 1/2. Picking up some dust.
+ Aldrin: 30 feet, 2 1/2 down. [Garbled] shadow.
+ Aldrin: 4 forward. 4 forward. Drifting to the right a little. 20 feet,
+ down a half.
+ Duke: 30 seconds.
+ Aldrin: Drifting forward just a little bit; that's good.
+ Aldrin: Contact Light.
+ Armstrong: Shutdown.
+ Aldrin: Okay. Engine Stop.
+ Aldrin: ACA out of Detent.
+ Armstrong: Out of Detent. Auto.
+ Aldrin: Mode Control, both Auto. Descent Engine Command Override, Off.
+ Engine Arm, Off. 413 is in.
+ Duke: We copy you down, Eagle.
+ Armstrong: Engine arm is off.
+ Armstrong: Houston, Tranquility Base here. The Eagle has landed.
+ Duke: Roger, Twan...[correcting himself] Tranquility. We copy you on
+ the ground. You got a bunch of guys about to turn blue.
+ We're breathing again. Thanks a lot.
+ Aldrin: Thank you.
+
=head2 v5.21.1 - Robert Jordan, The Crossroads of Twilights, Book 10 of the Wheel of Time
L<Announced on 2014-06-20 by Matthew Horsfall|http://www.nntp.perl.org/group/perl.perl5.porters/2014/06/msg217030.html>
XXX Generate this with:
- perl Porting/acknowledgements.pl v5.21.2..HEAD
+ perl Porting/acknowledgements.pl v5.21.3..HEAD
=head1 Reporting Bugs
Try installing a popular CPAN module that's reasonably complex and that
has dependencies; for example:
- CPAN> install Inline
+ CPAN> install Inline::C
CPAN> quit
Check that your perl can run this:
);
+sub usage
+{
+ my $err = shift and select STDERR;
+ print "Usage: $0 module [args] [cpan package]\n";
+ exit $err;
+}
+
GetOptions ('tarball=s' => \my $tarball,
'version=s' => \my $version,
- force => \my $force,)
- or die "Failed to parse arguments";
+ force => \my $force,
+ help => sub { usage 0; },
+ ) or die "Failed to parse arguments";
-die "Usage: $0 module [args] [cpan package]" unless @ARGV == 1 || @ARGV == 2;
+usage 1 unless @ARGV == 1 || @ARGV == 2;
sub find_type_f {
my @res;
On these systems, it might be the default compilation mode, and there
is currently no guarantee that passing no use64bitall option to the
Configure process will build a 32bit perl. Implementing -Duse32bit*
-options would be nice for perl 5.21.2.
+options would be nice for perl 5.21.3.
=head2 Profile Perl - am I hot or not?
=head1 Big projects
Tasks that will get your name mentioned in the description of the "Highlights
-of 5.21.2"
+of 5.21.3"
=head2 make ithreads more robust
underlying windows pid. Most posix compliant Proc functions expect
the cygwin pid, but several Win32::Process functions expect the
winpid. E.g. C<$$> is the cygwin pid of F</usr/bin/perl>, which is not
-the winpid. Use C<Cygwin::winpid_to_pid()> and C<Cygwin::winpid_to_pid()>
+the winpid. Use C<Cygwin::pid_to_winpid()> and C<Cygwin::winpid_to_pid()>
to translate between them.
=item * Cygwin vs. Windows errors
Make perl executable and create a symlink for libperl:
chmod a+x /boot/common/bin/perl
- cd /boot/common/lib; ln -s perl5/5.21.2/BePC-haiku/CORE/libperl.so .
+ cd /boot/common/lib; ln -s perl5/5.21.3/BePC-haiku/CORE/libperl.so .
-Replace C<5.21.2> with your respective version of Perl.
+Replace C<5.21.3> with your respective version of Perl.
=head1 KNOWN PROBLEMS
This document briefly describes Perl under Mac OS X.
- curl -O http://www.cpan.org/src/perl-5.21.2.tar.gz
- tar -xzf perl-5.21.2.tar.gz
- cd perl-5.21.2
+ curl -O http://www.cpan.org/src/perl-5.21.3.tar.gz
+ tar -xzf perl-5.21.3.tar.gz
+ cd perl-5.21.3
./Configure -des -Dprefix=/usr/local/
make
make test
=head1 DESCRIPTION
-The latest Perl release (5.21.2 as of this writing) builds without changes
+The latest Perl release (5.21.3 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.21.2/
+ unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.21.3/
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
choice. Once you have done so, use a command like the following to
unpack the archive:
- vmstar -xvf perl-5^.21^.2.tar
+ vmstar -xvf perl-5^.21^.3.tar
Then set default to the top-level source directory like so:
- set default [.perl-5^.21^.2]
+ set default [.perl-5^.21^.3]
and proceed with configuration as described in the next section.
Set the highest index in the array to the given number, equivalent to
Perl's C<$#array = $fill;>.
-The number of elements in the an array will be C<fill + 1> after
+The number of elements in the array will be C<fill + 1> after
av_fill() returns. If the array was previously shorter, then the
additional elements appended are set to NULL. If the array
was longer, then the excess elements are freed. C<av_fill(av, -1)> is
}
# elif defined(HAS_PROCSELFEXE)
char buf[MAXPATHLEN];
- int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
+ SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
+ /* NOTE: if the length returned by readlink() is sizeof(buf) - 1,
+ * it is impossible to know whether the result was truncated. */
+
+ if (len != -1) {
+ buf[len] = '\0';
+ }
/* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
includes a spurious NUL which will cause $^X to fail in system
;;
esac
+# Older clang releases are not wise enough for -Wunused-value.
+case "$gccversion" in
+*"Apple LLVM "[34]*|*"Apple LLVM version "[34]*)
+ for f in -Wno-unused-value
+ do
+ echo "cflags.SH: Adding $f because clang version '$gccversion'"
+ warn="$warn $f"
+ done
+ ;;
+esac
+
case "$cc" in
*g++*)
# Extra paranoia in case people have bad canned ccflags:
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long doubles.
*/
+/* LONG_DOUBLEKIND:
+ * LONG_DOUBLEKIND will be one of
+ * LONG_DOUBLE_IS_DOUBLE
+ * LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+ * LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+ * LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+ * LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+ * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+ * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+ * LONG_DOUBLE_IS_UNKNOWN_FORMAT
+ * It is only defined if the system supports long doubles.
+ */
#$d_longdbl HAS_LONG_DOUBLE /**/
#ifdef HAS_LONG_DOUBLE
#define LONG_DOUBLESIZE $longdblsize /**/
+#define LONG_DOUBLEKIND $longdblkind /**/
+#define LONG_DOUBLE_IS_DOUBLE 0
+#define LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN 1
+#define LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN 2
+#define LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN 3
+#define LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN 4
+#define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN 5
+#define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN 6
+#define LONG_DOUBLE_IS_UNKNOWN_FORMAT -1
#endif
/* HAS_LONG_LONG:
*/
#$d_frexpl HAS_FREXPL /**/
+/* HAS_LDEXPL:
+ * This symbol, if defined, indicates that the ldexpl routine is
+ * available to shift a long double floating-point number
+ * by an integral power of 2.
+ */
+#$d_ldexpl HAS_LDEXPL /**/
+
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
$ quadkind = "3"
$!
$ d_frexpl = "define"
+$ d_ldexpl = "define"
$ d_modfl = "define"
$ d_modflproto = "define"
$ ELSE
$ quadkind = "undef"
$!
$ d_frexpl = "undef"
+$ d_ldexpl = "undef"
$ d_modfl = "undef"
$ d_modflproto = "undef"
$ ENDIF
$ IF link_status .NE. good_link
$ THEN
$ longdblsize="0"
+$ longdblkind="0"
$ d_longdbl="undef"
$ echo "You do not have long double."
$ ELSE
$ echo4 "Checking to see how big your long doubles are..."
$ GOSUB just_mcr_it
$ longdblsize = tmp
+$ longdblkind = "1"
$ d_longdbl = "define"
$ echo "Your long doubles are ''longdblsize' bytes long."
$ ENDIF
$ WC "d_fd_macros='define'"
$ WC "d_fds_bits='define'"
$ WC "d_fgetpos='define'"
-$ WC "d_finite='undef'"
-$ WC "d_finitel='undef'"
+$ IF F$ELEMENT(0, "-", archname) .NES. "VMS_VAX" .AND. use_ieee_math
+$ THEN
+$ WC "d_finite='define'"
+$ WC "d_finitel='define'"
+$ ELSE
+$ WC "d_finite='undef'"
+$ WC "d_finitel='undef'"
+$ ENDIF
$ WC "d_flexfnam='define'"
$ WC "d_flock='undef'"
$ WC "d_flockproto='undef'"
$ WC "d_ipv6_mreq_source='undef'"
$ WC "d_isascii='define'"
$ WC "d_isblank='undef'"
-$ WC "d_isfinite='undef'"
+$ IF F$ELEMENT(0, "-", archname) .NES. "VMS_VAX" .AND. use_ieee_math
+$ THEN
+$ WC "d_isfinite='define'"
+$ ELSE
+$ WC "d_isfinite='undef'"
+$ ENDIF
$ WC "d_isinf='undef'"
$ WC "d_isnan='" + d_isnan + "'"
$ WC "d_isnanl='" + d_isnanl + "'"
$ WC "d_killpg='undef'"
$ WC "d_lchown='" + d_lchown + "'"
$ WC "d_ldbl_dig='define'"
+$ WC "d_ldexpl='" + d_ldexpl + "'"
$ WC "d_libm_lib_version='undef'"
$ WC "d_link='" + d_link + "'"
$ WC "d_llseek='undef'"
$ WC "libswanted='" + "'"
$ WC "libswanted_uselargefiles='" + "'"
$ WC "longdblsize='" + longdblsize + "'"
+$ WC "longdblkind='" + longdblkind + "'"
$ WC "longlongsize='" + longlongsize + "'"
$ WC "longsize='" + longsize + "'"
$ IF uselargefiles .OR. uselargefiles .EQS. "define"
package B::Debug;
-our $VERSION = '1.19';
+our $VERSION = '1.21';
use strict;
require 5.006;
sub B::SPECIAL::debug {
my $sv = shift;
my $i = ref $sv ? $$sv : 0;
- print exists $specialsv_name[$i] ? $specialsv_name[$i] : "", "\n";
+ print defined $specialsv_name[$i] ? $specialsv_name[$i] : "", "\n";
}
sub B::PADLIST::debug {
use strict;
use warnings;
package CPAN::Meta::Requirements;
-our $VERSION = '2.125'; # VERSION
+our $VERSION = '2.126'; # VERSION
# ABSTRACT: a set of version requirements for a CPAN dist
+#pod =head1 SYNOPSIS
+#pod
+#pod use CPAN::Meta::Requirements;
+#pod
+#pod my $build_requires = CPAN::Meta::Requirements->new;
+#pod
+#pod $build_requires->add_minimum('Library::Foo' => 1.208);
+#pod
+#pod $build_requires->add_minimum('Library::Foo' => 2.602);
+#pod
+#pod $build_requires->add_minimum('Module::Bar' => 'v1.2.3');
+#pod
+#pod $METAyml->{build_requires} = $build_requires->as_string_hash;
+#pod
+#pod =head1 DESCRIPTION
+#pod
+#pod A CPAN::Meta::Requirements object models a set of version constraints like
+#pod those specified in the F<META.yml> or F<META.json> files in CPAN distributions,
+#pod and as defined by L<CPAN::Meta::Spec>;
+#pod It can be built up by adding more and more constraints, and it will reduce them
+#pod to the simplest representation.
+#pod
+#pod Logically impossible constraints will be identified immediately by thrown
+#pod exceptions.
+#pod
+#pod =cut
use Carp ();
use Scalar::Util ();
use version 0.77 (); # the ->parse method
+#pod =method new
+#pod
+#pod my $req = CPAN::Meta::Requirements->new;
+#pod
+#pod This returns a new CPAN::Meta::Requirements object. It takes an optional
+#pod hash reference argument. Currently, only one key is supported:
+#pod
+#pod =for :list
+#pod * C<bad_version_hook> -- if provided, when a version cannot be parsed into
+#pod a version object, this code reference will be called with the invalid version
+#pod string as an argument. It must return a valid version object.
+#pod
+#pod All other keys are ignored.
+#pod
+#pod =cut
my @valid_options = qw( bad_version_hook );
my $vobj;
eval {
+ local $SIG{__WARN__} = sub { die "Invalid version: $_[0]" };
$vobj = (! defined $version) ? version->parse(0)
: (! Scalar::Util::blessed($version)) ? version->parse($version)
: $version;
return $vobj;
}
+#pod =method add_minimum
+#pod
+#pod $req->add_minimum( $module => $version );
+#pod
+#pod This adds a new minimum version requirement. If the new requirement is
+#pod redundant to the existing specification, this has no effect.
+#pod
+#pod Minimum requirements are inclusive. C<$version> is required, along with any
+#pod greater version number.
+#pod
+#pod This method returns the requirements object.
+#pod
+#pod =method add_maximum
+#pod
+#pod $req->add_maximum( $module => $version );
+#pod
+#pod This adds a new maximum version requirement. If the new requirement is
+#pod redundant to the existing specification, this has no effect.
+#pod
+#pod Maximum requirements are inclusive. No version strictly greater than the given
+#pod version is allowed.
+#pod
+#pod This method returns the requirements object.
+#pod
+#pod =method add_exclusion
+#pod
+#pod $req->add_exclusion( $module => $version );
+#pod
+#pod This adds a new excluded version. For example, you might use these three
+#pod method calls:
+#pod
+#pod $req->add_minimum( $module => '1.00' );
+#pod $req->add_maximum( $module => '1.82' );
+#pod
+#pod $req->add_exclusion( $module => '1.75' );
+#pod
+#pod Any version between 1.00 and 1.82 inclusive would be acceptable, except for
+#pod 1.75.
+#pod
+#pod This method returns the requirements object.
+#pod
+#pod =method exact_version
+#pod
+#pod $req->exact_version( $module => $version );
+#pod
+#pod This sets the version required for the given module to I<exactly> the given
+#pod version. No other version would be considered acceptable.
+#pod
+#pod This method returns the requirements object.
+#pod
+#pod =cut
BEGIN {
for my $type (qw(minimum maximum exclusion exact_version)) {
}
}
+#pod =method add_requirements
+#pod
+#pod $req->add_requirements( $another_req_object );
+#pod
+#pod This method adds all the requirements in the given CPAN::Meta::Requirements object
+#pod to the requirements object on which it was called. If there are any conflicts,
+#pod an exception is thrown.
+#pod
+#pod This method returns the requirements object.
+#pod
+#pod =cut
sub add_requirements {
my ($self, $req) = @_;
return $self;
}
+#pod =method accepts_module
+#pod
+#pod my $bool = $req->accepts_module($module => $version);
+#pod
+#pod Given an module and version, this method returns true if the version
+#pod specification for the module accepts the provided version. In other words,
+#pod given:
+#pod
+#pod Module => '>= 1.00, < 2.00'
+#pod
+#pod We will accept 1.00 and 1.75 but not 0.50 or 2.00.
+#pod
+#pod For modules that do not appear in the requirements, this method will return
+#pod true.
+#pod
+#pod =cut
sub accepts_module {
my ($self, $module, $version) = @_;
return $range->_accepts($version);
}
+#pod =method clear_requirement
+#pod
+#pod $req->clear_requirement( $module );
+#pod
+#pod This removes the requirement for a given module from the object.
+#pod
+#pod This method returns the requirements object.
+#pod
+#pod =cut
sub clear_requirement {
my ($self, $module) = @_;
return $self;
}
+#pod =method requirements_for_module
+#pod
+#pod $req->requirements_for_module( $module );
+#pod
+#pod This returns a string containing the version requirements for a given module in
+#pod the format described in L<CPAN::Meta::Spec> or undef if the given module has no
+#pod requirements. This should only be used for informational purposes such as error
+#pod messages and should not be interpreted or used for comparison (see
+#pod L</accepts_module> instead.)
+#pod
+#pod =cut
sub requirements_for_module {
my ($self, $module) = @_;
return $entry->as_string;
}
+#pod =method required_modules
+#pod
+#pod This method returns a list of all the modules for which requirements have been
+#pod specified.
+#pod
+#pod =cut
sub required_modules { keys %{ $_[0]{requirements} } }
+#pod =method clone
+#pod
+#pod $req->clone;
+#pod
+#pod This method returns a clone of the invocant. The clone and the original object
+#pod can then be changed independent of one another.
+#pod
+#pod =cut
sub clone {
my ($self) = @_;
$self->{requirements}{ $name } = $new;
}
+#pod =method is_simple
+#pod
+#pod This method returns true if and only if all requirements are inclusive minimums
+#pod -- that is, if their string expression is just the version number.
+#pod
+#pod =cut
sub is_simple {
my ($self) = @_;
return 1;
}
+#pod =method is_finalized
+#pod
+#pod This method returns true if the requirements have been finalized by having the
+#pod C<finalize> method called on them.
+#pod
+#pod =cut
sub is_finalized { $_[0]{finalized} }
+#pod =method finalize
+#pod
+#pod This method marks the requirements finalized. Subsequent attempts to change
+#pod the requirements will be fatal, I<if> they would result in a change. If they
+#pod would not alter the requirements, they have no effect.
+#pod
+#pod If a finalized set of requirements is cloned, the cloned requirements are not
+#pod also finalized.
+#pod
+#pod =cut
sub finalize { $_[0]{finalized} = 1 }
+#pod =method as_string_hash
+#pod
+#pod This returns a reference to a hash describing the requirements using the
+#pod strings in the L<CPAN::Meta::Spec> specification.
+#pod
+#pod For example after the following program:
+#pod
+#pod my $req = CPAN::Meta::Requirements->new;
+#pod
+#pod $req->add_minimum('CPAN::Meta::Requirements' => 0.102);
+#pod
+#pod $req->add_minimum('Library::Foo' => 1.208);
+#pod
+#pod $req->add_maximum('Library::Foo' => 2.602);
+#pod
+#pod $req->add_minimum('Module::Bar' => 'v1.2.3');
+#pod
+#pod $req->add_exclusion('Module::Bar' => 'v1.2.8');
+#pod
+#pod $req->exact_version('Xyzzy' => '6.01');
+#pod
+#pod my $hashref = $req->as_string_hash;
+#pod
+#pod C<$hashref> would contain:
+#pod
+#pod {
+#pod 'CPAN::Meta::Requirements' => '0.102',
+#pod 'Library::Foo' => '>= 1.208, <= 2.206',
+#pod 'Module::Bar' => '>= v1.2.3, != v1.2.8',
+#pod 'Xyzzy' => '== 6.01',
+#pod }
+#pod
+#pod =cut
sub as_string_hash {
my ($self) = @_;
return \%hash;
}
+#pod =method add_string_requirement
+#pod
+#pod $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206');
+#pod
+#pod This method parses the passed in string and adds the appropriate requirement
+#pod for the given module. It understands version ranges as described in the
+#pod L<CPAN::Meta::Spec/Version Ranges>. For example:
+#pod
+#pod =over 4
+#pod
+#pod =item 1.3
+#pod
+#pod =item >= 1.3
+#pod
+#pod =item <= 1.3
+#pod
+#pod =item == 1.3
+#pod
+#pod =item != 1.3
+#pod
+#pod =item > 1.3
+#pod
+#pod =item < 1.3
+#pod
+#pod =item >= 1.3, != 1.5, <= 2.0
+#pod
+#pod A version number without an operator is equivalent to specifying a minimum
+#pod (C<E<gt>=>). Extra whitespace is allowed.
+#pod
+#pod =back
+#pod
+#pod =cut
my %methods_for_op = (
'==' => [ qw(exact_version) ],
}
}
+#pod =method from_string_hash
+#pod
+#pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash );
+#pod
+#pod This is an alternate constructor for a CPAN::Meta::Requirements object. It takes
+#pod a hash of module names and version requirement strings and returns a new
+#pod CPAN::Meta::Requirements object.
+#pod
+#pod =cut
sub from_string_hash {
my ($class, $hash) = @_;
=pod
-=encoding utf-8
+=encoding UTF-8
=head1 NAME
=head1 VERSION
-version 2.125
+version 2.126
=head1 SYNOPSIS
=head1 DESCRIPTION
A CPAN::Meta::Requirements object models a set of version constraints like
-those specified in the F<META.yml> or F<META.json> files in CPAN distributions.
+those specified in the F<META.yml> or F<META.json> files in CPAN distributions,
+and as defined by L<CPAN::Meta::Spec>;
It can be built up by adding more and more constraints, and it will reduce them
to the simplest representation.
my $req = CPAN::Meta::Requirements->new;
This returns a new CPAN::Meta::Requirements object. It takes an optional
-hash reference argument. The following keys are supported:
+hash reference argument. Currently, only one key is supported:
=over 4
=item *
-<bad_version_hook> -- if provided, when a version cannot be parsed into
-
-a version object, this code reference will be called with the invalid version
-string as an argument. It must return a valid version object.
+C<bad_version_hook> -- if provided, when a version cannot be parsed into a version object, this code reference will be called with the invalid version string as an argument. It must return a valid version object.
=back
=head2 accepts_module
- my $bool = $req->accepts_modules($module => $version);
+ my $bool = $req->accepts_module($module => $version);
Given an module and version, this method returns true if the version
specification for the module accepts the provided version. In other words,
=head2 as_string_hash
This returns a reference to a hash describing the requirements using the
-strings in the F<META.yml> specification.
+strings in the L<CPAN::Meta::Spec> specification.
For example after the following program:
=back
+=head1 CONTRIBUTORS
+
+=over 4
+
+=item *
+
+Karen Etheridge <ether@cpan.org>
+
+=item *
+
+robario <webmaster@robario.com>
+
+=back
+
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2010 by David Golden and Ricardo Signes.
use strict;
use warnings;
package CPAN::Meta;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 SYNOPSIS
#pod
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
use strict;
use warnings;
package CPAN::Meta::Converter;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 SYNOPSIS
#pod
}
sub _convert {
- my ($data, $spec, $to_version) = @_;
+ my ($data, $spec, $to_version, $is_fragment) = @_;
my $new_data = {};
for my $key ( keys %$spec ) {
next if $key eq ':custom' || $key eq ':drop';
next unless my $fcn = $spec->{$key};
+ if ( $is_fragment && $key eq 'generated_by' ) {
+ $fcn = \&_keep;
+ }
die "spec for '$key' is not a coderef"
unless ref $fcn && ref $fcn eq 'CODE';
my $new_value = $fcn->($data->{$key}, $key, $data, $to_version);
my $args = { %args };
my $new_version = $args->{version} || $HIGHEST;
+ my $is_fragment = $args->{is_fragment};
my ($old_version) = $self->{spec};
my $converted = _dclone($self->{data});
if ( $old_version == $new_version ) {
- $converted = _convert( $converted, $cleanup{$old_version}, $old_version );
- unless ( $args->{no_validation} ) {
+ $converted = _convert( $converted, $cleanup{$old_version}, $old_version, $is_fragment );
+ unless ( $args->{is_fragment} ) {
my $cmv = CPAN::Meta::Validator->new( $converted );
unless ( $cmv->is_valid ) {
my $errs = join("\n", $cmv->errors);
next if $vers[$i] > $old_version;
last if $vers[$i+1] < $new_version;
my $spec_string = "$vers[$i+1]-from-$vers[$i]";
- $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1] );
- unless ( $args->{no_validation} ) {
+ $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1], $is_fragment );
+ unless ( $args->{is_fragment} ) {
my $cmv = CPAN::Meta::Validator->new( $converted );
unless ( $cmv->is_valid ) {
my $errs = join("\n", $cmv->errors);
next if $vers[$i] < $old_version;
last if $vers[$i+1] > $new_version;
my $spec_string = "$vers[$i+1]-from-$vers[$i]";
- $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1] );
- unless ( $args->{no_validation} ) {
+ $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1], $is_fragment );
+ unless ( $args->{is_fragment} ) {
my $cmv = CPAN::Meta::Validator->new( $converted );
unless ( $cmv->is_valid ) {
my $errs = join("\n", $cmv->errors);
grep { defined }
map { $fragments_generate{$old_version}{$_} }
keys %{ $self->{data} };
- my $converted = $self->convert( version => $HIGHEST, no_validation => 1 );
+ my $converted = $self->convert( version => $HIGHEST, is_fragment => 1 );
for my $key ( keys %$converted ) {
next if $key =~ /^x_/i || $key eq 'meta-spec';
delete $converted->{$key} unless $expected{$key};
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
use strict;
use warnings;
package CPAN::Meta::Feature;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
use CPAN::Meta::Prereqs;
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 DESCRIPTION
use strict;
use warnings;
package CPAN::Meta::History;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
1;
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 DESCRIPTION
--- /dev/null
+package CPAN::Meta::Merge;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.142060'; # VERSION
+
+use Carp qw/croak/;
+use Scalar::Util qw/blessed/;
+use CPAN::Meta::Converter;
+
+sub _identical {
+ my ($left, $right, $path) = @_;
+ croak "Can't merge attribute " . join '.', @{$path} unless $left eq $right;
+ return $left;
+}
+
+sub _merge {
+ my ($current, $next, $mergers, $path) = @_;
+ for my $key (keys %{$next}) {
+ if (not exists $current->{$key}) {
+ $current->{$key} = $next->{$key};
+ }
+ elsif (my $merger = $mergers->{$key}) {
+ $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]);
+ }
+ elsif ($merger = $mergers->{':default'}) {
+ $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]);
+ }
+ else {
+ croak sprintf "Can't merge unknown attribute '%s'", join '.', @{$path}, $key;
+ }
+ }
+ return $current;
+}
+
+sub _uniq {
+ my %seen = ();
+ return grep { not $seen{$_}++ } @_;
+}
+
+sub _set_addition {
+ my ($left, $right) = @_;
+ return [ +_uniq(@{$left}, @{$right}) ];
+}
+
+sub _uniq_map {
+ my ($left, $right, $path) = @_;
+ for my $key (keys %{$right}) {
+ if (not exists $left->{$key}) {
+ $left->{$key} = $right->{$key};
+ }
+ else {
+ croak 'Duplication of element ' . join '.', @{$path}, $key;
+ }
+ }
+ return $left;
+}
+
+sub _improvize {
+ my ($left, $right, $path) = @_;
+ my ($name) = reverse @{$path};
+ if ($name =~ /^x_/) {
+ if (ref($left) eq 'ARRAY') {
+ return _set_addition($left, $right, $path);
+ }
+ elsif (ref($left) eq 'HASH') {
+ return _uniq_map($left, $right, $path);
+ }
+ else {
+ return _identical($left, $right, $path);
+ }
+ }
+ croak sprintf "Can't merge '%s'", join '.', @{$path};
+}
+
+my %default = (
+ abstract => \&_identical,
+ author => \&_set_addition,
+ dynamic_config => sub {
+ my ($left, $right) = @_;
+ return $left || $right;
+ },
+ generated_by => sub {
+ my ($left, $right) = @_;
+ return join ', ', _uniq(split(/, /, $left), split(/, /, $right));
+ },
+ license => \&_set_addition,
+ 'meta-spec' => {
+ version => \&_identical,
+ url => \&_identical
+ },
+ name => \&_identical,
+ release_status => \&_identical,
+ version => \&_identical,
+ description => \&_identical,
+ keywords => \&_set_addition,
+ no_index => { map { ($_ => \&_set_addition) } qw/file directory package namespace/ },
+ optional_features => \&_uniq_map,
+ prereqs => sub {
+ require CPAN::Meta::Prereqs;
+ my ($left, $right) = map { CPAN::Meta::Prereqs->new($_) } @_[0,1];
+ return $left->with_merged_prereqs($right)->as_string_hash;
+ },
+ provides => \&_uniq_map,
+ resources => {
+ license => \&_set_addition,
+ homepage => \&_identical,
+ bugtracker => \&_uniq_map,
+ repository => \&_uniq_map,
+ ':default' => \&_improvize,
+ },
+ ':default' => \&_improvize,
+);
+
+sub new {
+ my ($class, %arguments) = @_;
+ croak 'default version required' if not exists $arguments{default_version};
+ my %mapping = %default;
+ my %extra = %{ $arguments{extra_mappings} || {} };
+ for my $key (keys %extra) {
+ if (ref($mapping{$key}) eq 'HASH') {
+ $mapping{$key} = { %{ $mapping{$key} }, %{ $extra{$key} } };
+ }
+ else {
+ $mapping{$key} = $extra{$key};
+ }
+ }
+ return bless {
+ default_version => $arguments{default_version},
+ mapping => _coerce_mapping(\%mapping, []),
+ }, $class;
+}
+
+my %coderef_for = (
+ set_addition => \&_set_addition,
+ uniq_map => \&_uniq_map,
+ identical => \&_identical,
+ improvize => \&_improvize,
+);
+
+sub _coerce_mapping {
+ my ($orig, $map_path) = @_;
+ my %ret;
+ for my $key (keys %{$orig}) {
+ my $value = $orig->{$key};
+ if (ref($orig->{$key}) eq 'CODE') {
+ $ret{$key} = $value;
+ }
+ elsif (ref($value) eq 'HASH') {
+ my $mapping = _coerce_mapping($value, [ @{$map_path}, $key ]);
+ $ret{$key} = sub {
+ my ($left, $right, $path) = @_;
+ return _merge($left, $right, $mapping, [ @{$path}, $key ]);
+ };
+ }
+ elsif ($coderef_for{$value}) {
+ $ret{$key} = $coderef_for{$value};
+ }
+ else {
+ croak "Don't know what to do with " . join '.', @{$map_path}, $key;
+ }
+ }
+ return \%ret;
+}
+
+sub merge {
+ my ($self, @items) = @_;
+ my $current = {};
+ for my $next (@items) {
+ if ( blessed($next) && $next->isa('CPAN::Meta') ) {
+ $next = $next->as_string_hash;
+ }
+ elsif ( ref($next) eq 'HASH' ) {
+ my $cmc = CPAN::Meta::Converter->new(
+ $next, default_version => $self->{default_version}
+ );
+ $next = $cmc->upgrade_fragment;
+ }
+ else {
+ croak "Don't know how to merge '$next'";
+ }
+ $current = _merge($current, $next, $self->{mapping}, []);
+ }
+ return $current;
+}
+
+1;
+
+# ABSTRACT: Merging CPAN Meta fragments
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+CPAN::Meta::Merge - Merging CPAN Meta fragments
+
+=head1 VERSION
+
+version 2.142060
+
+=head1 SYNOPSIS
+
+ my $merger = CPAN::Meta::Merge->new(default_version => "2");
+ my $meta = $merger->merge($base, @additional);
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 new
+
+This creates a CPAN::Meta::Merge object. It takes one mandatory named
+argument, C<version>, declaring the version of the meta-spec that must be
+used for the merge. It can optionally take an C<extra_mappings> argument
+that allows one to add additional merging functions for specific elements.
+
+=head2 merge(@fragments)
+
+Merge all C<@fragments> together. It will accept both CPAN::Meta objects and
+(possibly incomplete) hashrefs of metadata.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
use strict;
use warnings;
package CPAN::Meta::Prereqs;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 DESCRIPTION
#pod
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 DESCRIPTION
use strict;
use warnings;
package CPAN::Meta::Spec;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
1;
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
use strict;
use warnings;
package CPAN::Meta::Validator;
-our $VERSION = '2.141520'; # VERSION
+our $VERSION = '2.142060'; # VERSION
#pod =head1 SYNOPSIS
#pod
=head1 VERSION
-version 2.141520
+version 2.142060
=head1 SYNOPSIS
--- /dev/null
+#! perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use CPAN::Meta::Merge;
+
+my %base = (
+ abstract => 'This is a test',
+ author => ['A.U. Thor'],
+ generated_by => 'Myself',
+ license => [ 'perl_5' ],
+ resources => {
+ license => [ 'http://dev.perl.org/licenses/' ],
+ },
+ prereqs => {
+ runtime => {
+ requires => {
+ Foo => '0',
+ },
+ },
+ },
+ dynamic_config => 0,
+ provides => {
+ Baz => {
+ file => 'lib/Baz.pm',
+ },
+ },
+ 'meta-spec' => {
+ url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ version => 2,
+ },
+);
+
+my %first = (
+ author => [ 'I.M. Poster' ],
+ generated_by => 'Some other guy',
+ license => [ 'bsd' ],
+ resources => {
+ license => [ 'http://opensource.org/licenses/bsd-license.php' ],
+ },
+ prereqs => {
+ runtime => {
+ requires => {
+ Foo => '< 1',
+ },
+ recommends => {
+ Bar => '3.14',
+ },
+ },
+ test => {
+ requires => {
+ 'Test::Bar' => 0,
+ },
+ },
+ },
+ dynamic_config => 1,
+ provides => {
+ Quz => {
+ file => 'lib/Quz.pm',
+ },
+ },
+);
+my %first_expected = (
+ abstract => 'This is a test',
+ author => [ 'A.U. Thor', 'I.M. Poster' ],
+ generated_by => 'Myself, Some other guy',
+ license => [ 'perl_5', 'bsd' ],
+ resources => {
+ license => [ 'http://dev.perl.org/licenses/', 'http://opensource.org/licenses/bsd-license.php' ],
+ },
+ prereqs => {
+ runtime => {
+ requires => {
+ Foo => '>= 0, < 1',
+ },
+ recommends => {
+ Bar => '3.14',
+ },
+ },
+ test => {
+ requires => {
+ 'Test::Bar' => 0,
+ },
+ },
+ },
+ provides => {
+ Baz => {
+ file => 'lib/Baz.pm',
+ },
+ Quz => {
+ file => 'lib/Quz.pm',
+ },
+ },
+ dynamic_config => 1,
+ 'meta-spec' => {
+ url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ version => 2,
+ },
+);
+
+my $merger = CPAN::Meta::Merge->new(default_version => '2');
+
+my $first_result = $merger->merge(\%base, \%first);
+
+is_deeply($first_result, \%first_expected, 'First result is as expected');
+
+is_deeply($merger->merge(\%base, { abstract => 'This is a test' }), \%base, 'Can merge in identical abstract');
+my $failure = eval { $merger->merge(\%base, { abstract => 'And now for something else' }) };
+is($failure, undef, 'Trying to merge different author gives an exception');
+like $@, qr/^Can't merge attribute abstract /, 'Exception looks right';
+
+my $failure2 = eval { $merger->merge(\%base, { provides => { Baz => { file => 'Baz.pm' } } }) };
+is($failure2, undef, 'Trying to merge different author gives an exception');
+like $@, qr/^Duplication of element provides\.Baz /, 'Exception looks right';
+
+done_testing();
use Config;
use Exporter;
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
-$VERSION = "0.20";
+$VERSION = "0.22";
@ISA = ("Exporter");
@EXPORT_OK = qw( plv2hash summary myconfig signature );
%EXPORT_TAGS = (
my %BTD = map { $_ => 0 } qw(
DEBUGGING
- NO_MATHOMS
NO_HASH_SEED
+ NO_MATHOMS
NO_TAINT_SUPPORT
PERL_BOOL_AS_CHAR
PERL_DISABLE_PMC
PERL_DONT_CREATE_GVSV
PERL_EXTERNAL_GLOB
- PERL_HASH_FUNC_SIPHASH
- PERL_HASH_FUNC_SDBM
PERL_HASH_FUNC_DJB2
- PERL_HASH_FUNC_SUPERFAST
PERL_HASH_FUNC_MURMUR3
PERL_HASH_FUNC_ONE_AT_A_TIME
PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
PERL_HASH_FUNC_ONE_AT_A_TIME_OLD
+ PERL_HASH_FUNC_SDBM
+ PERL_HASH_FUNC_SIPHASH
+ PERL_HASH_FUNC_SUPERFAST
PERL_IS_MINIPERL
PERL_MALLOC_WRAP
PERL_MEM_LOG
HAVE_INTERP_INTERN
MULTIPLICITY
MYMALLOC
- PERLIO_LAYERS
PERL_DEBUG_READONLY_COW
PERL_DEBUG_READONLY_OPS
PERL_GLOBAL_STRUCT
+ PERL_GLOBAL_STRUCT_PRIVATE
PERL_IMPLICIT_CONTEXT
PERL_IMPLICIT_SYS
+ PERLIO_LAYERS
PERL_MAD
PERL_MICRO
PERL_NEED_APPCTX
USE_LARGE_FILES
USE_LOCALE_COLLATE
USE_LOCALE_NUMERIC
+ USE_LOCALE_TIME
USE_LONG_DOUBLE
USE_PERLIO
USE_REENTRANT_API
sub plv2hash
{
my %config;
- for (split m/\n+/ => join "\n", @_) {
-
- if (s/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)//) {
- $config{"package"} = $1;
- my $rev = $2;
- $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1;
- $rev and $config{version_patchlevel_string} = $rev;
- my ($rel) = $config{package} =~ m{perl(\d)};
- my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)};
- defined $vers && defined $subvers && defined $rel and
- $config{version} = "$rel.$vers.$subvers";
- next;
- }
- if (s/^\s+(Snapshot of:)\s+(\S+)//) {
- $config{git_commit_id_title} = $1;
- $config{git_commit_id} = $2;
- next;
- }
+ my $pv = join "\n" => @_;
+
+ if ($pv =~ m/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)/m) {
+ $config{"package"} = $1;
+ my $rev = $2;
+ $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1;
+ $rev and $config{version_patchlevel_string} = $rev;
+ my ($rel) = $config{"package"} =~ m{perl(\d)};
+ my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)};
+ defined $vers && defined $subvers && defined $rel and
+ $config{version} = "$rel.$vers.$subvers";
+ }
+
+ if ($pv =~ m/^\s+(Snapshot of:)\s+(\S+)/) {
+ $config{git_commit_id_title} = $1;
+ $config{git_commit_id} = $2;
+ }
- my %kv = m/\G,?\s*([^=]+)=('[^']+?'|\S+)/gc;
+ if (my %kv = ($pv =~ m{\b
+ (\w+) # key
+ \s*= # assign
+ ( '\s*[^']*?\s*' # quoted value
+ | \S+[^=]*?\s*\n # unquoted running till end of line
+ | \S+ # unquoted value
+ | \s*\n # empty
+ )
+ (?:,?\s+|\s*\n)? # separator (5.8.x reports did not have a ','
+ }gx)) { # between every kv pair
while (my ($k, $v) = each %kv) {
$k =~ s/\s+$//;
+ $v =~ s/\s*\n\z//;
$v =~ s/,$//;
$v =~ m/^'(.*)'$/ and $v = $1;
- $v =~ s/^\s+//;
$v =~ s/\s+$//;
$config{$k} = $v;
}
}
+
my $build = { %empty_build };
+
+ $pv =~ m{^\s+Compiled at\s+(.*)}m
+ and $build->{stamp} = $1;
+ $pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*?)(?:[\s\n]+Buil[td] under)}ms
+ and $build->{patches} = [ split m/\n+\s*/, $1 ];
+ $pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*?)(?:[\s\n]+(?:Locally applied|Buil[td] under))}ms
+ and map { $build->{options}{$_} = 1 } split m/\s+|\n/ => $1;
+
$build->{osname} = $config{osname};
+ $pv =~ m{^\s+Built under\s+(.*)}m
+ and $build->{osname} = $1;
+ $config{osname} ||= $build->{osname};
+
return _make_derived ({
build => $build,
environment => {},
}
else {
#y $pv = qx[$^X -e"sub Config::myconfig{};" -V];
- my $pv = qx[$^X -V];
- $pv =~ s{.*?\n\n}{}s;
- $pv =~ s{\n(?: \s+|\t\s*)}{\0}g;
-
- # print STDERR $pv;
-
- $pv =~ m{^\s+Built under\s+(.*)}m
- and $build->{osname} = $1;
- $pv =~ m{^\s+Compiled at\s+(.*)}m
- and $build->{stamp} = $1;
- $pv =~ m{^\s+Locally applied patches:(?:\s+|\0)(.*)}m
- and $build->{patches} = [ split m/\0+/, $1 ];
- $pv =~ m{^\s+Compile-time options:(?:\s+|\0)(.*)}m
- and map { $build->{options}{$_} = 1 } split m/\s+|\0/ => $1;
+ my $cnf = plv2hash (qx[$^X -V]);
+
+ $build->{$_} = $cnf->{build}{$_} for qw( osname stamp patches options );
}
my @KEYS = keys %ENV;
+++ /dev/null
-#!/usr/bin/perl
-
-use Test::More;
-
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-all_pod_files_ok ();
+++ /dev/null
-#!/usr/bin/perl
-
-use Test::More;
-
-eval "use Test::Pod::Coverage tests => 1";
-plan skip_all => "Test::Pod::Coverage required for testing POD Coverage" if $@;
-pod_coverage_ok ("Config::Perl::V", "Config::Perl::V is covered");
}
ok (my $conf = Config::Perl::V::myconfig, "Read config");
-for (qw( build environment config inc )) {
- ok (exists $conf->{build}, "Has build entry");
- }
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
is (lc $conf->{build}{osname}, lc $conf->{config}{osname}, "osname");
SKIP: {
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 92;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "Mar 23 2010 17:34:56", "Build time");
+is ($conf->{config}{"package"}, "perl5", "reconstructed \%Config{package}");
+is ($conf->{config}{version}, "5.6.2", "reconstructed \%Config{version}");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ DEBUGGING USE_64_BIT_INT USE_LARGE_FILES
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+__END__
+Summary of my perl5 (revision 5.0 version 6 subversion 2) configuration:
+ Platform:
+ osname=linux, osvers=2.6.31.12-0.2-default, archname=i686-linux-64int-perlio
+ uname='linux nb09 2.6.31.12-0.2-default #1 smp 2010-03-16 21:25:39 +0100 i686 i686 i386 gnulinux '
+ config_args='-Dusedevel -Duse64bitint -Duseperlio -des -Dusedevel -Uinstallusrbinperl -Dprefix=/media/Tux/perls'
+ hint=recommended, useposix=true, d_sigaction=define
+ usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
+ useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
+ use64bitint=define use64bitall=undef uselongdouble=undef
+ Compiler:
+ cc='cc', ccflags ='-DDEBUGGING -fno-strict-aliasing -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
+ optimize='-O2',
+ cppflags='-DDEBUGGING -fno-strict-aliasing -I/pro/local/include'
+ ccversion='', gccversion='4.4.1 [gcc-4_4-branch revision 150839]', gccosandvers=''
+ intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
+ ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
+ alignbytes=4, usemymalloc=n, prototype=define
+ Linker and Libraries:
+ ld='cc', ldflags ='-L/pro/local/lib'
+ libpth=/pro/local/lib /lib /usr/lib /usr/local/lib
+ libs=-lnsl -lgdbm -ldb -ldl -lm -lc -lcrypt -lutil
+ perllibs=-lnsl -ldl -lm -lc -lcrypt -lutil
+ libc=/lib/libc-2.10.1.so, so=so, useshrplib=false, libperl=libperl.a
+ Dynamic Linking:
+ dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
+ cccdlflags='-fpic', lddlflags='-shared -L/pro/local/lib'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: DEBUGGING USE_64_BIT_INT USE_LARGE_FILES
+ Built under linux
+ Compiled at Mar 23 2010 17:34:56
+ @INC:
+ /media/Tux/perls/lib/5.6.2/i686-linux-64int-perlio
+ /media/Tux/perls/lib/5.6.2
+ /media/Tux/perls/lib/site_perl/5.6.2/i686-linux-64int-perlio
+ /media/Tux/perls/lib/site_perl/5.6.2
+ /media/Tux/perls/lib/site_perl
+ .
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 92;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "Oct 21 2010 14:50:53", "Build time");
+is ($conf->{config}{version}, "5.8.9", "reconstructed \%Config{version}");
+is ($conf->{config}{usethreads}, "define", "This was a threaded perl");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ DEBUGGING MULTIPLICITY PERL_IMPLICIT_CONTEXT
+ PERL_MALLOC_WRAP THREADS_HAVE_PIDS USE_64_BIT_INT
+ USE_FAST_STDIO USE_ITHREADS USE_LARGE_FILES
+ USE_LONG_DOUBLE USE_PERLIO USE_REENTRANT_API
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+__END__
+Summary of my perl5 (revision 5 version 8 subversion 9) configuration:
+ Platform:
+ osname=linux, osvers=2.6.34.7-0.4-desktop, archname=i686-linux-thread-multi-64int-ld
+ uname='linux tux09.procura.nl 2.6.34.7-0.4-desktop #1 smp preempt 2010-10-07 19:07:51 +0200 i686 i686 i386 gnulinux '
+ config_args='-Dusedevel -Dusethreads -Duseithreads -Duse64bitint -Duselongdouble -Duseperlio -des -Dusedevel -Uinstallusrbinperl -Dprefix=/media/Tux/perls-t'
+ hint=recommended, useposix=true, d_sigaction=define
+ usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
+ useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
+ use64bitint=define use64bitall=undef uselongdouble=define
+ usemymalloc=n, bincompat5005=undef
+ Compiler:
+ cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -pipe -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
+ optimize='-O2',
+ cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -pipe -I/pro/local/include'
+ ccversion='', gccversion='4.5.0 20100604 [gcc-4_5-branch revision 160292]', gccosandvers=''
+ intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
+ ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8
+ alignbytes=4, prototype=define
+ Linker and Libraries:
+ ld='cc', ldflags ='-L/pro/local/lib'
+ libpth=/pro/local/lib /lib /usr/lib /usr/local/lib
+ libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
+ perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
+ libc=/lib/libc-2.11.2.so, so=so, useshrplib=false, libperl=libperl.a
+ gnulibc_version='2.11.2'
+ Dynamic Linking:
+ dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
+ cccdlflags='-fPIC', lddlflags='-shared -O2 -L/pro/local/lib'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: DEBUGGING MULTIPLICITY PERL_IMPLICIT_CONTEXT
+ PERL_MALLOC_WRAP THREADS_HAVE_PIDS USE_64_BIT_INT
+ USE_FAST_STDIO USE_ITHREADS USE_LARGE_FILES
+ USE_LONG_DOUBLE USE_PERLIO USE_REENTRANT_API
+ Built under linux
+ Compiled at Oct 21 2010 14:50:53
+ @INC:
+ /media/Tux/perls-t/lib/5.8.9/i686-linux-thread-multi-64int-ld
+ /media/Tux/perls-t/lib/5.8.9
+ /media/Tux/perls-t/lib/site_perl/5.8.9/i686-linux-thread-multi-64int-ld
+ /media/Tux/perls-t/lib/site_perl/5.8.9
+ .
BEGIN {
use Test::More;
- my $tests = 8;
+ my $tests = 91;
unless ($ENV{PERL_CORE}) {
require Test::NoWarnings;
Test::NoWarnings->import ();
is ($conf->{build}{stamp}, 0, "No build time known");
is ($conf->{config}{version}, "5.10.0", "reconstructed \%Config{version}");
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
__END__
Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
Platform:
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 93;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "Dec 20 2010 12:46:00", "Build time");
+is ($conf->{config}{version}, "5.12.2", "reconstructed \%Config{version}");
+is ($conf->{config}{gccversion}, "", "not built with gcc");
+is ($conf->{config}{ccversion}, "B3910B", "built with HP C-ANSI-C");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP USE_64_BIT_ALL
+ USE_64_BIT_INT USE_LARGE_FILES USE_LONG_DOUBLE
+ USE_PERLIO USE_PERL_ATOF
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+__END__
+Summary of my perl5 (revision 5 version 12 subversion 2) configuration:
+
+ Platform:
+ osname=hpux, osvers=11.31, archname=IA64.ARCHREV_0-LP64-ld
+ uname='hp-ux x2 b.11.31 u ia64 2977233888 unlimited-user license '
+ config_args='-Duse64bitall -Duselongdouble -des'
+ hint=recommended, useposix=true, d_sigaction=define
+ useithreads=undef, usemultiplicity=undef
+ useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
+ use64bitint=define, use64bitall=define, uselongdouble=define
+ usemymalloc=n, bincompat5005=undef
+ Compiler:
+ cc='cc', ccflags =' -Ae -DPERL_DONT_CREATE_GVSV +Z -z -D_HPUX_SOURCE -Wl,+vnocompatwarnings +DD64 -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 ',
+ optimize='+O2 +Onolimit',
+ cppflags='-Aa -D__STDC_EXT__ -DPERL_DONT_CREATE_GVSV +Z -z -D_HPUX_SOURCE -Ae -DPERL_DONT_CREATE_GVSV +Z -z -D_HPUX_SOURCE -Wl,+vnocompatwarnings +DD64 -I/pro/local/include'
+ ccversion='B3910B', gccversion='', gccosandvers=''
+ intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=87654321
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
+ ivtype='long', ivsize=8, nvtype='long double', nvsize=16, Off_t='off_t', lseeksize=8
+ alignbytes=16, prototype=define
+ Linker and Libraries:
+ ld='/usr/bin/ld', ldflags ='-L/pro/local/lib +DD64 -L/usr/lib/hpux64'
+ libpth=/pro/local/lib /usr/lib/hpux64 /lib /usr/lib /usr/ccs/lib /usr/local/lib
+ libs=-lcl -lpthread -lnsl -lnm -ldb -ldl -ldld -lm -lsec -lc
+ perllibs=-lcl -lpthread -lnsl -lnm -ldl -ldld -lm -lsec -lc
+ libc=/usr/lib/hpux64/libc.so, so=so, useshrplib=false, libperl=libperl.a
+ gnulibc_version=''
+ Dynamic Linking:
+ dlsrc=dl_hpux.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-B,deferred '
+ cccdlflags='+Z', lddlflags='-b +vnocompatwarnings -L/pro/local/lib -L/usr/lib/hpux64'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP USE_64_BIT_ALL
+ USE_64_BIT_INT USE_LARGE_FILES USE_LONG_DOUBLE
+ USE_PERLIO USE_PERL_ATOF
+ Built under hpux
+ Compiled at Dec 20 2010 12:46:00
+ @INC:
+ /pro/lib/perl5/site_perl/5.12.2/IA64.ARCHREV_0-LP64-ld
+ /pro/lib/perl5/site_perl/5.12.2
+ /pro/lib/perl5/5.12.2/IA64.ARCHREV_0-LP64-ld
+ /pro/lib/perl5/5.12.2
+ .
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 93;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "May 11 2012 16:36:53", "Build time");
+is ($conf->{config}{version}, "5.14.2", "reconstructed \%Config{version}");
+is ($conf->{config}{gccversion}, "", "not built with gcc");
+is ($conf->{config}{ccversion}, "11.1.0.8", "xlc version");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ DEBUGGING PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP
+ PERL_PRESERVE_IVUV PERL_USE_DEVEL USE_64_BIT_ALL
+ USE_64_BIT_INT USE_LARGE_FILES USE_PERLIO
+ USE_PERL_ATOF
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+__END__
+Summary of my perl5 (revision 5 version 14 subversion 2) configuration:
+
+ Platform:
+ osname=aix, osvers=5.3.0.0, archname=aix-64all
+ uname='aix i3 3 5 0004898ad300 '
+ config_args='-Dusedevel -Duse64bitall -Uversiononly -Dinc_version_list=none -des'
+ hint=recommended, useposix=true, d_sigaction=define
+ useithreads=undef, usemultiplicity=undef
+ useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
+ use64bitint=define, use64bitall=define, uselongdouble=undef
+ usemymalloc=n, bincompat5005=undef
+ Compiler:
+ cc='xlc -q64', ccflags ='-q64 -DDEBUGGING -qlanglvl=extended -D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE -qmaxmem=-1 -qnoansialias -DUSE_NATIVE_DLOPEN -qlanglvl=extended -I/pro/local/include -q64 -DUSE_64_BIT_ALL -q64',
+ optimize='-O',
+ cppflags='-DDEBUGGING -D_ALL_SOURCE -D_ANSI_C_SOURCE -D_POSIX_SOURCE -DUSE_NATIVE_DLOPEN -I/pro/local/include'
+ ccversion='11.1.0.8', gccversion='', gccosandvers=''
+ intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=87654321
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=8
+ ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
+ alignbytes=8, prototype=define
+ Linker and Libraries:
+ ld='ld', ldflags ='-L/usr/local/ppc64/lib64 -b64 -q64 -L/pro/local/lib -brtl -bdynamic -b64'
+ libpth=/usr/local/ppc64/lib64 /lib /usr/lib /usr/ccs/lib /usr/local/lib /usr/lib64
+ libs=-lbind -lnsl -ldbm -ldb -ldl -lld -lm -lcrypt -lc
+ perllibs=-lbind -lnsl -ldl -lld -lm -lcrypt -lc
+ libc=/lib/libc.a, so=a, useshrplib=false, libperl=libperl.a
+ gnulibc_version=''
+ Dynamic Linking:
+ dlsrc=dl_aix.xs, dlext=so, d_dlsymun=undef, ccdlflags=' -bE:/pro/lib/perl5/5.14.2/aix-64all/CORE/perl.exp'
+ cccdlflags=' ', lddlflags='-b64 -bhalt:4 -G -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -bnoentry -lc -lm -L/usr/local/ppc64/lib64 -L/pro/local/lib'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: DEBUGGING PERL_DONT_CREATE_GVSV PERL_MALLOC_WRAP
+ PERL_PRESERVE_IVUV PERL_USE_DEVEL USE_64_BIT_ALL
+ USE_64_BIT_INT USE_LARGE_FILES USE_PERLIO
+ USE_PERL_ATOF
+ Built under aix
+ Compiled at May 11 2012 16:36:53
+ @INC:
+ /pro/lib/perl5/site_perl/5.14.2/aix-64all
+ /pro/lib/perl5/site_perl/5.14.2
+ /pro/lib/perl5/5.14.2/aix-64all
+ /pro/lib/perl5/5.14.2
+ .
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 92;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "Mar 12 2013 08:36:17", "Build time");
+is ($conf->{config}{version}, "5.16.3", "reconstructed \%Config{version}");
+is ($conf->{config}{ccversion}, "", "Using gcc. non-gcc version should not be defined");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ HAS_TIMES PERLIO_LAYERS PERL_DONT_CREATE_GVSV
+ PERL_MALLOC_WRAP PERL_PRESERVE_IVUV USE_64_BIT_INT
+ USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
+ USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_PERLIO
+ USE_PERL_ATOF
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+__END__
+Summary of my perl5 (revision 5 version 16 subversion 3) configuration:
+
+ Platform:
+ osname=linux, osvers=3.4.33-2.24-desktop, archname=i686-linux-64int
+ uname='linux lx09 3.4.33-2.24-desktop #1 smp preempt tue feb 26 03:34:33 utc 2013 (5f00a32) i686 i686 i386 gnulinux '
+ config_args='-Duse64bitint -Duselongdouble -des'
+ hint=previous, useposix=true, d_sigaction=define
+ useithreads=undef, usemultiplicity=undef
+ useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
+ use64bitint=define, use64bitall=undef, uselongdouble=undef
+ usemymalloc=n, bincompat5005=undef
+ Compiler:
+ cc='cc', ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
+ optimize='-O2',
+ cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/pro/local/include -fno-strict-aliasing -pipe -fstack-protector -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
+ ccversion='', gccversion='4.7.1 20120723 [gcc-4_7-branch revision 189773]', gccosandvers=''
+ intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
+ ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
+ alignbytes=4, prototype=define
+ Linker and Libraries:
+ ld='cc', ldflags ='-L/pro/local/lib -fstack-protector'
+ libpth=/pro/local/lib /lib /usr/lib /usr/local/lib
+ libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
+ perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
+ libc=/lib/libc-2.15.so, so=so, useshrplib=false, libperl=libperl.a
+ gnulibc_version='2.15'
+ Dynamic Linking:
+ dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
+ cccdlflags='-fPIC', lddlflags='-shared -O2 -L/pro/local/lib -fstack-protector'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: HAS_TIMES PERLIO_LAYERS PERL_DONT_CREATE_GVSV
+ PERL_MALLOC_WRAP PERL_PRESERVE_IVUV USE_64_BIT_INT
+ USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
+ USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_PERLIO
+ USE_PERL_ATOF
+ Built under linux
+ Compiled at Mar 12 2013 08:36:17
+ @INC:
+ /pro/lib/perl5/site_perl/5.16.3/i686-linux-64int
+ /pro/lib/perl5/site_perl/5.16.3
+ /pro/lib/perl5/5.16.3/i686-linux-64int
+ /pro/lib/perl5/5.16.3
+ .
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 150;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "Aug 25 2013 01:24:40", "Build time");
+is ($conf->{config}{version}, "5.16.2", "reconstructed \%Config{version}");
+is ($conf->{config}{ccversion}, "", "Using gcc. non-gcc version should not be defined");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ HAS_TIMES MULTIPLICITY PERLIO_LAYERS
+ PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT
+ PERL_MALLOC_WRAP PERL_PRESERVE_IVUV USE_64_BIT_ALL
+ USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES
+ USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE
+ USE_LOCALE_NUMERIC USE_PERLIO USE_PERL_ATOF
+ USE_REENTRANT_API
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+is_deeply ($conf->{build}{patches}, [
+ "/Library/Perl/Updates/<version> comes before system perl directories",
+ "installprivlib and installarchlib points to the Updates directory",
+ "CVE-2013-1667 hashtable DOS fix",
+ ], "Local patches");
+
+my %check = (
+
+ archname => "darwin-thread-multi-2level",
+ bincompat5005 => "undef",
+ config_args => "-ds -e -Dprefix=/usr -Dccflags=-g -pipe -Dldflags= -Dman3ext=3pm -Duseithreads -Duseshrplib -Dinc_version_list=none -Dcc=cc",
+ d_sfio => "undef",
+ d_sigaction => "define",
+ hint => "recommended",
+ myuname => "darwin jackson.apple.com 13.0 darwin kernel version 13.0.0: tue jul 30 20:52:22 pdt 2013; root:xnu-2422.1.53~3release_x86_64 x86_64",
+ use64bitall => "define",
+ use64bitint => "define",
+ useithreads => "define",
+ uselargefiles => "define",
+ uselongdouble => "undef",
+ usemultiplicity => "define",
+ usemymalloc => "n",
+ useperlio => "define",
+ useposix => "true",
+ usesocks => "undef",
+
+ alignbytes => 8,
+ byteorder => "12345678",
+ cc => "cc",
+ ccflags => "-arch x86_64 -arch i386 -g -pipe -fno-common -DPERL_DARWIN -fno-strict-aliasing -fstack-protector -I/usr/local/include",
+ ccversion => "",
+ cppflags => "-g -pipe -fno-common -DPERL_DARWIN -fno-strict-aliasing -fstack-protector -I/usr/local/include",
+ d_longdbl => "define",
+ d_longlong => "define",
+ doublesize => 8,
+ gccosandvers => "",
+ gccversion => "4.2.1 Compatible Apple LLVM 5.0 (clang-500.0.68)",
+ intsize => 4,
+ ivsize => 8,
+ ivtype => "long",
+ longdblsize => 16,
+ longlongsize => 8,
+ longsize => 8,
+ lseeksize => 8,
+ nvsize => 8,
+ nvtype => "double",
+ lseektype => "off_t",
+ optimize => "-Os",
+ prototype => "define",
+ ptrsize => 8,
+
+ gnulibc_version => "",
+ ld => "cc -mmacosx-version-min=10.9",
+ ldflags => "-arch x86_64 -arch i386 -fstack-protector -L/usr/local/lib",
+ libc => "",
+ libperl => "libperl.dylib",
+ libpth => "/usr/local/lib /usr/lib",
+ libs => "",
+ perllibs => "",
+ so => "dylib",
+ useshrplib => "true",
+
+ cccdlflags => "",
+ ccdlflags => "",
+ d_dlsymun => "undef",
+ dlext => "bundle",
+ dlsrc => "dl_dlopen.xs",
+ lddlflags => "-arch x86_64 -arch i386 -bundle -undefined dynamic_lookup -L/usr/local/lib -fstack-protector",
+ );
+is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check;
+
+
+__END__
+Summary of my perl5 (revision 5 version 16 subversion 2) configuration:
+
+ Platform:
+ osname=darwin, osvers=13.0, archname=darwin-thread-multi-2level
+ uname='darwin jackson.apple.com 13.0 darwin kernel version 13.0.0: tue jul 30 20:52:22 pdt 2013; root:xnu-2422.1.53~3release_x86_64 x86_64 '
+ config_args='-ds -e -Dprefix=/usr -Dccflags=-g -pipe -Dldflags= -Dman3ext=3pm -Duseithreads -Duseshrplib -Dinc_version_list=none -Dcc=cc'
+ hint=recommended, useposix=true, d_sigaction=define
+ useithreads=define, usemultiplicity=define
+ useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
+ use64bitint=define, use64bitall=define, uselongdouble=undef
+ usemymalloc=n, bincompat5005=undef
+ Compiler:
+ cc='cc', ccflags ='-arch x86_64 -arch i386 -g -pipe -fno-common -DPERL_DARWIN -fno-strict-aliasing -fstack-protector -I/usr/local/include',
+ optimize='-Os',
+ cppflags='-g -pipe -fno-common -DPERL_DARWIN -fno-strict-aliasing -fstack-protector -I/usr/local/include'
+ ccversion='', gccversion='4.2.1 Compatible Apple LLVM 5.0 (clang-500.0.68)', gccosandvers=''
+ intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
+ ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
+ alignbytes=8, prototype=define
+ Linker and Libraries:
+ ld='cc -mmacosx-version-min=10.9', ldflags ='-arch x86_64 -arch i386 -fstack-protector -L/usr/local/lib'
+ libpth=/usr/local/lib /usr/lib
+ libs=
+ perllibs=
+ libc=, so=dylib, useshrplib=true, libperl=libperl.dylib
+ gnulibc_version=''
+ Dynamic Linking:
+ dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
+ cccdlflags=' ', lddlflags='-arch x86_64 -arch i386 -bundle -undefined dynamic_lookup -L/usr/local/lib -fstack-protector'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: HAS_TIMES MULTIPLICITY PERLIO_LAYERS
+ PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT
+ PERL_MALLOC_WRAP PERL_PRESERVE_IVUV USE_64_BIT_ALL
+ USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES
+ USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE
+ USE_LOCALE_NUMERIC USE_PERLIO USE_PERL_ATOF
+ USE_REENTRANT_API
+ Locally applied patches:
+ /Library/Perl/Updates/<version> comes before system perl directories
+ installprivlib and installarchlib points to the Updates directory
+ CVE-2013-1667 hashtable DOS fix
+ Built under darwin
+ Compiled at Aug 25 2013 01:24:40
+ %ENV:
+ PERL5LIB=""
+ PERL5OPT=""
+ PERL5_CPANPLUS_IS_RUNNING="37393"
+ PERL5_CPAN_IS_RUNNING="37393"
+ @INC:
+ /Library/Perl/5.16/darwin-thread-multi-2level
+ /Library/Perl/5.16
+ /Network/Library/Perl/5.16/darwin-thread-multi-2level
+ /Network/Library/Perl/5.16
+ /Library/Perl/Updates/5.16.2/darwin-thread-multi-2level
+ /Library/Perl/Updates/5.16.2
+ /System/Library/Perl/5.16/darwin-thread-multi-2level
+ /System/Library/Perl/5.16
+ /System/Library/Perl/Extras/5.16/darwin-thread-multi-2level
+ /System/Library/Perl/Extras/5.16
+ .
+
BEGIN {
use Test::More;
- my $tests = 35;
+ my $tests = 111;
unless ($ENV{PERL_CORE}) {
require Test::NoWarnings;
Test::NoWarnings->import ();
ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
-is ($conf->{build}{stamp}, 0, "No build time known");
+is ($conf->{build}{stamp}, "May 18 2013 17:34:20", "Build time");
is ($conf->{config}{version}, "5.18.0", "reconstructed \$Config{version}");
-# Some random checks
-is ($conf->{build}{options}{$_}, 0, "Runtime option $_") for qw(
- DEBUG_LEAKING_SCALARS NO_HASH_SEED PERL_MEM_LOG_STDERR PERL_MEM_LOG_ENV
- PERL_MEM_LOG_TIMESTAMP PERL_MICRO USE_ATTRIBUTES_FOR_PERLIO VMS_DO_SOCKETS );
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ HAS_TIMES PERLIO_LAYERS PERL_DONT_CREATE_GVSV
+ PERL_HASH_FUNC_ONE_AT_A_TIME_HARD PERL_MALLOC_WRAP
+ PERL_PRESERVE_IVUV PERL_SAWAMPERSAND USE_64_BIT_INT
+ USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
+ USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LONG_DOUBLE
+ USE_PERLIO USE_PERL_ATOF
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+is_deeply ($conf->{build}{patches}, [], "No local patches");
my %check = (
alignbytes => 4,
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 111;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "Jan 9 2014 09:22:04", "Build time");
+is ($conf->{config}{version}, "5.18.2", "reconstructed \$Config{version}");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ HAS_TIMES PERLIO_LAYERS PERL_DONT_CREATE_GVSV
+ PERL_HASH_FUNC_ONE_AT_A_TIME_HARD PERL_MALLOC_WRAP
+ PERL_PRESERVE_IVUV PERL_SAWAMPERSAND USE_64_BIT_INT
+ USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
+ USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LONG_DOUBLE
+ USE_PERLIO USE_PERL_ATOF
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+is_deeply ($conf->{build}{patches}, [], "No local patches");
+
+my %check = (
+ alignbytes => 4,
+ api_version => 18,
+ bincompat5005 => "undef",
+ byteorder => 12345678,
+ cc => "cc",
+ cccdlflags => "-fPIC",
+ ccdlflags => "-Wl,-E",
+ config_args => "-Duse64bitint -Duselongdouble -des",
+ gccversion => "4.8.1 20130909 [gcc-4_8-branch revision 202388]",
+ gnulibc_version => "2.18",
+ ivsize => 8,
+ ivtype => "long long",
+ ld => "cc",
+ lddlflags => "-shared -O2 -L/pro/local/lib -fstack-protector",
+ ldflags => "-L/pro/local/lib -fstack-protector",
+ libc => "/lib/libc-2.18.so",
+ lseektype => "off_t",
+ osvers => "3.11.6-4-desktop",
+ use64bitint => "define",
+ );
+is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check;
+
+__END__
+Summary of my perl5 (revision 5 version 18 subversion 2) configuration:
+
+ Platform:
+ osname=linux, osvers=3.11.6-4-desktop, archname=i686-linux-64int-ld
+ uname='linux lx09 3.11.6-4-desktop #1 smp preempt wed oct 30 18:04:56 utc 2013 (e6d4a27) i686 i686 i386 gnulinux '
+ config_args='-Duse64bitint -Duselongdouble -des'
+ hint=recommended, useposix=true, d_sigaction=define
+ useithreads=undef, usemultiplicity=undef
+ useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
+ use64bitint=define, use64bitall=undef, uselongdouble=define
+ usemymalloc=n, bincompat5005=undef
+ Compiler:
+ cc='cc', ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
+ optimize='-O2',
+ cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/pro/local/include'
+ ccversion='', gccversion='4.8.1 20130909 [gcc-4_8-branch revision 202388]', gccosandvers=''
+ intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
+ ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8
+ alignbytes=4, prototype=define
+ Linker and Libraries:
+ ld='cc', ldflags ='-L/pro/local/lib -fstack-protector'
+ libpth=/pro/local/lib /lib /usr/lib /usr/local/lib
+ libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
+ perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
+ libc=/lib/libc-2.18.so, so=so, useshrplib=false, libperl=libperl.a
+ gnulibc_version='2.18'
+ Dynamic Linking:
+ dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
+ cccdlflags='-fPIC', lddlflags='-shared -O2 -L/pro/local/lib -fstack-protector'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: HAS_TIMES PERLIO_LAYERS PERL_DONT_CREATE_GVSV
+ PERL_HASH_FUNC_ONE_AT_A_TIME_HARD PERL_MALLOC_WRAP
+ PERL_PRESERVE_IVUV PERL_SAWAMPERSAND USE_64_BIT_INT
+ USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
+ USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LONG_DOUBLE
+ USE_PERLIO USE_PERL_ATOF
+ Built under linux
+ Compiled at Jan 9 2014 09:22:04
+ @INC:
+ /pro/lib/perl5/site_perl/5.18.2/i686-linux-64int-ld
+ /pro/lib/perl5/site_perl/5.18.2
+ /pro/lib/perl5/5.18.2/i686-linux-64int-ld
+ /pro/lib/perl5/5.18.2
+ .
--- /dev/null
+#!/pro/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+ use Test::More;
+ my $tests = 111;
+ unless ($ENV{PERL_CORE}) {
+ require Test::NoWarnings;
+ Test::NoWarnings->import ();
+ $tests++;
+ }
+
+ plan tests => $tests;
+ }
+
+use Config::Perl::V;
+
+ok (my $conf = Config::Perl::V::plv2hash (<DATA>), "Read perl -v block");
+ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc );
+
+is ($conf->{build}{osname}, $conf->{config}{osname}, "osname");
+is ($conf->{build}{stamp}, "Jun 30 2014 15:37:09", "Build time");
+is ($conf->{config}{version}, "5.20.0", "reconstructed \$Config{version}");
+
+my $opt = Config::Perl::V::plv2hash ("")->{build}{options};
+foreach my $o (sort qw(
+ HAS_TIMES MULTIPLICITY PERLIO_LAYERS
+ PERL_DONT_CREATE_GVSV
+ PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
+ PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP
+ PERL_NEW_COPY_ON_WRITE PERL_PRESERVE_IVUV
+ PERL_USE_DEVEL USE_64_BIT_INT USE_ITHREADS
+ USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
+ USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LONG_DOUBLE
+ USE_PERLIO USE_PERL_ATOF USE_REENTRANT_API
+ )) {
+ is ($conf->{build}{options}{$o}, 1, "Runtime option $o set");
+ delete $opt->{$o};
+ }
+foreach my $o (sort keys %$opt) {
+ is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset");
+ }
+
+is_deeply ($conf->{build}{patches}, [], "No local patches");
+
+my %check = (
+ alignbytes => 4,
+ api_version => 20,
+ bincompat5005 => "undef",
+ byteorder => 12345678,
+ cc => "cc",
+ cccdlflags => "-fPIC",
+ ccdlflags => "-Wl,-E",
+ config_args => "-Dusedevel -Uversiononly -Dinc_version_list=none -Duse64bitint -Dusethreads -Duseithreads -Duselongdouble -des",
+ gccversion => "4.8.1 20130909 [gcc-4_8-branch revision 202388]",
+ gnulibc_version => "2.18",
+ ivsize => 8,
+ ivtype => "long long",
+ ld => "cc",
+ lddlflags => "-shared -O2 -L/pro/local/lib -fstack-protector",
+ ldflags => "-L/pro/local/lib -fstack-protector",
+ libc => "libc-2.18.so",
+ lseektype => "off_t",
+ osvers => "3.11.10-17-desktop",
+ use64bitint => "define",
+ );
+is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check;
+
+__END__
+Summary of my perl5 (revision 5 version 20 subversion 0) configuration:
+
+ Platform:
+ osname=linux, osvers=3.11.10-17-desktop, archname=i686-linux-thread-multi-64int-ld
+ uname='linux lx09 3.11.10-17-desktop #1 smp preempt mon jun 16 15:28:13 utc 2014 (fba7c1f) i686 i686 i386 gnulinux '
+ config_args='-Dusedevel -Uversiononly -Dinc_version_list=none -Duse64bitint -Dusethreads -Duseithreads -Duselongdouble -des'
+ hint=recommended, useposix=true, d_sigaction=define
+ useithreads=define, usemultiplicity=define
+ use64bitint=define, use64bitall=undef, uselongdouble=define
+ usemymalloc=n, bincompat5005=undef
+ Compiler:
+ cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
+ optimize='-O2',
+ cppflags='-D_REENTRANT -D_GNU_SOURCE -fwrapv -fno-strict-aliasing -pipe -fstack-protector -I/pro/local/include'
+ ccversion='', gccversion='4.8.1 20130909 [gcc-4_8-branch revision 202388]', gccosandvers=''
+ intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
+ d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
+ ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, Off_t='off_t', lseeksize=8
+ alignbytes=4, prototype=define
+ Linker and Libraries:
+ ld='cc', ldflags ='-L/pro/local/lib -fstack-protector'
+ libpth=/usr/local/lib /usr/lib/gcc/i586-suse-linux/4.8/include-fixed /usr/lib/gcc/i586-suse-linux/4.8/../../../../i586-suse-linux/lib /usr/lib /pro/local/lib /lib
+ libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc -lgdbm_compat
+ perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
+ libc=libc-2.18.so, so=so, useshrplib=false, libperl=libperl.a
+ gnulibc_version='2.18'
+ Dynamic Linking:
+ dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
+ cccdlflags='-fPIC', lddlflags='-shared -O2 -L/pro/local/lib -fstack-protector'
+
+
+Characteristics of this binary (from libperl):
+ Compile-time options: HAS_TIMES MULTIPLICITY PERLIO_LAYERS
+ PERL_DONT_CREATE_GVSV
+ PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
+ PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP
+ PERL_NEW_COPY_ON_WRITE PERL_PRESERVE_IVUV
+ PERL_USE_DEVEL USE_64_BIT_INT USE_ITHREADS
+ USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
+ USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LONG_DOUBLE
+ USE_PERLIO USE_PERL_ATOF USE_REENTRANT_API
+ Built under linux
+ Compiled at Jun 30 2014 15:37:09
+ @INC:
+ /pro/lib/perl5/site_perl/5.20.0/i686-linux-thread-multi-64int-ld
+ /pro/lib/perl5/site_perl/5.20.0
+ /pro/lib/perl5/5.20.0/i686-linux-thread-multi-64int-ld
+ /pro/lib/perl5/5.20.0
+ .
use strict;
use warnings;
-use Exporter 5.57 'import';
-
-our $VERSION = '1.64';
+our $VERSION = '1.65';
+our @ISA = ('Exporter');
our @EXPORT_OK = qw(mkmanifest
manicheck filecheck fullcheck skipcheck
manifind maniread manicopy maniadd
$bakbase =~ s/\./_/g if $Is_VMS_nodot; # avoid double dots
rename $MANIFEST, "$bakbase.bak" unless $manimiss;
open M, "> $MANIFEST" or die "Could not open $MANIFEST: $!";
+ binmode M, ':raw';
my $skip = maniskip();
my $found = manifind();
my($key,$val,$file,%all);
warn "Problem opening $mfile: $!";
return;
}
+ binmode M, ':raw';
print M $_ for (@lines);
close M;
return;
open(MANIFEST, ">>$MANIFEST") or
die "maniadd() could not open $MANIFEST: $!";
+ binmode MANIFEST, ':raw';
foreach my $file (_sort @needed) {
my $comment = $additions->{$file} || '';
if ( $must_rewrite ) {
1 while unlink $MANIFEST; # avoid multiple versions on VMS
open MANIFEST, ">", $MANIFEST or die "(must_rewrite=$must_rewrite) Could not open >$MANIFEST: $!";
+ binmode MANIFEST, ':raw';
for (my $i=0; $i<=$#manifest; $i+=2) {
print MANIFEST "$manifest[$i]\n";
}
use strict;
-use Test::More tests => 96;
+use Test::More tests => 97;
use Cwd;
use File::Spec;
$file =~ s/ /^_/g if $Is_VMS_noefs; # escape spaces
1 while unlink $file; # or else we'll get multiple versions on VMS
open( T, '> '.$file) or return;
+ binmode T, ':raw'; # no CRLFs please
print T $data;
close T;
return 0 unless -e $file; # exists under the name we gave it ?
is( $files->{yarrow}, 'hock',' with comment' );
is( $files->{foobar}, '', ' preserved old entries' );
+my $manicontents = do {
+ local $/;
+ open my $fh, "MANIFEST" or die;
+ binmode $fh, ':raw';
+ <$fh>
+};
+is index($manicontents, "\015\012"), -1, 'MANIFEST no CRLF';
+
{
# EOL normalization in maniadd()
use strict;
use warnings;
# ABSTRACT: A small, simple, correct HTTP/1.1 client
-our $VERSION = '0.043'; # VERSION
+our $VERSION = '0.047'; # VERSION
use Carp ();
-# =method new
-#
-# $http = HTTP::Tiny->new( %attributes );
-#
-# This constructor returns a new HTTP::Tiny object. Valid attributes include:
-#
-# =for :list
-# * C<agent>
-# A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended.
-# * C<cookie_jar>
-# An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods
-# * C<default_headers>
-# A hashref of default headers to apply to requests
-# * C<local_address>
-# The local IP address to bind to
-# * C<keep_alive>
-# Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
-# * C<max_redirect>
-# Maximum number of redirects allowed (defaults to 5)
-# * C<max_size>
-# Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception.
-# * C<http_proxy>
-# URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set)
-# * C<https_proxy>
-# URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set)
-# * C<proxy>
-# URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set)
-# * C<no_proxy>
-# List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}>)
-# * C<timeout>
-# Request timeout in seconds (default is 60)
-# * C<verify_SSL>
-# A boolean that indicates whether to validate the SSL certificate of an C<https>
-# connection (default is false)
-# * C<SSL_options>
-# A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
-#
-# Exceptions from C<max_size>, C<timeout> or other errors will result in a
-# pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
-# content field in the response will contain the text of the exception.
-#
-# The C<keep_alive> parameter enables a persistent connection, but only to a
-# single destination scheme, host and port. Also, if any connection-relevant
-# attributes are modified, a persistent connection will be dropped. If you want
-# persistent connections across multiple destinations, use multiple HTTP::Tiny
-# objects.
-#
-# See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
-#
-# =cut
+#pod =method new
+#pod
+#pod $http = HTTP::Tiny->new( %attributes );
+#pod
+#pod This constructor returns a new HTTP::Tiny object. Valid attributes include:
+#pod
+#pod =for :list
+#pod * C<agent> —
+#pod A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended.
+#pod * C<cookie_jar> —
+#pod An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods
+#pod * C<default_headers> —
+#pod A hashref of default headers to apply to requests
+#pod * C<local_address> —
+#pod The local IP address to bind to
+#pod * C<keep_alive> —
+#pod Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
+#pod * C<max_redirect> —
+#pod Maximum number of redirects allowed (defaults to 5)
+#pod * C<max_size> —
+#pod Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception.
+#pod * C<http_proxy> —
+#pod URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set)
+#pod * C<https_proxy> —
+#pod URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set)
+#pod * C<proxy> —
+#pod URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set)
+#pod * C<no_proxy> —
+#pod List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —)
+#pod * C<timeout> —
+#pod Request timeout in seconds (default is 60)
+#pod * C<verify_SSL> —
+#pod A boolean that indicates whether to validate the SSL certificate of an C<https> —
+#pod connection (default is false)
+#pod * C<SSL_options> —
+#pod A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>
+#pod
+#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
+#pod prevent getting the corresponding proxies from the environment.
+#pod
+#pod Exceptions from C<max_size>, C<timeout> or other errors will result in a
+#pod pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
+#pod content field in the response will contain the text of the exception.
+#pod
+#pod The C<keep_alive> parameter enables a persistent connection, but only to a
+#pod single destination scheme, host and port. Also, if any connection-relevant
+#pod attributes are modified, a persistent connection will be dropped. If you want
+#pod persistent connections across multiple destinations, use multiple HTTP::Tiny
+#pod objects.
+#pod
+#pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
+#pod
+#pod =cut
my @attributes;
BEGIN {
sub _set_proxies {
my ($self) = @_;
- if (! $self->{proxy} ) {
+ # get proxies from %ENV only if not provided; explicit undef will disable
+ # getting proxies from the environment
+
+ # generic proxy
+ if (! exists $self->{proxy} ) {
$self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
- if ( defined $self->{proxy} ) {
- $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
- }
- else {
- delete $self->{proxy};
- }
}
- if (! $self->{http_proxy} ) {
+ if ( defined $self->{proxy} ) {
+ $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
+ }
+ else {
+ delete $self->{proxy};
+ }
+
+ # http proxy
+ if (! exists $self->{http_proxy} ) {
$self->{http_proxy} = $ENV{http_proxy} || $self->{proxy};
- if ( defined $self->{http_proxy} ) {
- $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
- $self->{_has_proxy}{http} = 1;
- }
- else {
- delete $self->{http_proxy};
- }
}
- if (! $self->{https_proxy} ) {
+ if ( defined $self->{http_proxy} ) {
+ $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
+ $self->{_has_proxy}{http} = 1;
+ }
+ else {
+ delete $self->{http_proxy};
+ }
+
+ # https proxy
+ if (! exists $self->{https_proxy} ) {
$self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
- if ( $self->{https_proxy} ) {
- $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
- $self->{_has_proxy}{https} = 1;
- }
- else {
- delete $self->{https_proxy};
- }
+ }
+
+ if ( $self->{https_proxy} ) {
+ $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
+ $self->{_has_proxy}{https} = 1;
+ }
+ else {
+ delete $self->{https_proxy};
}
# Split no_proxy to array reference if not provided as such
return;
}
-# =method get|head|put|post|delete
-#
-# $response = $http->get($url);
-# $response = $http->get($url, \%options);
-# $response = $http->head($url);
-#
-# These methods are shorthand for calling C<request()> for the given method. The
-# URL must have unsafe characters escaped and international domain names encoded.
-# See C<request()> for valid options and a description of the response.
-#
-# The C<success> field of the response will be true if the status code is 2XX.
-#
-# =cut
+#pod =method get|head|put|post|delete
+#pod
+#pod $response = $http->get($url);
+#pod $response = $http->get($url, \%options);
+#pod $response = $http->head($url);
+#pod
+#pod These methods are shorthand for calling C<request()> for the given method. The
+#pod URL must have unsafe characters escaped and international domain names encoded.
+#pod See C<request()> for valid options and a description of the response.
+#pod
+#pod The C<success> field of the response will be true if the status code is 2XX.
+#pod
+#pod =cut
for my $sub_name ( qw/get head put post delete/ ) {
my $req_method = uc $sub_name;
HERE
}
-# =method post_form
-#
-# $response = $http->post_form($url, $form_data);
-# $response = $http->post_form($url, $form_data, \%options);
-#
-# This method executes a C<POST> request and sends the key/value pairs from a
-# form data hash or array reference to the given URL with a C<content-type> of
-# C<application/x-www-form-urlencoded>. If data is provided as an array
-# reference, the order is preserved; if provided as a hash reference, the terms
-# are sorted on key and value for consistency. See documentation for the
-# C<www_form_urlencode> method for details on the encoding.
-#
-# The URL must have unsafe characters escaped and international domain names
-# encoded. See C<request()> for valid options and a description of the response.
-# Any C<content-type> header or content in the options hashref will be ignored.
-#
-# The C<success> field of the response will be true if the status code is 2XX.
-#
-# =cut
+#pod =method post_form
+#pod
+#pod $response = $http->post_form($url, $form_data);
+#pod $response = $http->post_form($url, $form_data, \%options);
+#pod
+#
pod This method executes a C<POST> request and sends the key/value pairs from a
+#pod form data hash or array reference to the given URL with a C<content-type> of
+#
pod C<application/x-www-form-urlencoded>. If data is provided as an array
+#pod reference, the order is preserved; if provided as a hash reference, the terms
+#pod are sorted on key and value for consistency. See documentation for the
+#pod C<www_form_urlencode> method for details on the encoding.
+#pod
+#pod The URL must have unsafe characters escaped and international domain names
+#pod encoded. See C<request()> for valid options and a description of the response.
+#pod Any C<content-type> header or content in the options hashref will be ignored.
+#pod
+#pod The C<success> field of the response will be true if the status code is 2XX.
+#pod
+#pod =cut
sub post_form {
my ($self, $url, $data, $args) = @_;
);
}
-# =method mirror
-#
-# $response = $http->mirror($url, $file, \%options)
-# if ( $response->{success} ) {
-# print "$file is up to date\n";
-# }
-#
-# Executes a C<GET> request for the URL and saves the response body to the file
-# name provided. The URL must have unsafe characters escaped and international
-# domain names encoded. If the file already exists, the request will include an
-# C<If-Modified-Since> header with the modification timestamp of the file. You
-# may specify a different C<If-Modified-Since> header yourself in the C<<
-# $options->{headers} >> hash.
-#
-# The C<success> field of the response will be true if the status code is 2XX
-# or if the status code is 304 (unmodified).
-#
-# If the file was modified and the server response includes a properly
-# formatted C<Last-Modified> header, the file modification time will
-# be updated accordingly.
-#
-# =cut
+#pod =method mirror
+#pod
+#pod $response = $http->mirror($url, $file, \%options)
+#pod if ( $response->{success} ) {
+#pod print "$file is up to date\n";
+#pod }
+#pod
+#pod Executes a C<GET> request for the URL and saves the response body to the file
+#pod name provided. The URL must have unsafe characters escaped and international
+#pod domain names encoded. If the file already exists, the request will include an
+#pod C<If-Modified-Since> header with the modification timestamp of the file. You
+#pod may specify a different C<If-Modified-Since> header yourself in the C<<
+#pod $options->{headers} >> hash.
+#pod
+#pod The C<success> field of the response will be true if the status code is 2XX
+#pod or if the status code is 304 (unmodified).
+#pod
+#pod If the file was modified and the server response includes a properly
+#pod formatted C<Last-Modified> header, the file modification time will
+#pod be updated accordingly.
+#pod
+#pod =cut
sub mirror {
my ($self, $url, $file, $args) = @_;
return $response;
}
-# =method request
-#
-# $response = $http->request($method, $url);
-# $response = $http->request($method, $url, \%options);
-#
-# Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
-# 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and
-# international domain names encoded.
-#
-# If the URL includes a "user:password" stanza, they will be used for Basic-style
-# authorization headers. (Authorization headers will not be included in a
-# redirected request.) For example:
-#
-# $http->request('GET', 'http://Aladdin:open sesame@example.com/');
-#
-# If the "user:password" stanza contains reserved characters, they must
-# be percent-escaped:
-#
-# $http->request('GET', 'http://john%40example.com:password@example.com/');
-#
-# A hashref of options may be appended to modify the request.
-#
-# Valid options are:
-#
-# =for :list
-# * C<headers>
-# A hashref containing headers to include with the request. If the value for
-# a header is an array reference, the header will be output multiple times with
-# each value in the array. These headers over-write any default headers.
-# * C<content>
-# A scalar to include as the body of the request OR a code reference
-# that will be called iteratively to produce the body of the request
-# * C<trailer_callback>
-# A code reference that will be called if it exists to provide a hashref
-# of trailing headers (only used with chunked transfer-encoding)
-# * C<data_callback>
-# A code reference that will be called for each chunks of the response
-# body received.
-#
-# If the C<content> option is a code reference, it will be called iteratively
-# to provide the content body of the request. It should return the empty
-# string or undef when the iterator is exhausted.
-#
-# If the C<content> option is the empty string, no C<content-type> or
-# C<content-length> headers will be generated.
-#
-# If the C<data_callback> option is provided, it will be called iteratively until
-# the entire response body is received. The first argument will be a string
-# containing a chunk of the response body, the second argument will be the
-# in-progress response hash reference, as described below. (This allows
-# customizing the action of the callback based on the C<status> or C<headers>
-# received prior to the content body.)
-#
-# The C<request> method returns a hashref containing the response. The hashref
-# will have the following keys:
-#
-# =for :list
-# * C<success>
-# Boolean indicating whether the operation returned a 2XX status code
-# * C<url>
-# URL that provided the response. This is the URL of the request unless
-# there were redirections, in which case it is the last URL queried
-# in a redirection chain
-# * C<status>
-# The HTTP status code of the response
-# * C<reason>
-# The response phrase returned by the server
-# * C<content>
-# The body of the response. If the response does not have any content
-# or if a data callback is provided to consume the response body,
-# this will be the empty string
-# * C<headers>
-# A hashref of header fields. All header field names will be normalized
-# to be lower case. If a header is repeated, the value will be an arrayref;
-# it will otherwise be a scalar string containing the value
-#
-# On an exception during the execution of the request, the C<status> field will
-# contain 599, and the C<content> field will contain the text of the exception.
-#
-# =cut
+#pod =method request
+#pod
+#pod $response = $http->request($method, $url);
+#pod $response = $http->request($method, $url, \%options);
+#pod
+#pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
+#pod 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and
+#pod international domain names encoded.
+#pod
+#pod If the URL includes a "user:password" stanza, they will be used for Basic-style
+#pod authorization headers. (Authorization headers will not be included in a
+#pod redirected request.) For example:
+#pod
+#pod $http->request('GET', 'http://Aladdin:open sesame@example.com/');
+#pod
+#pod If the "user:password" stanza contains reserved characters, they must
+#pod be percent-escaped:
+#pod
+#pod $http->request('GET', 'http://john%40example.com:password@example.com/');
+#pod
+#pod A hashref of options may be appended to modify the request.
+#pod
+#pod Valid options are:
+#pod
+#pod =for :list
+#pod * C<headers> —
+#pod A hashref containing headers to include with the request. If the value for
+#pod a header is an array reference, the header will be output multiple times with
+#pod each value in the array. These headers over-write any default headers.
+#pod * C<content> —
+#pod A scalar to include as the body of the request OR a code reference
+#pod that will be called iteratively to produce the body of the request
+#pod * C<trailer_callback> —
+#pod A code reference that will be called if it exists to provide a hashref
+#pod of trailing headers (only used with chunked transfer-encoding)
+#pod * C<data_callback> —
+#pod A code reference that will be called for each chunks of the response
+#pod body received.
+#pod
+#pod The C<Host> header is generated from the URL in accordance with RFC 2616. It
+#pod is a fatal error to specify C<Host> in the C<headers> option. Other headers
+#pod may be ignored or overwritten if necessary for transport compliance.
+#pod
+#pod If the C<content> option is a code reference, it will be called iteratively
+#pod to provide the content body of the request. It should return the empty
+#pod string or undef when the iterator is exhausted.
+#pod
+#pod If the C<content> option is the empty string, no C<content-type> or
+#pod C<content-length> headers will be generated.
+#pod
+#pod If the C<data_callback> option is provided, it will be called iteratively until
+#pod the entire response body is received. The first argument will be a string
+#pod containing a chunk of the response body, the second argument will be the
+#pod in-progress response hash reference, as described below. (This allows
+#pod customizing the action of the callback based on the C<status> or C<headers>
+#pod received prior to the content body.)
+#pod
+#pod The C<request> method returns a hashref containing the response. The hashref
+#pod will have the following keys:
+#pod
+#pod =for :list
+#pod * C<success> —
+#pod Boolean indicating whether the operation returned a 2XX status code
+#pod * C<url> —
+#pod URL that provided the response. This is the URL of the request unless
+#pod there were redirections, in which case it is the last URL queried
+#pod in a redirection chain
+#pod * C<status> —
+#pod The HTTP status code of the response
+#pod * C<reason> —
+#pod The response phrase returned by the server
+#pod * C<content> —
+#pod The body of the response. If the response does not have any content
+#pod or if a data callback is provided to consume the response body,
+#pod this will be the empty string
+#pod * C<headers> —
+#pod A hashref of header fields. All header field names will be normalized
+#pod to be lower case. If a header is repeated, the value will be an arrayref;
+#pod it will otherwise be a scalar string containing the value
+#pod
+#pod On an exception during the execution of the request, the C<status> field will
+#pod contain 599, and the C<content> field will contain the text of the exception.
+#pod
+#pod =cut
my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
return $response;
}
-# =method www_form_urlencode
-#
-# $params = $http->www_form_urlencode( $data );
-# $response = $http->get("http://example.com/query?$params");
-#
-# This method converts the key/value pairs from a data hash or array reference
-# into a C<x-www-form-urlencoded> string. The keys and values from the data
-# reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
-# array reference, the key will be repeated with each of the values of the array
-# reference. If data is provided as a hash reference, the key/value pairs in the
-# resulting string will be sorted by key and value for consistent ordering.
-#
-# =cut
+#pod =method www_form_urlencode
+#pod
+#pod $params = $http->www_form_urlencode( $data );
+#pod $response = $http->get("http://example.com/query?$params");
+#pod
+#pod This method converts the key/value pairs from a data hash or array reference
+#pod into a C<x-www-form-urlencoded> string. The keys and values from the data
+#pod reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
+#pod array reference, the key will be repeated with each of the values of the array
+#pod reference. If data is provided as a hash reference, the key/value pairs in the
+#pod resulting string will be sorted by key and value for consistent ordering.
+#pod
+#pod =cut
sub www_form_urlencode {
my ($self, $data) = @_;
$request->{headers}{lc $k} = $v;
}
}
+
+ if (exists $request->{headers}{'host'}) {
+ die(qq/The 'Host' header must not be provided as header option\n/);
+ }
+
$request->{headers}{'host'} = $request->{host_port};
$request->{headers}{'user-agent'} ||= $self->{agent};
$request->{headers}{'connection'} = "close"
my $url = pop;
# URI regex adapted from the URI module
- my ($scheme, $authority, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
+ my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
or die(qq/Cannot parse URL: '$url'\n/);
$scheme = lc $scheme;
$path_query = "/$path_query" unless $path_query =~ m<\A/>;
- my ($auth,$host);
- $authority = (length($authority)) ? $authority : 'localhost';
- if ( $authority =~ /@/ ) {
- ($auth,$host) = $authority =~ m/\A([^@]*)@(.*)\z/; # user:pass@host
+ my $auth = '';
+ if ( (my $i = index $host, '@') != -1 ) {
+ # user:pass@host
+ $auth = substr $host, 0, $i, ''; # take up to the @ for auth
+ substr $host, 0, 1, ''; # knock the @ off the host
+
# userinfo might be percent escaped, so recover real auth info
$auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
}
- else {
- $host = $authority;
- $auth = '';
- }
- $host = lc $host;
- my $port = do {
- $host =~ s/:([0-9]*)\z// && length $1
- ? $1
- : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef);
- };
+ my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
+ : $scheme eq 'http' ? 80
+ : $scheme eq 'https' ? 443
+ : undef;
- return ($scheme, $host, $port, $path_query, $auth);
+ return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
}
# Date conversions adapted from HTTP::Date
$HeaderCase{lc $field_name} = $field_name;
}
for (ref $v eq 'ARRAY' ? @$v : $v) {
- /[^\x0D\x0A]/
- or die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n");
+ $_ = '' unless defined $_;
$buf .= "$field_name: $_\x0D\x0A";
}
}
=head1 VERSION
-version 0.043
+version 0.047
=head1 SYNOPSIS
=item *
-C<agent>
-
-A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended.
+C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended.
=item *
-C<cookie_jar>
-
-An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods
+C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods
=item *
-C<default_headers>
-
-A hashref of default headers to apply to requests
+C<default_headers> — A hashref of default headers to apply to requests
=item *
-C<local_address>
-
-The local IP address to bind to
+C<local_address> — The local IP address to bind to
=item *
-C<keep_alive>
-
-Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
+C<keep_alive> — Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
=item *
-C<max_redirect>
-
-Maximum number of redirects allowed (defaults to 5)
+C<max_redirect> — Maximum number of redirects allowed (defaults to 5)
=item *
-C<max_size>
-
-Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception.
+C<max_size> — Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception.
=item *
-C<http_proxy>
-
-URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set)
+C<http_proxy> — URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set)
=item *
-C<https_proxy>
-
-URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set)
+C<https_proxy> — URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set)
=item *
-C<proxy>
-
-URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set)
+C<proxy> — URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set)
=item *
-C<no_proxy>
-
-List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}>)
+C<no_proxy> — List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —)
=item *
-C<timeout>
-
-Request timeout in seconds (default is 60)
+C<timeout> — Request timeout in seconds (default is 60)
=item *
-C<verify_SSL>
-
-A boolean that indicates whether to validate the SSL certificate of an C<https>
-connection (default is false)
+C<verify_SSL> — A boolean that indicates whether to validate the SSL certificate of an C<https> — connection (default is false)
=item *
-C<SSL_options>
-
-A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
+C<SSL_options> — A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>
=back
+Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
+prevent getting the corresponding proxies from the environment.
+
Exceptions from C<max_size>, C<timeout> or other errors will result in a
pseudo-HTTP status code of 599 and a reason of "Internal Exception". The
content field in the response will contain the text of the exception.
=item *
-C<headers>
-
-A hashref containing headers to include with the request. If the value for
-a header is an array reference, the header will be output multiple times with
-each value in the array. These headers over-write any default headers.
+C<headers> — A hashref containing headers to include with the request. If the value for a header is an array reference, the header will be output multiple times with each value in the array. These headers over-write any default headers.
=item *
-C<content>
-
-A scalar to include as the body of the request OR a code reference
-that will be called iteratively to produce the body of the request
+C<content> — A scalar to include as the body of the request OR a code reference that will be called iteratively to produce the body of the request
=item *
-C<trailer_callback>
-
-A code reference that will be called if it exists to provide a hashref
-of trailing headers (only used with chunked transfer-encoding)
+C<trailer_callback> — A code reference that will be called if it exists to provide a hashref of trailing headers (only used with chunked transfer-encoding)
=item *
-C<data_callback>
-
-A code reference that will be called for each chunks of the response
-body received.
+C<data_callback> — A code reference that will be called for each chunks of the response body received.
=back
+The C<Host> header is generated from the URL in accordance with RFC 2616. It
+is a fatal error to specify C<Host> in the C<headers> option. Other headers
+may be ignored or overwritten if necessary for transport compliance.
+
If the C<content> option is a code reference, it will be called iteratively
to provide the content body of the request. It should return the empty
string or undef when the iterator is exhausted.
=item *
-C<success>
-
-Boolean indicating whether the operation returned a 2XX status code
+C<success> — Boolean indicating whether the operation returned a 2XX status code
=item *
-C<url>
-
-URL that provided the response. This is the URL of the request unless
-there were redirections, in which case it is the last URL queried
-in a redirection chain
+C<url> — URL that provided the response. This is the URL of the request unless there were redirections, in which case it is the last URL queried in a redirection chain
=item *
-C<status>
-
-The HTTP status code of the response
+C<status> — The HTTP status code of the response
=item *
-C<reason>
-
-The response phrase returned by the server
+C<reason> — The response phrase returned by the server
=item *
-C<content>
-
-The body of the response. If the response does not have any content
-or if a data callback is provided to consume the response body,
-this will be the empty string
+C<content> — The body of the response. If the response does not have any content or if a data callback is provided to consume the response body, this will be the empty string
=item *
-C<headers>
-
-A hashref of header fields. All header field names will be normalized
-to be lower case. If a header is repeated, the value will be an arrayref;
-it will otherwise be a scalar string containing the value
+C<headers> — A hashref of header fields. All header field names will be normalized to be lower case. If a header is repeated, the value will be an arrayref; it will otherwise be a scalar string containing the value
=back
Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
-thrown if a new enough versions of these modules not installed or if the SSL
+thrown if new enough versions of these modules are not installed or if the SSL
encryption fails. An C<https> connection may be made via an C<http> proxy that
supports the CONNECT command (i.e. RFC 2817). You may not proxy C<https> via
a proxy that itself requires C<https> to communicate.
=head1 LIMITATIONS
HTTP::Tiny is I<conditionally compliant> with the
-L<HTTP/1.1 specification|http://www.w3.org/Protocols/rfc2616/rfc2616.html>.
+L<HTTP/1.1 specifications|http://www.w3.org/Protocols/>:
+
+=over 4
+
+=item *
+
+"Message Syntax and Routing" [RFC7230]
+
+=item *
+
+"Semantics and Content" [RFC7231]
+
+=item *
+
+"Conditional Requests" [RFC7232]
+
+=item *
+
+"Range Requests" [RFC7233]
+
+=item *
+
+"Caching" [RFC7234]
+
+=item *
+
+"Authentication" [RFC7235]
+
+=back
+
It attempts to meet all "MUST" requirements of the specification, but does not
-implement all "SHOULD" requirements.
+implement all "SHOULD" requirements. (Note: it was developed against the
+earlier RFC 2616 specification and may not yet meet the revised RFC 7230-7235
+spec.)
Some particular limitations of note include:
=item *
-Chris Weyl <cweyl@alumni.drew.edu>
+Chris Weyl <rsrchboy@cpan.org>
=item *
=item *
+James Raspass <jraspass@gmail.com>
+
+=item *
+
Jess Robinson <castaway@desert-island.me.uk>
=item *
=item *
+Sören Kornetzki <soeren.kornetzki@delti.com>
+
+=item *
+
Tony Cook <tony@develop-help.com>
=back
use warnings;
use Test::More;
+use t::Util qw[tmpfile monkey_patch set_socket_source];
+
use HTTP::Tiny;
+BEGIN { monkey_patch() }
+
my %usage = (
'get' => q/Usage: $http->get(URL, [HASHREF])/,
'mirror' => q/Usage: $http->mirror(URL, FILE, [HASHREF])/,
['request','GET','http://www.example.com/','extra', 'extra'],
);
+my $res_fh = tmpfile();
+my $req_fh = tmpfile();
+
my $http = HTTP::Tiny->new;
+set_socket_source($req_fh, $res_fh);
for my $c ( @cases ) {
my ($method, @args) = @$c;
like ($err, qr/\Q$usage{$method}\E/, join("|",@$c) );
}
+my $res = eval{ $http->get("http://www.example.com/", { headers => { host => "www.example2.com" } } ) };
+is( $res->{status}, 599, "Providing a Host header errors with 599" );
+like( $res->{content}, qr/'Host' header/, "Providing a Host header gives right error message" );
+
done_testing;
is_deeply($handle->read_header_lines, $headers, "roundtrip header lines");
}
+{
+ my $fh = tmpfile();
+ my $handle = HTTP::Tiny::Handle->new(fh => $fh);
+ my $headers = { foo => ['Foo', 'Baz'], bar => 'Bar', baz => '' };
+ $handle->write_header_lines($headers);
+ rewind($fh);
+ is_deeply($handle->read_header_lines, $headers, "roundtrip header lines");
+}
+
like($@, qr{http_proxy URL must be in format http\[s\]://\[auth\@\]<host>:<port>/});
}
+# Explicitly disable proxy
+{
+ local $ENV{all_proxy} = "http://localhost:8080";
+ local $ENV{http_proxy} = "http://localhost:8080";
+ local $ENV{https_proxy} = "http://localhost:8080";
+ my $c = HTTP::Tiny->new(
+ proxy => undef,
+ http_proxy => undef,
+ https_proxy => undef,
+ );
+ ok(!defined $c->proxy, "proxy => undef disables ENV proxy");
+ ok(!defined $c->http_proxy, "http_proxy => undef disables ENV proxy");
+ ok(!defined $c->https_proxy, "https_proxy => undef disables ENV proxy");
+}
done_testing();
use strict;
{ use 5.006001; }
-our $VERSION = '2.014';
+our $VERSION = '2.015';
=head1 NAME
# family
# Borrowed from Regexp::Common::net
-my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|1?[0-9]{1,2}/;
+my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}/;
my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
sub fake_makeerr
}
# Numeric addresses with AI_NUMERICHOST should pass (RT95758)
-{
- ( $err, @res ) = getaddrinfo( "127.0.0.1", 80, { flags => AI_NUMERICHOST } );
- ok( $err == 0, "\$err == 0 for 127.0.0.1/80/flags=AI_NUMERICHOST" ) or
- diag( "\$err is $err" );
+AI_NUMERICHOST: {
+ # Here we need a port that is open to the world. Not all places have all
+ # the ports. For example Solaris by default doesn't have http/80 in
+ # /etc/services, and that would fail. Let's try a couple of commonly open
+ # ports, and hope one of them will succeed. Conversely this means that
+ # sometimes this will fail.
+ #
+ # An alternative method would be to manually parse /etc/services and look
+ # for enabled services but that's kind of yuck, too.
+ my @port = (80, 7, 22, 25, 88, 123, 110, 389, 443, 445, 873, 2049, 3306);
+ foreach my $port ( @port ) {
+ ( $err, @res ) = getaddrinfo( "127.0.0.1", $port, { flags => AI_NUMERICHOST, socktype => SOCK_STREAM } );
+ if( $err == 0 ) {
+ ok( $err == 0, "\$err == 0 for 127.0.0.1/$port/flags=AI_NUMERICHOST" );
+ last AI_NUMERICHOST;
+ }
+ }
+ fail( "$err for 127.0.0.1/$port[-1]/flags=AI_NUMERICHOST (failed for ports @port)" );
}
# Now check that names with AI_NUMERICHOST fail
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More tests => 12;
use Socket qw(:addrinfo AF_INET pack_sockaddr_in inet_aton);
is( $host, "127.0.0.1", '$host is undef for NIx_NOSERV' );
is( $service, undef, '$service is 80 for NS, NIx_NOSERV' );
-# Probably "localhost" but we'd better ask the system to be sure
-my $expect_host = gethostbyaddr( inet_aton( "127.0.0.1" ), AF_INET );
-defined $expect_host or $expect_host = "127.0.0.1";
-
( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), NI_NUMERICSERV );
cmp_ok( $err, "==", 0, '$err == 0 for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICSERV' );
-is( $host, $expect_host, "\$host is $expect_host for NS" );
-is( $service, "80", '$service is 80 for NS' );
-
-# Probably "www" but we'd better ask the system to be sure
-my $flags = NI_NUMERICHOST;
-my $expect_service = getservbyport( 80, "tcp" );
-unless( defined $expect_service ) {
- $expect_service = "80";
- $flags |= NI_NUMERICSERV; # don't seem to have a service name
-}
+# We can't meaningfully compare '$host' with anything specific, all we can be
+# sure is it's not empty
+ok( length $host, '$host is nonzero length for NS' );
-( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), $flags );
-cmp_ok( $err, "==", 0, '$err == 0 for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICHOST[|NI_NUMERICSERV]' );
+( $err, $host, $service ) = getnameinfo( pack_sockaddr_in( 80, inet_aton( "127.0.0.1" ) ), NI_NUMERICHOST );
+cmp_ok( $err, "==", 0, '$err == 0 for {family=AF_INET,port=80,sinaddr=127.0.0.1}/NI_NUMERICHOST' );
-is( $host, "127.0.0.1", '$host is 127.0.0.1 for NH' );
-is( $service, $expect_service, "\$service is $expect_service for NH" );
+ok( length $service, '$service is nonzero length for NH' );
}
warn "Something unexpectedly hung during testing";
kill "INT", $parent or die "Kill failed: $!";
+ if( $^O eq "cygwin" ) {
+ # sometimes the above isn't enough on cygwin
+ sleep 1; # wait a little, it might have worked after all
+ system( "/bin/kill -f $parent; echo die $parent" );
+ }
exit 1;
}
}
# Assume interval timer granularity of $limit * 0.5 seconds. Too bold?
my $virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL);
-ok defined $virt && abs($virt / 0.5) - 1 < $limit;
+ok defined $virt && abs($virt / 0.5) - 1 < $limit
+ or diag "virt=" . (defined $virt ? $virt : 'undef');
note "getitimer: ", join(" ",
Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL));
Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL));
$virt = Time::HiRes::getitimer(&Time::HiRes::ITIMER_VIRTUAL);
-ok defined $virt && $virt == 0;
+note "at end, i=$i";
+is($virt, 0, "time left should be zero");
$SIG{VTALRM} = 'DEFAULT';
package perlfaq;
-{
- $perlfaq::VERSION = '5.0150044';
-}
-
+$perlfaq::VERSION = '5.0150045';
0; # not is it supposed to be loaded
have an even number as the minor release (i.e. perl5.18.x, where 18 is the
minor release). The experimental versions may include features that
don't make it into the stable versions, and have an odd number as the
-minor release (i.e. perl5.19.x, where 9 is the minor release).
+minor release (i.e. perl5.19.x, where 19 is the minor release).
=back
BEGIN {
use Fcntl;
- my $temp_dir = -d '/tmp' ? '/tmp' : $ENV{TMPDIR} || $ENV{TEMP};
- my $base_name = sprintf "%s/%d-%d-0000", $temp_dir, $$, time;
+ use File::Spec;
+ my $temp_dir = File::Spec->tmpdir();
+ my $file_base = sprintf "%d-%d-0000", $$, time;
+ my $base_name = File::Spec->catfile($temp_dir, $file_base);
sub temp_file {
my $fh;
If you can not reach the author for some reason contact
the PAUSE admins at modules@perl.org who may be able to help,
-but each case it treated separately.
+but each case is treated separately.
=over 4
Perl_vdeb(pTHX_ const char *pat, va_list *args)
{
#ifdef DEBUGGING
- dVAR;
const char* const file = PL_curcop ? OutCopFILE(PL_curcop) : "<null>";
const char* const display_file = file ? file : "<free>";
const long line = PL_curcop ? (long)CopLINE(PL_curcop) : 0;
Perl_debstackptrs(pTHX)
{
#ifdef DEBUGGING
- dVAR;
PerlIO_printf(Perl_debug_log,
"%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n",
PTR2UV(PL_curstack), PTR2UV(PL_stack_base),
I32 mark_min, I32 mark_max)
{
#ifdef DEBUGGING
- dVAR;
I32 i = stack_max - 30;
const I32 *markscan = PL_markstack + mark_min;
Perl_deb_stack_all(pTHX)
{
#ifdef DEBUGGING
- dVAR;
I32 si_ix;
const PERL_SI *si;
use Perl::OSType qw/os_type/;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
$VERSION = eval $VERSION;
# We only use this once - don't waste a symbol table entry on it.
use File::Temp qw(tempfile);
use vars qw($VERSION);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
# More details about C/C++ compilers:
# http://developers.sun.com/sunstudio/documentation/product/compiler.jsp
use ExtUtils::CBuilder::Base;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Base);
sub link_executable {
use ExtUtils::CBuilder::Base;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Base);
use File::Spec::Functions qw(catfile catdir);
use IO::File;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Base);
=begin comment
package ExtUtils::CBuilder::Platform::Windows::BCC;
use vars qw($VERSION);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
sub format_compiler_cmd {
my ($self, %spec) = @_;
package ExtUtils::CBuilder::Platform::Windows::GCC;
use vars qw($VERSION);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
sub format_compiler_cmd {
my ($self, %spec) = @_;
package ExtUtils::CBuilder::Platform::Windows::MSVC;
use vars qw($VERSION);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
sub arg_exec_file {
my ($self, $file) = @_;
use File::Spec;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
sub need_prelink { 1 }
package ExtUtils::CBuilder::Platform::android;
use strict;
+use Config;
use File::Spec;
use ExtUtils::CBuilder::Platform::Unix;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
# The Android linker will not recognize symbols from
$self->split_like_shell($args{extra_linker_flags}),
'-L' . $self->perl_inc(),
'-lperl',
+ $self->split_like_shell($Config{perllibs}),
];
}
use ExtUtils::CBuilder::Platform::Unix;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
# TODO: If a specific exe_file name is requested, if the exe created
use ExtUtils::CBuilder::Platform::Unix;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
sub compile {
use vars qw($VERSION @ISA);
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
sub link_executable {
my $self = shift;
use ExtUtils::CBuilder::Platform::Unix;
use vars qw($VERSION @ISA);
-$VERSION = '0.280216';
+$VERSION = '0.280217';
@ISA = qw(ExtUtils::CBuilder::Platform::Unix);
sub need_prelink { 1 }
+5.021003
+ - Prepared for v5.21.3
+
5.021002
- Prepared for v5.21.2
%bug_tracker %deprecated %delta/;
use Module::CoreList::TieHashDelta;
use version;
-$VERSION = '5.021002';
+$VERSION = '5.021003';
my $dumpinc = 0;
sub import {
5.021000 => '2014-05-27',
5.021001 => '2014-06-20',
5.021002 => '2014-07-20',
+ 5.021003 => '2014-08-20',
);
for my $version ( sort { $a <=> $b } keys %released ) {
removed => {
}
},
+ 5.021003 => {
+ delta_from => 5.021002,
+ changed => {
+ 'B::Debug' => '1.21',
+ 'CPAN::Meta' => '2.142060',
+ 'CPAN::Meta::Converter' => '2.142060',
+ 'CPAN::Meta::Feature' => '2.142060',
+ 'CPAN::Meta::History' => '2.142060',
+ 'CPAN::Meta::Merge' => '2.142060',
+ 'CPAN::Meta::Prereqs' => '2.142060',
+ 'CPAN::Meta::Requirements'=> '2.126',
+ 'CPAN::Meta::Spec' => '2.142060',
+ 'CPAN::Meta::Validator' => '2.142060',
+ 'Config' => '5.021003',
+ 'Config::Perl::V' => '0.22',
+ 'ExtUtils::CBuilder' => '0.280217',
+ 'ExtUtils::CBuilder::Base'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::Unix'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::VMS'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::Windows'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::aix'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::android'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::cygwin'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::darwin'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.280217',
+ 'ExtUtils::CBuilder::Platform::os2'=> '0.280217',
+ 'ExtUtils::Manifest' => '1.65',
+ 'HTTP::Tiny' => '0.047',
+ 'IPC::Open3' => '1.18',
+ 'Module::CoreList' => '5.021003',
+ 'Module::CoreList::TieHashDelta'=> '5.021003',
+ 'Module::CoreList::Utils'=> '5.021003',
+ 'Opcode' => '1.28',
+ 'POSIX' => '1.42',
+ 'Safe' => '2.38',
+ 'Socket' => '2.015',
+ 'Sys::Hostname' => '1.19',
+ 'UNIVERSAL' => '1.12',
+ 'XS::APItest' => '0.63',
+ 'perlfaq' => '5.0150045',
+ },
+ removed => {
+ }
+ },
);
sub is_core
removed => {
}
},
+ 5.021003 => {
+ delta_from => 5.021002,
+ changed => {
+ },
+ removed => {
+ }
+ },
);
for my $version (sort { $a <=> $b } keys %deprecated) {
'CPAN::Meta::Converter' => 'cpan',
'CPAN::Meta::Feature' => 'cpan',
'CPAN::Meta::History' => 'cpan',
+ 'CPAN::Meta::Merge' => 'cpan',
'CPAN::Meta::Prereqs' => 'cpan',
'CPAN::Meta::Requirements'=> 'cpan',
'CPAN::Meta::Spec' => 'cpan',
'Encode::TW' => 'cpan',
'Encode::Unicode' => 'cpan',
'Encode::Unicode::UTF7' => 'cpan',
+ 'ExtUtils::Command' => 'cpan',
'ExtUtils::Command::MM' => 'cpan',
'ExtUtils::Constant' => 'cpan',
'ExtUtils::Constant::Base'=> 'cpan',
'ExtUtils::Constant::ProxySubs'=> 'cpan',
'ExtUtils::Constant::Utils'=> 'cpan',
'ExtUtils::Constant::XS'=> 'cpan',
+ 'ExtUtils::Install' => 'cpan',
+ 'ExtUtils::Installed' => 'cpan',
'ExtUtils::Liblist' => 'cpan',
'ExtUtils::Liblist::Kid'=> 'cpan',
'ExtUtils::MM' => 'cpan',
'ExtUtils::MY' => 'cpan',
'ExtUtils::MakeMaker' => 'cpan',
'ExtUtils::MakeMaker::Config'=> 'cpan',
+ 'ExtUtils::Manifest' => 'cpan',
'ExtUtils::Mkbootstrap' => 'cpan',
'ExtUtils::Mksymlists' => 'cpan',
+ 'ExtUtils::Packlist' => 'cpan',
'ExtUtils::testlib' => 'cpan',
'Fatal' => 'cpan',
'File::Fetch' => 'cpan',
'CPAN::Meta::Converter' => 'https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues',
'CPAN::Meta::Feature' => 'https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues',
'CPAN::Meta::History' => 'https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues',
+ 'CPAN::Meta::Merge' => 'https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues',
'CPAN::Meta::Prereqs' => 'https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues',
'CPAN::Meta::Requirements'=> 'https://github.com/dagolden/CPAN-Meta-Requirements/issues',
'CPAN::Meta::Spec' => 'https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues',
'Encode::TW' => undef,
'Encode::Unicode' => undef,
'Encode::Unicode::UTF7' => undef,
+ 'ExtUtils::Command' => 'http://rt.perl.org/rt3/',
'ExtUtils::Command::MM' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'ExtUtils::Constant' => undef,
'ExtUtils::Constant::Base'=> undef,
'ExtUtils::Constant::ProxySubs'=> undef,
'ExtUtils::Constant::Utils'=> undef,
'ExtUtils::Constant::XS'=> undef,
+ 'ExtUtils::Install' => 'http://rt.perl.org/rt3/',
+ 'ExtUtils::Installed' => 'http://rt.perl.org/rt3/',
'ExtUtils::Liblist' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'ExtUtils::Liblist::Kid'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'ExtUtils::MM' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'ExtUtils::MY' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'ExtUtils::MakeMaker' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'ExtUtils::MakeMaker::Config'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
+ 'ExtUtils::Manifest' => 'http://rt.perl.org/rt3/',
'ExtUtils::Mkbootstrap' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'ExtUtils::Mksymlists' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
+ 'ExtUtils::Packlist' => 'http://rt.perl.org/rt3/',
'ExtUtils::testlib' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker',
'Fatal' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie',
'File::Fetch' => undef,
5.15.9, 5.16.0, 5.16.1, 5.16.2, 5.16.3, 5.17.0, 5.17.1, 5.17.2, 5.17.3,
5.17.4, 5.17.5, 5.17.6, 5.17.7, 5.17.8, 5.17.9, 5.17.10, 5.17.11, 5.18.0,
5.19.0, 5.19.1, 5.19.2, 5.19.3, 5.19.4, 5.19.5, 5.19.6, 5.19.7, 5.19.8,
-5.19.9, 5.19.10, 5.19.11, 5.20.0, 5.21.0, 5.21.1 and 5.21.2 releases of perl.
+5.19.9, 5.19.10, 5.19.11, 5.20.0, 5.21.0, 5.21.1, 5.21.2 and 5.21.3 releases of perl.
=head1 HISTORY
use strict;
use vars qw($VERSION);
-$VERSION = '5.021002';
+$VERSION = '5.021003';
sub TIEHASH {
my ($class, $changed, $removed, $parent) = @_;
use Module::CoreList;
use Module::CoreList::TieHashDelta;
-$VERSION = '5.021002';
+$VERSION = '5.021003';
sub utilities {
my $perl = shift;
removed => {
}
},
+ 5.021003 => {
+ delta_from => 5.021002,
+ changed => {
+ },
+ removed => {
+ }
+ },
);
for my $version (sort { $a <=> $b } keys %delta) {
+2.38 Mon Aug 04 2014
+ - critical bugfix: outside packages could be replaced (fix in Opcode)
+
+2.37 Sat Jun 22 2013
+ - Doc and presentation nits
+
+2.36 Thu May 23 18:08:48 2013
+ - Doc and test fixes for newer perls
+
2.35 Thu Feb 21 2013
- localize %SIG in the Safe compartment
- actually check that we call execution methods on a Safe object
cf Perl 5 change 42440e3c68e8bafb7e2a74763360939de0fad6be
2.33 Tue Apr 3 2012
- - Don’t eval code under ‘no strict’ (Father Chrysostomos)
+ Don't eval code under "no strict" (Father Chrysostomos)
cf. Perl 5 change 25dc25e774abbe993644899cf4d9f9925a9fb9a8
2.32 Sat Mar 31 2012
Changes
-MANIFEST This list of files
Makefile.PL
+MANIFEST This list of files
+META.json Module JSON meta-data (added by MakeMaker)
+META.yml Module meta-data (added by MakeMaker)
README
Safe.pm
t/safe1.t
t/safenamedcap.t
t/safeops.t
t/saferegexp.t
+t/safesecurity.t
t/safesort.t
t/safeuniversal.t
t/safeutf8.t
t/safewrap.t
-META.yml Module meta-data (added by MakeMaker)
-META.json Module JSON meta-data (added by MakeMaker)
use 5.003_11;
use Scalar::Util qw(reftype refaddr);
-$Safe::VERSION = "2.37";
+$Safe::VERSION = "2.38";
# *** Don't declare any lexicals above this point ***
#
--- /dev/null
+#!perl
+
+BEGIN {
+ require Config;
+ import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/) {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+use strict;
+use warnings;
+use Test::More;
+use Safe;
+plan(tests => 1);
+
+my $c = new Safe;
+
+{
+ package My::Controller;
+ sub jopa { return "jopa" }
+}
+
+$c->reval(q{
+ package My::Controller;
+ sub jopa { return "hacked" }
+
+ My::Controller->jopa; # let it cache package
+});
+
+is(My::Controller->jopa, "jopa", "outside packages cannot be overriden");
}
}
-use Test::More tests => 15;
-
+my ($ok1, $ok2);
BEGIN {
require autouse;
eval {
"autouse"->import('Scalar::Util' => 'Scalar::Util::set_prototype(&$)');
};
- ok( !$@, "Function from package with custom 'import()' correctly imported" );
+ $ok1 = !$@;
eval {
"autouse"->import('Scalar::Util' => 'Foo::min');
};
- ok( $@, qr/^autouse into different package attempted/ );
+ $ok2 = $@;
"autouse"->import('Scalar::Util' => qw(isdual set_prototype(&$)));
}
+use Test::More tests => 15;
+
+ok( $ok1, "Function from package with custom 'import()' correctly imported" );
+like( $ok2, qr/^autouse into different package attempted/, "Catch autouse into different package" );
+
ok( isdual($!),
"Function imported via 'autouse' performs as expected");
num_svs = 0;
}
else if (isDIGIT(*type)) {
- wanted_fd = atoi(type);
+ wanted_fd = grok_atou(type, NULL);
}
else {
const IO* thatio;
Apd |int |grok_number_flags|NN const char *pv|STRLEN len|NULLOK UV *valuep|U32 flags
ApdR |bool |grok_numeric_radix|NN const char **sp|NN const char *send
Apd |UV |grok_oct |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result
+Apdn |UV |grok_atou |NN const char* pv|NULLOK const char** endptr
: These are all indirectly referenced by globals.c. This is somewhat annoying.
p |int |magic_clearenv |NN SV* sv|NN MAGIC* mg
p |int |magic_clear_all_env|NN SV* sv|NN MAGIC* mg
Ap |void |set_numeric_radix
Ap |void |set_numeric_standard
ApM |bool |_is_in_locale_category|const bool compiling|const int category
+Apd |void |sync_locale
ApdO |void |require_pv |NN const char* pv
Apd |void |pack_cat |NN SV *cat|NN const char *pat|NN const char *patend \
|NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags
s |void |process_special_blocks |I32 floor \
|NN const char *const fullname\
|NN GV *const gv|NN CV *const cv
+s |void |clear_special_blocks |NN const char *const fullname\
+ |NN GV *const gv|NN CV *const cv
#endif
Xpa |void* |Slab_Alloc |size_t sz
Xp |void |Slab_Free |NN void *op
#define getcwd_sv(a) Perl_getcwd_sv(aTHX_ a)
#define gp_free(a) Perl_gp_free(aTHX_ a)
#define gp_ref(a) Perl_gp_ref(aTHX_ a)
+#define grok_atou Perl_grok_atou
#define grok_bin(a,b,c,d) Perl_grok_bin(aTHX_ a,b,c,d)
#define grok_hex(a,b,c,d) Perl_grok_hex(aTHX_ a,b,c,d)
#define grok_number(a,b,c) Perl_grok_number(aTHX_ a,b,c)
#define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
#define swash_fetch(a,b,c) Perl_swash_fetch(aTHX_ a,b,c)
#define swash_init(a,b,c,d,e) Perl_swash_init(aTHX_ a,b,c,d,e)
+#define sync_locale() Perl_sync_locale(aTHX)
#define taint_env() Perl_taint_env(aTHX)
#define taint_proper(a,b) Perl_taint_proper(aTHX_ a,b)
#define tmps_grow(a) Perl_tmps_grow(aTHX_ a)
#define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d)
#define bad_type_gv(a,b,c,d,e) S_bad_type_gv(aTHX_ a,b,c,d,e)
#define bad_type_pv(a,b,c,d,e) S_bad_type_pv(aTHX_ a,b,c,d,e)
+#define clear_special_blocks(a,b,c) S_clear_special_blocks(aTHX_ a,b,c)
#define cop_free(a) S_cop_free(aTHX_ a)
#define dup_attrlist(a) S_dup_attrlist(aTHX_ a)
#define finalize_op(a) S_finalize_op(aTHX_ a)
}
#endif
if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
- dl_nonlazy = atoi(perl_dl_nonlazy);
+ dl_nonlazy = grok_atou(perl_dl_nonlazy, NULL);
if (dl_nonlazy)
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
#ifdef DL_LOADONCEONLY
plan(skip_all => "GDBM_File was not built")
unless $Config{extensions} =~ /\bGDBM_File\b/;
+ # https://rt.perl.org/Public/Bug/Display.html?id=117967
+ plan(skip_all => "GDBM_File is flaky in $^O")
+ if $^O =~ /darwin/;
+
plan(tests => 8);
use_ok('GDBM_File');
}
use Carp;
use Symbol qw(gensym qualify);
-$VERSION = '1.17';
+$VERSION = '1.18';
@ISA = qw(Exporter);
@EXPORT = qw(open3);
sub spawn_with_handles {
my $fds = shift; # Fields: handle, mode, open_as
my $close_in_child = shift;
- my ($fd, $pid, @saved_fh, $saved, %saved, @errs);
+ my ($fd, %saved, @errs);
foreach $fd (@$fds) {
$fd->{tmp_copy} = IO::Handle->new_from_fd($fd->{handle}, $fd->{mode});
unless eval { $fd->{handle}->isa('IO::Handle') } ;
# If some of handles to redirect-to coincide with handles to
# redirect, we need to use saved variants:
- $fd->{handle}->fdopen(defined fileno $fd->{open_as}
- ? $saved{fileno $fd->{open_as}} || $fd->{open_as}
- : $fd->{open_as},
- $fd->{mode});
+ my $open_as = $fd->{open_as};
+ my $fileno = fileno($open_as);
+ $fd->{handle}->fdopen(defined($fileno)
+ ? $saved{$fileno} || $open_as
+ : $open_as,
+ $fd->{mode});
}
unless ($^O eq 'MSWin32') {
require Fcntl;
}
}
+ my $pid;
unless (@errs) {
if (FORCE_DEBUG_SPAWN) {
pipe my $r, my $w or die "Pipe failed: $!";
our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.27";
+$VERSION = "1.28";
use Carp;
use Exporter ();
dummy_hv = save_hash(PL_incgv);
GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpvs("INC",GV_ADD,SVt_PVHV))));
- /* Invalidate ISA and method caches */
+ /* Invalidate class and method caches */
++PL_sub_generation;
hv_clear(PL_stashcache);
SPAGAIN; /* for the PUTBACK added by xsubpp */
LEAVE;
+ /* Invalidate again */
+ ++PL_sub_generation;
+ hv_clear(PL_stashcache);
+
int
verify_opset(opset, fatal = 0)
static XSPROTO(is_common)
{
dXSARGS;
- static PTR_TBL_t * is_common_ptr_table;
if (items != 1)
croak_xs_usage(cv, "charstring");
* called. See thread at
* http://markmail.org/thread/jhqcag5njmx7jpyu */
- if (! is_common_ptr_table) {
- is_common_ptr_table = ptr_table_new();
- }
- if (! ptr_table_fetch(is_common_ptr_table, PL_op)) {
+ HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
+ if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
"Calling POSIX::%"HEKf"() is deprecated",
HEKfARG(GvNAME_HEK(CvGV(cv))));
- ptr_table_store(is_common_ptr_table, PL_op, (void *) 1);
+ hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
}
}
our ($AUTOLOAD, %SIGRT);
-our $VERSION = '1.41';
+our $VERSION = '1.42';
require XSLoader;
=item C<atexit>
-C<atexit()> is C-specific: use C<END {}> instead, see L<perlsub>.
+C<atexit()> is C-specific: use C<END {}> instead, see L<perlmod>.
=item C<atof>
# Expected number of tests is one each for every combination of a
# known is<xxx> function and string listed above.
-plan(tests => keys(%classes) * keys(%functions) + 1);
+plan(tests => keys(%classes) * keys(%functions) + 2);
# Main test loop: Run all POSIX::is<xxx> tests on each string defined above.
# Only the character classes listed for that string should return 1. We
# calls
is(scalar @warnings, 20);
}
+
+SKIP:
+{
+ # [perl #122476] - is*() could crash when threads were involved on Win32
+ # this only crashed on Win32, only test there
+ # When the is*() functions are removed, also remove "iscrash"
+ skip("Not Win32", 1) unless $^O eq "MSWin32";
+ skip("No threads", 1) unless $Config{useithreads};
+ skip("No Win32API::File", 1)
+ unless $Config{extensions} =~ m(\bWin32API/File\b);
+
+ local $ENV{PERL5LIB} =
+ join($Config{path_sep},
+ map / / ? qq("$_") : $_, @INC);
+ my $result = `$^X t/iscrash`;
+ like($result, qr/\bok\b/, "is in threads didn't crash");
+}
--- /dev/null
+# test file for checking that the is*() functions don't crash
+use Win32API::File qw(SetErrorMode SEM_NOGPFAULTERRORBOX SEM_NOOPENFILEERRORBOX);
+use strict;
+use threads;
+use POSIX qw(isalpha islower);
+
+SetErrorMode(SEM_NOGPFAULTERRORBOX | SEM_NOOPENFILEERRORBOX);
+
+use warnings; # we want the warnings code to run
+$SIG{__WARN__} = sub {}; # but don't want to display them
+
+my $t1 = threads->create(sub { isalpha("c") });
+$t1->join;
+
+islower("a");
+
+my $t2 = threads->create(sub { isalpha("a") });
+$t2->join;
+
+print "ok\n";
our $host;
BEGIN {
- $VERSION = '1.18';
+ $VERSION = '1.19';
{
local $SIG{__DIE__};
eval {
# define MAXHOSTNAMELEN 256
#endif
-/* swiped from POSIX.xs */
-#if defined(__VMS) && !defined(__POSIX_SOURCE)
-# if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
-# include <utsname.h>
-# endif
-#endif
-
#ifdef I_SYSUTSNAME
# include <sys/utsname.h>
#endif
use warnings;
use Carp;
-our $VERSION = '0.62';
+our $VERSION = '0.63';
require XSLoader;
PUSHs(sv_2mortal(newSViv(result)));
if (result & IS_NUMBER_IN_UV)
PUSHs(sv_2mortal(newSVuv(value)));
+
+void
+grok_atou(number, endsv)
+ SV *number
+ SV *endsv
+ PREINIT:
+ STRLEN len;
+ const char *pv = SvPV(number, len);
+ UV result;
+ const char* endptr;
+ PPCODE:
+ EXTEND(SP,2);
+ if (endsv == &PL_sv_undef) {
+ result = grok_atou(pv, NULL);
+ } else {
+ result = grok_atou(pv, &endptr);
+ }
+ PUSHs(sv_2mortal(newSVuv(result)));
+ if (endsv == &PL_sv_undef) {
+ PUSHs(sv_2mortal(newSVpvn(NULL, 0)));
+ } else {
+ if (endptr) {
+ PUSHs(sv_2mortal(newSViv(endptr - pv)));
+ } else {
+ PUSHs(sv_2mortal(newSViv(0)));
+ }
+ }
is($out_flags, $grok->[3], "'$grok->[0]' flags $grok->[1] - check flags");
}
+my $ATOU_MAX = ~0;
+
+# atou tests
+my @atous =
+ (
+ # [ input, endsv, out uv, out len ]
+
+ # Basic cases.
+ [ "0", "", 0, 1 ],
+ [ "1", "", 1, 1 ],
+ [ "2", "", 2, 1 ],
+ [ "9", "", 9, 1 ],
+ [ "12", "", 12, 2 ],
+ [ "123", "", 123, 3 ],
+
+ # Trailing whitespace is accepted or rejected, depending on endptr.
+ [ "0 ", " ", 0, 1 ],
+ [ "1 ", " ", 1, 1 ],
+ [ "2 ", " ", 2, 1 ],
+ [ "12 ", " ", 12, 2 ],
+
+ # Trailing garbage is accepted or rejected, depending on endptr.
+ [ "0x", "x", 0, 1 ],
+ [ "1x", "x", 1, 1 ],
+ [ "2x", "x", 2, 1 ],
+ [ "12x", "x", 12, 2 ],
+
+ # Leading whitespace is failure.
+ [ " 0", " 0", 0, 0 ],
+ [ " 1", " 1", 0, 0 ],
+ [ " 12", " 12", 0, 0 ],
+
+ # Leading garbage is outright failure.
+ [ "x0", "x0", 0, 0 ],
+ [ "x1", "x1", 0, 0 ],
+ [ "x12", "x12", 0, 0 ],
+
+ # We do not parse decimal point.
+ [ "12.3", ".3", 12, 2 ],
+
+ # Leading pluses or minuses are no good.
+ [ "+12", "+12", 0, 0 ],
+ [ "-12", "-12", 0, 0 ],
+
+ # Extra leading zeros cause overflow.
+ [ "00", "00", $ATOU_MAX, 0 ],
+ [ "01", "01", $ATOU_MAX, 0 ],
+ [ "012", "012", $ATOU_MAX, 0 ],
+ );
+
+# Values near overflow point.
+if ($Config{uvsize} == 8) {
+ push @atous,
+ (
+ # 32-bit values no problem for 64-bit.
+ [ "4294967293", "", 4294967293, 10, ],
+ [ "4294967294", "", 4294967294, 10, ],
+ [ "4294967295", "", 4294967295, 10, ],
+ [ "4294967296", "", 4294967296, 10, ],
+ [ "4294967297", "", 4294967297, 10, ],
+
+ # This is well within 64-bit.
+ [ "9999999999", "", 9999999999, 10, ],
+
+ # Values valid up to 64-bit and beyond.
+ [ "18446744073709551613", "", 18446744073709551613, 20, ],
+ [ "18446744073709551614", "", 18446744073709551614, 20, ],
+ [ "18446744073709551615", "", $ATOU_MAX, 20, ],
+ [ "18446744073709551616", "", $ATOU_MAX, 0, ],
+ [ "18446744073709551617", "", $ATOU_MAX, 0, ],
+ );
+} elsif ($Config{uvsize} == 4) {
+ push @atous,
+ (
+ # Values valid up to 32-bit and beyond.
+ [ "4294967293", "", 4294967293, 10, ],
+ [ "4294967294", "", 4294967294, 10, ],
+ [ "4294967295", "", $ATOU_MAX, 10, ],
+ [ "4294967296", "", $ATOU_MAX, 0, ],
+ [ "4294967297", "", $ATOU_MAX, 0, ],
+
+ # Still beyond 32-bit.
+ [ "4999999999", "", $ATOU_MAX, 0, ],
+ [ "5678901234", "", $ATOU_MAX, 0, ],
+ [ "6789012345", "", $ATOU_MAX, 0, ],
+ [ "7890123456", "", $ATOU_MAX, 0, ],
+ [ "8901234567", "", $ATOU_MAX, 0, ],
+ [ "9012345678", "", $ATOU_MAX, 0, ],
+ [ "9999999999", "", $ATOU_MAX, 0, ],
+ [ "10000000000", "", $ATOU_MAX, 0, ],
+ [ "12345678901", "", $ATOU_MAX, 0, ],
+
+ # 64-bit values are way beyond.
+ [ "18446744073709551613", "", $ATOU_MAX, 0, ],
+ [ "18446744073709551614", "", $ATOU_MAX, 0, ],
+ [ "18446744073709551615", "", $ATOU_MAX, 0, ],
+ [ "18446744073709551616", "", $ATOU_MAX, 0, ],
+ [ "18446744073709551617", "", $ATOU_MAX, 0, ],
+ );
+}
+
+# These will fail to fail once 128/256-bit systems arrive.
+push @atous,
+ (
+ [ "23456789012345678901", "", $ATOU_MAX, 0 ],
+ [ "34567890123456789012", "", $ATOU_MAX, 0 ],
+ [ "98765432109876543210", "", $ATOU_MAX, 0 ],
+ [ "98765432109876543211", "", $ATOU_MAX, 0 ],
+ [ "99999999999999999999", "", $ATOU_MAX, 0 ],
+ );
+
+for my $grok (@atous) {
+ my $input = $grok->[0];
+ my $endsv = $grok->[1];
+
+ my ($out_uv, $out_len);
+
+ # First with endsv.
+ ($out_uv, $out_len) = grok_atou($input, $endsv);
+ is($out_uv, $grok->[2],
+ "'$input' $endsv - number success (got $out_uv cf $grok->[2])");
+ ok($grok->[3] <= length $input, "'$input' $endsv - length sanity 1");
+ unless (length $grok->[1]) {
+ is($out_len, $grok->[3], "'$input' $endsv - length sanity 2");
+ } # else { ... } ?
+ if ($out_len) {
+ is($endsv, substr($input, $out_len),
+ "'$input' $endsv - length sanity 3");
+ }
+
+ # Then without endsv (undef == NULL).
+ ($out_uv, $out_len) = grok_atou($input, undef);
+ if (length $grok->[1]) {
+ if ($grok->[2] == $ATOU_MAX) {
+ is($out_uv, $ATOU_MAX, "'$input' undef - number overflow");
+ } else {
+ is($out_uv, 0, "'$input' undef - number zero");
+ }
+ } else {
+ is($out_uv, $grok->[2],
+ "'$input' undef - number success (got $out_uv cf $grok->[2])");
+ }
+}
+
done_testing();
if (!isDIGIT(*end))
return addmg;
}
- paren = strtoul(name, NULL, 10);
+ paren = grok_atou(name, NULL);
goto storeparen;
}
}
# 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.21.2
+# mkdir -p /opt/perl-catamount/lib/perl5/5.21.3
# 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.21.2
+# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.21.3
# 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
case "X$optimize" in
X)
case `gcc -v 2>&1|grep "gcc version"` in
- "gcc version 3."*)
- optimize="-O2 -falign-loops=2 -falign-jumps=2 -falign-functions=2" ;;
- *)
+ "gcc version 1."*|"gcc version 2."*)
optimize="-O2 -malign-loops=2 -malign-jumps=2 -malign-functions=2" ;;
+ *)
+ optimize="-O2 -falign-loops=2 -falign-jumps=2 -falign-functions=2" ;;
esac
ldflags='-s'
;;
`
case "$cc" in
-'') if test -f /opt/SUNWspro/bin/cc; then
- cc=/opt/SUNWspro/bin/cc
- cat <<EOF >&4
+'') for i in `ls -r /opt/solstudio*/bin/cc` /opt/SUNWspro/bin/cc
+ do
+ if test -f "$i"; then
+ cc=$i
+ cat <<EOF >&4
You specified no cc but you seem to have the Workshop compiler
($cc) installed, using that.
e.g. Configure -Dcc=gcc
EOF
- fi
+ break
+ fi
+ done
;;
esac
if $tryworkshopcc >/dev/null 2>&1; then
cc_name=`$run ./try`
if test "$cc_name" = "workshop"; then
- ccversion="`${cc:-cc} -V 2>&1|sed -n -e '1s/^[Cc][Cc]: //p'`"
+ ccversion="`${cc:-cc} -V 2>&1|sed -n -e '1s/^[Cc][Cc9]9*: //p'`"
fi
if test "$cc_name" = "workshop CC"; then
ccversion="`${cc:-CC} -V 2>&1|sed -n -e '1s/^[Cc][C]: //p'`"
d_attribute_pure='undef'
d_attribute_unused='undef'
d_attribute_warn_unused_result='undef'
+ case "$cc" in
+ *c99) # c99 rejects bare '-O'.
+ case "$optimize" in
+ ''|-O) optimize=-O3 ;;
+ esac
+ # Without -Xa c99 doesn't see
+ # many OS interfaces.
+ case "$ccflags" in
+ *-Xa*) ;;
+ *) ccflags="$ccflags -Xa" ;;
+ esac
+ ;;
+ esac
;;
esac
fi
#
cat >> config.over <<'EOOVER'
if test "$d_unsetenv" = "$define" -a \
- `expr "$ccflags" : '.*-D_PERL_USE_SAFE_PUTENV'` -eq 0; then
+ `expr "$ccflags" : '.*-DPERL_USE_SAFE_PUTENV'` -eq 0; then
ccflags="$ccflags -DPERL_USE_SAFE_PUTENV"
fi
EOOVER
|| defined(PERL_HASH_FUNC_ONE_AT_A_TIME) \
|| defined(PERL_HASH_FUNC_ONE_AT_A_TIME_HARD) \
|| defined(PERL_HASH_FUNC_ONE_AT_A_TIME_OLD) \
+ || defined(PERL_HASH_FUNC_MURMUR_HASH_64A) \
+ || defined(PERL_HASH_FUNC_MURMUR_HASH_64B) \
)
#define PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
#endif
# define PERL_HASH_FUNC "ONE_AT_A_TIME_OLD"
# define PERL_HASH_SEED_BYTES 4
# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_old_one_at_a_time((seed),(U8*)(str),(len))
+#elif defined(PERL_HASH_FUNC_MURMUR_HASH_64A)
+# define PERL_HASH_FUNC "MURMUR_HASH_64A"
+# define PERL_HASH_SEED_BYTES 8
+# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_murmur_hash_64a((seed),(U8*)(str),(len))
+#elif defined(PERL_HASH_FUNC_MURMUR_HASH_64B)
+# define PERL_HASH_FUNC "MURMUR_HASH_64B"
+# define PERL_HASH_SEED_BYTES 8
+# define PERL_HASH_WITH_SEED(seed,hash,str,len) (hash)= S_perl_hash_murmur_hash_64b((seed),(U8*)(str),(len))
#endif
#ifndef PERL_HASH_WITH_SEED
return (hash + (hash << 15));
}
+#ifdef PERL_HASH_FUNC_MURMUR_HASH_64A
+/* This code is from Austin Appleby and is in the public domain.
+ Altered by Yves Orton to match Perl's hash interface, and to
+ return a 32 bit hash.
+
+ Note uses unaligned 64 bit loads - will NOT work on machines with
+ strict alginment requirements.
+
+ Also this code may not be suitable for big-endian machines.
+*/
+
+/* a 64 bit hash where we only use the low 32 bits */
+PERL_STATIC_INLINE U32
+S_perl_hash_murmur_hash_64a (const unsigned char * const seed, const unsigned char *str, const STRLEN len)
+{
+ const U64TYPE m = 0xc6a4a7935bd1e995;
+ const int r = 47;
+ U64TYPE h = *((U64TYPE*)seed) ^ len;
+ const U64TYPE * data = (const U64TYPE *)str;
+ const U64TYPE * end = data + (len/8);
+ const unsigned char * data2;
+
+ while(data != end)
+ {
+ U64TYPE k = *data++;
+
+ k *= m;
+ k ^= k >> r;
+ k *= m;
+
+ h ^= k;
+ h *= m;
+ }
+
+ data2 = (const unsigned char *)data;
+
+ switch(len & 7)
+ {
+ case 7: h ^= (U64TYPE)(data2[6]) << 48; /* fallthrough */
+ case 6: h ^= (U64TYPE)(data2[5]) << 40; /* fallthrough */
+ case 5: h ^= (U64TYPE)(data2[4]) << 32; /* fallthrough */
+ case 4: h ^= (U64TYPE)(data2[3]) << 24; /* fallthrough */
+ case 3: h ^= (U64TYPE)(data2[2]) << 16; /* fallthrough */
+ case 2: h ^= (U64TYPE)(data2[1]) << 8; /* fallthrough */
+ case 1: h ^= (U64TYPE)(data2[0]); /* fallthrough */
+ h *= m;
+ };
+
+ h ^= h >> r;
+ h *= m;
+ h ^= h >> r;
+
+ /* was: return h; */
+ return h & 0xFFFFFFFF;
+}
+
+#endif
+
+#ifdef PERL_HASH_FUNC_MURMUR_HASH_64B
+/* This code is from Austin Appleby and is in the public domain.
+ Altered by Yves Orton to match Perl's hash interface and return
+ a 32 bit value
+
+ Note uses unaligned 32 bit loads - will NOT work on machines with
+ strict alginment requirements.
+
+ Also this code may not be suitable for big-endian machines.
+*/
+
+/* a 64-bit hash for 32-bit platforms where we only use the low 32 bits */
+PERL_STATIC_INLINE U32
+S_perl_hash_murmur_hash_64b (const unsigned char * const seed, const unsigned char *str, STRLEN len)
+{
+ const U32 m = 0x5bd1e995;
+ const int r = 24;
+
+ U32 h1 = ((U32 *)seed)[0] ^ len;
+ U32 h2 = ((U32 *)seed)[1];
+
+ const U32 * data = (const U32 *)str;
+
+ while(len >= 8)
+ {
+ U32 k1, k2;
+ k1 = *data++;
+ k1 *= m; k1 ^= k1 >> r; k1 *= m;
+ h1 *= m; h1 ^= k1;
+ len -= 4;
+
+ k2 = *data++;
+ k2 *= m; k2 ^= k2 >> r; k2 *= m;
+ h2 *= m; h2 ^= k2;
+ len -= 4;
+ }
+
+ if(len >= 4)
+ {
+ U32 k1 = *data++;
+ k1 *= m; k1 ^= k1 >> r; k1 *= m;
+ h1 *= m; h1 ^= k1;
+ len -= 4;
+ }
+
+ switch(len)
+ {
+ case 3: h2 ^= ((unsigned char*)data)[2] << 16; /* fallthrough */
+ case 2: h2 ^= ((unsigned char*)data)[1] << 8; /* fallthrough */
+ case 1: h2 ^= ((unsigned char*)data)[0]; /* fallthrough */
+ h2 *= m;
+ };
+
+ h1 ^= h2 >> 18; h1 *= m;
+ h2 ^= h1 >> 22; h2 *= m;
+ /*
+ The following code has been removed as it is unused
+ when only the low 32 bits are used. -- Yves
+
+ h1 ^= h2 >> 17; h1 *= m;
+
+ U64TYPE h = h1;
+
+ h = (h << 32) | h2;
+ */
+
+ return h2;
+}
+#endif
+
/* legacy - only mod_perl should be doing this. */
#ifdef PERL_HASH_INTERNAL_ACCESS
#define PERL_HASH_INTERNAL(hash,str,len) PERL_HASH(hash,str,len)
PERLVARI(I, statname, SV *, NULL)
#ifdef HAS_TIMES
-/* Will be removed soon after v5.21.2. See RT #121351 */
+/* Will be removed soon after v5.21.3. See RT #121351 */
PERLVAR(I, timesbuf, struct tms)
#endif
/* Hook for File::Glob */
PERLVARI(I, globhook, globhook_t, NULL)
-/* The last unconditional member of the interpreter structure when 5.21.2 was
+/* The last unconditional member of the interpreter structure when 5.21.3 was
released. The offset of the end of this is baked into a global variable in
any shared perl library which will allow a sanity test in future perl
releases. */
package UNIVERSAL;
-our $VERSION = '1.11';
+our $VERSION = '1.12';
# UNIVERSAL should not contain any extra subs/methods beyond those
-# that it exists to define. The use of Exporter below is a historical
-# accident that can't be fixed without breaking code. Note that we
-# *don't* set @ISA here, as we don't want all classes/objects inheriting from
-# Exporter. It's bad enough that all classes have a import() method
-# whenever UNIVERSAL.pm is loaded.
-require Exporter;
-@EXPORT_OK = qw(isa can VERSION);
+# that it exists to define. The existence of import() below is a historical
+# accident that can't be fixed without breaking code.
# Make sure that even though the import method is called, it doesn't do
# anything unless called on UNIVERSAL.
sub import {
return unless $_[0] eq __PACKAGE__;
return unless @_ > 1;
- require warnings;
- warnings::warnif(
- 'deprecated',
- 'UNIVERSAL->import is deprecated and will be removed in a future perl',
- );
- goto &Exporter::import;
+ require Carp;
+ Carp::croak("UNIVERSAL does not export anything");
}
1;
=head1 EXPORTS
-None by default.
+None.
-You may request the import of three functions (C<isa>, C<can>, and C<VERSION>),
-B<but this feature is deprecated and will be removed>. Please don't do this in
-new code.
-
-For example, previous versions of this documentation suggested using C<isa> as
+Previous versions of this documentation suggested using C<isa> as
a function to determine the type of a reference:
use UNIVERSAL 'isa';
$yes = isa $h, "HASH";
$yes = isa "Foo", "Bar";
-The problem is that this code will I<never> call an overridden C<isa> method in
+The problem is that this code would I<never> call an overridden C<isa> method in
any class. Instead, use C<reftype> from L<Scalar::Util> for the first case:
use Scalar::Util 'reftype';
# Debugger for Perl 5.00x; perl5db.pl patch level:
use vars qw($VERSION $header);
-$VERSION = '1.45';
+$VERSION = '1.46';
$header = "perl5db.pl version $VERSION";
my @vars = split( ' ', $match_vars || '' );
# Find the pad.
- my $h = eval { PadWalker::peek_my( ( $match_level || 0 ) + 1 ) };
+ my $h = eval { PadWalker::peek_my( ( $match_level || 0 ) + 2 ) };
# Oops. Can't find it.
if (my $Err = $@) {
# keys TYPE, BITS, EXTRAS, LIST, and NONE with values having the
# same meanings as the input parameters.
# SPECIALS contains a reference to any special-treatment hash in the
+ # property.
# INVERT_IT is non-zero if the result should be inverted before use
# USER_DEFINED is non-zero if the result came from a user-defined
- # property.
my $file; ## file to load data from, and also part of the %Cache key.
# Change this to get a different set of Unicode tables
* dot.
*
* This sets several interpreter-level variables:
- * PL_numeric_name The default locale's name: a copy of 'newnum'
+ * PL_numeric_name The underlying locale's name: a copy of 'newnum'
* PL_numeric_local A boolean indicating if the toggled state is such
* that the current locale is the program's underlying
* locale
char *p;
const bool locwarn = (printwarn > 1 ||
(printwarn &&
- (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))));
+ (!(p = PerlEnv_getenv("PERL_BADLANG")) ||
+ grok_atou(p, NULL))));
bool done = FALSE;
#ifdef WIN32
/* In some systems you can find out the system default locale
* result */
if (is_utf8) {
wchar_t wc;
- GCC_DIAG_IGNORE(-Wunused-result);
- (void) mbtowc(&wc, NULL, 0); /* Reset any shift state */
- GCC_DIAG_RESTORE;
+ PERL_UNUSED_RESULT(mbtowc(&wc, NULL, 0));/* Reset any shift state */
errno = 0;
if ((size_t)mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8))
!= strlen(HYPHEN_UTF8)
}
/*
+
+=head1 Locale-related functions and macros
+
+=for apidoc sync_locale
+
+Changing the program's locale should be avoided by XS code. Nevertheless,
+certain non-Perl libraries called from XS, such as C<Gtk> do so. When this
+happens, Perl needs to be told that the locale has changed. Use this function
+to do so, before returning to Perl.
+
+=cut
+*/
+
+void
+Perl_sync_locale(pTHX)
+{
+
+#ifdef USE_LOCALE_CTYPE
+ new_ctype(setlocale(LC_CTYPE, NULL));
+#endif /* USE_LOCALE_CTYPE */
+
+#ifdef USE_LOCALE_COLLATE
+ new_collate(setlocale(LC_COLLATE, NULL));
+#endif
+
+#ifdef USE_LOCALE_NUMERIC
+ set_numeric_local(); /* Switch from "C" to underlying LC_NUMERIC */
+ new_numeric(setlocale(LC_NUMERIC, NULL));
+#endif /* USE_LOCALE_NUMERIC */
+
+}
+
+
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
if (bad_free_warn == -1) {
dTHX;
char *pbf = PerlEnv_getenv("PERL_BADFREE");
- bad_free_warn = (pbf) ? atoi(pbf) : 1;
+ bad_free_warn = (pbf) ? grok_atou(pbf, NULL) : 1;
}
if (!bad_free_warn)
return;
if (bad_free_warn == -1) {
dTHX;
char *pbf = PerlEnv_getenv("PERL_BADFREE");
- bad_free_warn = (pbf) ? atoi(pbf) : 1;
+ bad_free_warn = (pbf) ? grok_atou(pbf, NULL) : 1;
}
if (!bad_free_warn)
return NULL;
{
const char *p = SvPV_const(sv, len);
Groups_t *gary = NULL;
+ const char* endptr;
#ifdef _SC_NGROUPS_MAX
int maxgrp = sysconf(_SC_NGROUPS_MAX);
while (isSPACE(*p))
++p;
- new_egid = (Gid_t)Atol(p);
+ new_egid = (Gid_t)grok_atou(p, &endptr);
for (i = 0; i < maxgrp; ++i) {
- while (*p && !isSPACE(*p))
- ++p;
+ if (endptr == NULL)
+ break;
+ p = endptr;
while (isSPACE(*p))
++p;
if (!*p)
break;
- if(!gary)
+ if (!gary)
Newx(gary, i + 1, Groups_t);
else
Renew(gary, i + 1, Groups_t);
- gary[i] = (Groups_t)Atol(p);
+ gary[i] = (Groups_t)grok_atou(p, &endptr);
}
if (i)
PERL_UNUSED_RESULT(setgroups(i, gary));
cppflags='$cppflags'
ccversion='$ccversion', gccversion='$gccversion', gccosandvers='$gccosandvers'
intsize=$intsize, longsize=$longsize, ptrsize=$ptrsize, doublesize=$doublesize, byteorder=$byteorder
- d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize
+ d_longlong=$d_longlong, longlongsize=$longlongsize, d_longdbl=$d_longdbl, longdblsize=$longdblsize, longdblkind=$longdblkind
ivtype='$ivtype', ivsize=$ivsize, nvtype='$nvtype', nvsize=$nvsize, Off_t='$lseektype', lseeksize=$lseeksize
alignbytes=$alignbytes, prototype=$prototype
Linker and Libraries:
return grok_number_flags(pv, len, valuep, 0);
}
+static const UV uv_max_div_10 = UV_MAX / 10;
+static const U8 uv_max_mod_10 = UV_MAX % 10;
+
int
Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags)
{
const char *s = pv;
const char * const send = pv + len;
- const UV max_div_10 = UV_MAX / 10;
- const char max_mod_10 = UV_MAX % 10;
int numtype = 0;
int sawinf = 0;
int sawnan = 0;
each time for overflow. */
digit = *s - '0';
while (digit >= 0 && digit <= 9
- && (value < max_div_10
- || (value == max_div_10
- && digit <= max_mod_10))) {
+ && (value < uv_max_div_10
+ || (value == uv_max_div_10
+ && digit <= uv_max_mod_10))) {
value = value * 10 + digit;
if (++s < send)
digit = *s - '0';
return 0;
}
+/*
+=for apidoc grok_atou
+
+grok_atou is a safer replacement for atoi and strtol.
+
+grok_atou parses a C-style zero-byte terminated string, looking for
+a decimal unsigned integer.
+
+Returns the unsigned integer, if a valid value can be parsed
+from the beginning of the string.
+
+Accepts only the decimal digits '0'..'9'.
+
+As opposed to atoi or strtol, grok_atou does NOT allow optional
+leading whitespace, or negative inputs. If such features are
+required, the calling code needs to explicitly implement those.
+
+If a valid value cannot be parsed, returns either zero (if non-digits
+are met before any digits) or UV_MAX (if the value overflows).
+
+Note that extraneous leading zeros also count as an overflow
+(meaning that only "0" is the zero).
+
+On failure, the *endptr is also set to NULL, unless endptr is NULL.
+
+Trailing non-digit bytes are allowed if the endptr is non-NULL.
+On return the *endptr will contain the pointer to the first non-digit byte.
+
+If the endptr is NULL, the first non-digit byte MUST be
+the zero byte terminating the pv, or zero will be returned.
+
+Background: atoi has severe problems with illegal inputs, it cannot be
+used for incremental parsing, and therefore should be avoided
+atoi and strtol are also affected by locale settings, which can also be
+seen as a bug (global state controlled by user environment).
+
+=cut
+*/
+
+UV
+Perl_grok_atou(const char *pv, const char** endptr)
+{
+ const char* s = pv;
+ const char** eptr;
+ const char* end2; /* Used in case endptr is NULL. */
+ UV val = 0; /* The return value. */
+
+ PERL_ARGS_ASSERT_GROK_ATOU;
+
+ eptr = endptr ? endptr : &end2;
+ if (isDIGIT(*s)) {
+ /* Single-digit inputs are quite common. */
+ val = *s++ - '0';
+ if (isDIGIT(*s)) {
+ /* Extra leading zeros cause overflow. */
+ if (val == 0) {
+ *eptr = NULL;
+ return UV_MAX;
+ }
+ while (isDIGIT(*s)) {
+ /* This could be unrolled like in grok_number(), but
+ * the expected uses of this are not speed-needy, and
+ * unlikely to need full 64-bitness. */
+ U8 digit = *s++ - '0';
+ if (val < uv_max_div_10 ||
+ (val == uv_max_div_10 && digit <= uv_max_mod_10)) {
+ val = val * 10 + digit;
+ } else {
+ *eptr = NULL;
+ return UV_MAX;
+ }
+ }
+ }
+ }
+ if (s == pv) {
+ *eptr = NULL; /* If no progress, failed to parse anything. */
+ return 0;
+ }
+ if (endptr == NULL && *s) {
+ return 0; /* If endptr is NULL, no trailing non-digits allowed. */
+ }
+ *eptr = s;
+ return val;
+}
+
STATIC NV
S_mulexp10(NV value, I32 exponent)
{
OP *
Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
{
- dVAR;
OP *first = start ? OP_SIBLING(start) : cLISTOPx(parent)->op_first;
OP *rest;
OP *last_del = NULL;
gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
has_name = FALSE;
}
-
if (!ec)
move_proto_attr(&proto, &attrs, gv);
}
}
- if (name && ! (PL_parser && PL_parser->error_count))
- process_special_blocks(floor, name, gv, cv);
+ if (name) {
+ if (PL_parser && PL_parser->error_count)
+ clear_special_blocks(name, gv, cv);
+ else
+ process_special_blocks(floor, name, gv, cv);
+ }
}
done:
}
STATIC void
+S_clear_special_blocks(pTHX_ const char *const fullname,
+ GV *const gv, CV *const cv) {
+ const char *colon;
+ const char *name;
+
+ PERL_ARGS_ASSERT_CLEAR_SPECIAL_BLOCKS;
+
+ colon = strrchr(fullname,':');
+ name = colon ? colon + 1 : fullname;
+
+ if ((*name == 'B' && strEQ(name, "BEGIN"))
+ || (*name == 'E' && strEQ(name, "END"))
+ || (*name == 'U' && strEQ(name, "UNITCHECK"))
+ || (*name == 'C' && strEQ(name, "CHECK"))
+ || (*name == 'I' && strEQ(name, "INIT"))) {
+ GvCV_set(gv, NULL);
+ SvREFCNT_dec_NN(MUTABLE_SV(cv));
+ }
+}
+
+STATIC void
S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
GV *const gv,
CV *const cv)
switch (cUNOPo->op_first->op_type) {
case OP_RV2AV:
case OP_PADAV:
- case OP_AASSIGN: /* Is this a good idea? */
Perl_croak(aTHX_ "Can't use 'defined(@array)'"
" (Maybe you should just omit the defined()?)");
break;
}
else {
OP *prev, *cvop, *first, *parent;
- U32 flags;
+ U32 flags = 0;
parent = entersubop;
if (!OP_HAS_SIBLING(aop)) {
OP_HAS_SIBLING(cvop);
prev = cvop, cvop = OP_SIBLING(cvop))
;
- flags = OPf_SPECIAL * !(cvop->op_private & OPpENTERSUB_NOPAREN);
+ if (!(cvop->op_private & OPpENTERSUB_NOPAREN)
+ /* Usually, OPf_SPECIAL on a UNOP means that its arg had no
+ * parens, but these have their own meaning for that flag: */
+ && opnum != OP_VALUES && opnum != OP_KEYS && opnum != OP_EACH
+ && opnum != OP_DELETE && opnum != OP_EXISTS)
+ flags |= OPf_SPECIAL;
/* excise cvop from end of sibling chain */
op_sibling_splice(parent, prev, 1, NULL);
op_free(cvop);
/* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
/* On pushre, rx is used as part of split, e.g. split " " */
/* On regcomp, "use re 'eval'" was in scope */
- /* On OP_READLINE, was <$filehandle> */
/* On RV2[ACGHS]V, don't create GV--in
defined()*/
/* On OP_DBSTATE, indicates breakpoint
SV *
Perl_pad_sv(pTHX_ PADOFFSET po)
{
- dVAR;
ASSERT_CURPAD_ACTIVE("pad_sv");
if (!po)
void
Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
{
- dVAR;
-
PERL_ARGS_ASSERT_PAD_SETSV;
ASSERT_CURPAD_ACTIVE("pad_setsv");
STATIC void
S_cv_dump(pTHX_ const CV *cv, const char *title)
{
- dVAR;
const CV * const outside = CvOUTSIDE(cv);
PADLIST* const padlist = CvPADLIST(cv);
#define PERL_REVISION 5 /* age */
#define PERL_VERSION 21 /* epoch */
-#define PERL_SUBVERSION 2 /* generation */
+#define PERL_SUBVERSION 3 /* 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 21
-#define PERL_API_SUBVERSION 2
+#define PERL_API_SUBVERSION 3
/*
XXX Note: The selection of non-default Configure options, such
as -Duselonglong may invalidate these settings. Currently, Configure
{
const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
if (s) {
- const int i = atoi(s);
+ int i;
+ if (strEQ(s, "-1")) { /* Special case: modperl folklore. */
+ i = -1;
+ } else {
+ i = grok_atou(s, NULL);
+ }
#ifdef DEBUGGING
if (destruct_level < i) destruct_level = i;
#endif
{
const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
- if (s && (atoi(s) == 1)) {
+ if (s && (grok_atou(s, NULL) == 1)) {
unsigned char *seed= PERL_HASH_SEED;
unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
PerlIO_printf(Perl_debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
#ifdef MYMALLOC
{
const char *s;
- if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
- dump_mstats("after compilation:");
+ if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && grok_atou(s, NULL) >= 2)
+ dump_mstats("after compilation:");
}
#endif
}
}
else if (isDIGIT(**s)) {
- i = atoi(*s);
+ const char* e;
+ i = grok_atou(*s, &e);
+ if (e)
+ *s = e;
for (; isWORDCHAR(**s); (*s)++) ;
}
else if (givehelp) {
if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
const char *s = scriptname + 8;
- fdscript = atoi(s);
- while (isDIGIT(*s))
- s++;
+ const char* e;
+ fdscript = grok_atou(s, &e);
+ s = e;
if (*s) {
/* PSz 18 Feb 04
* Tell apart "normal" usage of fdscript, e.g.
# endif
#endif
-#define SSize_t_MAX (SSize_t)(~(size_t)0 >> 1)
+#define Size_t_MAX (~(Size_t)0)
+#define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1)
#define IV_DIG (BIT_DIGITS(IVSIZE * 8))
#define UV_DIG (BIT_DIGITS(UVSIZE * 8))
# ifdef LDBL_MAX
# define NV_MAX LDBL_MAX
# endif
+# ifdef LDBL_MIN_EXP
+# define NV_MIN_EXP LDBL_MIN_EXP
+# endif
+# ifdef LDBL_MAX_EXP
+# define NV_MAX_EXP LDBL_MAX_EXP
+# endif
# ifdef LDBL_MIN_10_EXP
# define NV_MIN_10_EXP LDBL_MIN_10_EXP
# endif
# define Perl_frexp(x,y) Perl_my_frexpl(x,y)
# endif
# endif
+# ifdef HAS_LDEXPL
+# define Perl_ldexp(x, y) ldexpl(x,y)
+# else
+# if defined(HAS_SCALBNL) && FLT_RADIX == 2
+# define Perl_ldexp(x,y) scalbnl(x,y)
+# endif
+# endif
# ifndef Perl_isnan
# ifdef HAS_ISNANL
# define Perl_isnan(x) isnanl(x)
# ifdef DBL_MAX
# define NV_MAX DBL_MAX
# endif
+# ifdef DBL_MIN_EXP
+# define NV_MIN_EXP DBL_MIN_EXP
+# endif
+# ifdef DBL_MAX_EXP
+# define NV_MAX_EXP DBL_MAX_EXP
+# endif
# ifdef DBL_MIN_10_EXP
# define NV_MIN_10_EXP DBL_MIN_10_EXP
# endif
# define Perl_fmod fmod
# define Perl_modf(x,y) modf(x,y)
# define Perl_frexp(x,y) frexp(x,y)
+# define Perl_ldexp(x,y) ldexp(x,y)
#endif
/* rumor has it that Win32 has _fpclass() */
# ifdef PERL_GLOBAL_STRUCT
" PERL_GLOBAL_STRUCT"
# endif
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+ " PERL_GLOBAL_STRUCT_PRIVATE"
+# endif
# ifdef PERL_IMPLICIT_CONTEXT
" PERL_IMPLICIT_CONTEXT"
# endif
XATTRBLOCK,
XATTRTERM,
XTERMBLOCK,
+ XBLOCKTERM,
XPOSTDEREF,
XTERMORDORDOR /* evil hack */
/* update exp_name[] in toke.c if adding to this enum */
* 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.21.2" /**/
-#define PRIVLIB_EXP "/sys/lib/perl/5.21.2" /**/
+#define PRIVLIB "/sys/lib/perl/5.21.3" /**/
+#define PRIVLIB_EXP "/sys/lib/perl/5.21.3" /**/
/* 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.21.2/site_perl" /**/
-#define SITELIB_EXP "/sys/lib/perl/5.21.2/site_perl" /**/
-#define SITELIB_STEM "/sys/lib/perl/5.21.2/site_perl" /**/
+#define SITELIB "/sys/lib/perl/5.21.3/site_perl" /**/
+#define SITELIB_EXP "/sys/lib/perl/5.21.3/site_perl" /**/
+#define SITELIB_STEM "/sys/lib/perl/5.21.3/site_perl" /**/
/* Size_t_size:
* This symbol holds the size of a Size_t in bytes.
ansi2knr=''
aphostname='/bin/uname -n'
api_revision='5'
-api_subversion='2'
+api_subversion='3'
api_version='21'
-api_versionstring='5.21.2'
+api_versionstring='5.21.3'
ar='ar'
-archlib='/sys/lib/perl5/5.21.2/386'
-archlibexp='/sys/lib/perl5/5.21.2/386'
+archlib='/sys/lib/perl5/5.21.3/386'
+archlibexp='/sys/lib/perl5/5.21.3/386'
archname64=''
archname='386'
archobjs=''
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='define'
+d_ldexpl='undef'
d_libm_lib_version='0'
d_link='define'
d_localtime64='undef'
inc_version_list_init='0'
incpath=''
inews=''
-installarchlib='/sys/lib/perl/5.21.2/386'
+installarchlib='/sys/lib/perl/5.21.3/386'
installbin='/usr/bin'
installman1dir='/sys/man/1pub'
installman3dir='/sys/man/2pub'
installprefix='/usr'
installprefixexp='/usr'
-installprivlib='/sys/lib/perl/5.21.2'
+installprivlib='/sys/lib/perl/5.21.3'
installscript='/usr/bin'
-installsitearch='/sys/lib/perl/5.21.2/site_perl/386'
+installsitearch='/sys/lib/perl/5.21.3/site_perl/386'
installsitebin='/usr/bin'
-installsitelib='/sys/lib/perl/5.21.2/site_perl'
+installsitelib='/sys/lib/perl/5.21.3/site_perl'
installstyle='lib/perl5'
installusrbinperl='undef'
installvendorarch=''
localtime_r_proto='0'
locincpth=''
loclibpth=''
+longdblkind='0'
longdblsize='8'
longlongsize='8'
longsize='4'
pr=''
prefix='/usr'
prefixexp='/usr'
-privlib='/sys/lib/perl/5.21.2'
-privlibexp='/sys/lib/perl/5.21.2'
+privlib='/sys/lib/perl/5.21.3'
+privlibexp='/sys/lib/perl/5.21.3'
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.21.2/site_perl/386'
+sitearch='/sys/lib/perl/5.21.3/site_perl/386'
sitearchexp='/sys/lib/perl/site_perl/386'
sitebin='/usr/bin'
sitebinexp='/usr/bin'
-sitelib='/sys/lib/perl/5.21.2/site_perl'
-sitelib_stem='/sys/lib/perl/5.21.2/site_perl'
-sitelibexp='/sys/lib/perl/5.21.2/site_perl'
+sitelib='/sys/lib/perl/5.21.3/site_perl'
+sitelib_stem='/sys/lib/perl/5.21.3/site_perl'
+sitelibexp='/sys/lib/perl/5.21.3/site_perl'
siteprefix='/usr'
siteprefixexp='/usr'
sizesize='4'
strerror_r_proto='0'
strings='/sys/include/ape/string.h'
submit=''
-subversion='2'
+subversion='3'
sysman='/sys/man/1pub'
tail=''
tar=''
vendorlibexp=''
vendorprefix=''
vendorprefixexp=''
-version='5.21.2'
-version_patchlevel_string='version 21 subversion 2'
+version='5.21.3'
+version_patchlevel_string='version 21 subversion 3'
versiononly='undef'
vi=''
xlibpth=''
config_argc=0
PERL_REVISION=5
PERL_VERSION=21
-PERL_SUBVERSION=2
+PERL_SUBVERSION=3
PERL_API_REVISION=5
PERL_API_VERSION=21
-PERL_API_SUBVERSION=2
+PERL_API_SUBVERSION=3
PERL_PATCHLEVEL=
PERL_CONFIG_SH=true
/roffitall
# generated
-/perl5212delta.pod
+/perl5213delta.pod
/perlapi.pod
/perlintern.pod
*.html
perlhist Perl history records
perldelta Perl changes since previous version
+ perl5212delta Perl changes in version 5.21.2
perl5211delta Perl changes in version 5.21.1
perl5210delta Perl changes in version 5.21.0
perl5200delta Perl changes in version 5.20.0
--- /dev/null
+=encoding utf8
+
+=head1 NAME
+
+perl5212delta - what is new for perl v5.21.2
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.21.1 release and the 5.21.2
+release.
+
+If you are upgrading from an earlier release such as 5.21.0, first read
+L<perl5211delta>, which describes differences between 5.21.0 and 5.21.1.
+
+=head1 Core Enhancements
+
+=head2 Better heuristics on older platforms for determining locale UTF8ness
+
+On platforms that implement neither the C99 standard nor the POSIX 2001
+standard, determining if the current locale is UTF8 or not depends on
+heuristics. These are improved in this release.
+
+=head1 Security
+
+=head2 Perl is now always compiled with -D_FORTIFY_SOURCE=2 if available
+
+The 'code hardening' option called C<_FORTIFY_SOURCE>, available in
+gcc 4.*, is now always used for compiling Perl, if available.
+
+Note that this isn't necessarily a huge step since in many platforms
+the step had already been taken several years ago: many Linux
+distributions (like Fedora) have been using this option for Perl,
+and OS X has enforced the same for many years.
+
+
+=head1 Deprecations
+
+=head2 C<< /\C/ >> character class
+
+This character class, which matches a single byte, even if it appears
+in a multi-byte character has been deprecated. Matching single bytes
+in a multi-byte character breaks encapsulation, and can corrupt utf8
+strings.
+
+=head1 Performance Enhancements
+
+=over 4
+
+=item *
+
+Refactoring of C<< pp_tied >> and CC<< pp_ref >> for small improvements.
+
+=item *
+
+Pathtools don't try to load XS on miniperl.
+
+=item *
+
+A typo fix reduces the size of the C<< OP >> structure.
+
+=item *
+
+Hash lookups where the key is a constant is faster.
+
+=back
+
+=head1 Modules and Pragmata
+
+=head2 Updated Modules and Pragmata
+
+=over 4
+
+=item *
+
+L<arybase> has been upgraded from version 0.07 to 0.08.
+
+=item *
+
+L<B> has been upgraded from version 1.49 to 1.50.
+
+=item *
+
+L<Devel::Peek> has been upgraded from version 1.17 to 1.18.
+
+=item *
+
+L<experimental> has been upgraded from version 0.007 to 0.008.
+
+=item *
+
+L<ExtUtils::Manifest> has been upgraded from version 1.63 to 1.64.
+
+=item *
+
+L<File::Copy> has been upgraded from version 2.29 to 2.30.
+
+=item *
+
+The PathTools module collection (L<File::Spec> and friends) has been
+upgraded from version 3.48 to 3.49.
+
+=item *
+
+L<Filter::Simple> has been upgraded from version 0.91 to 0.92.
+
+=item *
+
+L<Hash::Util> has been upgraded from version 0.17 to 0.18.
+
+=item *
+
+L<IO> has been upgraded from version 1.32 to 1.33.
+
+=item *
+
+L<IO::Socket::IP> has been upgraded from version 0.29 to 0.31.
+
+A better fix for subclassing C<connect()>.
+L<[cpan #95983]|https://rt.cpan.org/Ticket/Display.html?id=95983>
+L<[cpan #97050]|https://rt.cpan.org/Ticket/Display.html?id=97050>
+
+=item *
+
+L<IPC::Open3> has been upgraded from version 1.16 to 1.17.
+
+=item *
+
+L<Math::BigInt> has been upgraded from version 1.9995 to 1.9996.
+
+Correct handling of subclasses.
+L<[cpan #96254]|https://rt.cpan.org/Ticket/Display.html?id=96254>
+L<[cpan #96329]|https://rt.cpan.org/Ticket/Display.html?id=96329>
+
+=item *
+
+L<Module::CoreList> has been upgraded from version 5.021001_01 to 5.021002.
+
+=item *
+
+L<Pod::Usage> has been upgraded from version 1.63 to 1.64.
+
+=item *
+
+L<POSIX> has been upgraded from version 1.40 to 1.41.
+
+=item *
+
+L<threads> has been upgraded from version 1.94 to 1.95.
+
+=item *
+
+L<warnings> has been upgraded from version 1.24 to 1.26.
+
+=back
+
+=head1 Documentation
+
+=head2 Changes to Existing Documentation
+
+=head3 L<< perlpolicy >>
+
+=over 4
+
+=item *
+
+We now have a code of conduct for the I<< p5p >> mailing list, as documented
+in L<< perlpolicy/STANDARDS OF CONDUCT >>.
+
+=back
+
+=head3 L<< perlfunc >>
+
+=over 4
+
+=item *
+
+Improve documentation of C<< our >>.
+
+=back
+
+=head3 L<< perlsyn >>
+
+=over 4
+
+=item *
+
+The empty conditional in C<< for >> and C<< while >> is now documented
+in L<< perlsyn >>.
+
+=back
+
+=head1 Diagnostics
+
+=head2 New Diagnostics
+
+=head3 New Warnings
+
+=over 4
+
+=item *
+
+L<Argument "%s" treated as 0 in increment (++)|perldiag/"Argument "%s" treated
+as 0 in increment (++)">
+
+(W numeric) The indicated string was fed as an argument to the C<++> operator
+which expects either a number or a string matching C</^[a-zA-Z]*[0-9]*\z/>.
+See L<perlop/Auto-increment and Auto-decrement> for details.
+
+=item *
+
+L<Redundant argument in %s|perldiag/Redundant argument in %s>
+
+(W redundant) You called a function with more arguments than other
+arguments you supplied indicated would be needed. Currently only
+emitted when a printf-type format required fewer arguments than were
+supplied, but might be used in the future for e.g. L<perlfunc/pack>.
+
+The warnings category C<< redundant >> is new. See also [RT #121025]
+
+=back
+
+=head1 Configuration and Compilation
+
+=over 4
+
+=item *
+
+A new compilation flag, C<< -DPERL_OP_PARENT >> is available. For details,
+see the discussion below at L<< /Internal Changes >>.
+
+=back
+
+=head1 Testing
+
+=over 4
+
+=item *
+
+C<< test.pl >> now allows C<< plan skip_all => $reason >>, to make it
+more compatible with C<< Test::More >>.
+
+=back
+
+=head1 Platform Support
+
+=head2 Platform-Specific Notes
+
+=over 4
+
+=item Solaris
+
+Builds on Solaris 10 with C<-Dusedtrace> would fail early since make
+didn't follow implied dependencies to build C<perldtrace.h>. Added an
+explicit dependency to C<depend>.
+L<[perl #120120]|https://rt.perl.org/Ticket/Display.html?id=120120>
+
+=back
+
+=head1 Internal Changes
+
+=over 4
+
+=item *
+
+The following private API functions had their context parameter removed,
+C<Perl_cast_ulong>, C<Perl_cast_i32>, C<Perl_cast_iv>, C<Perl_cast_uv>,
+C<Perl_cv_const_sv>, C<Perl_mg_find>, C<Perl_mg_findext>, C<Perl_mg_magical>,
+C<Perl_mini_mktime>, C<Perl_my_dirfd>, C<Perl_sv_backoff>, C<Perl_utf8_hop>.
+
+Users of the public API prefix-less calls remain unaffected.
+
+=item *
+
+Experimental support for ops in the optree to be able to locate their
+parent, if any. A general-purpose function, C<< op_sibling_splice() >>
+allows for general manipulating an C<< op_sibling >> chain. The last op
+in such a chain is now marked with the field C<< op_lastsib >>.
+
+A new build define, C<< -DPERL_OP_PARENT >> has been added; if
+given, it forces the core to use C<< op_lastsib >> to detect the
+last sibling in a chain, freeing the last C<< op_sibling >> pointer,
+which then points back to the parent (instead of being C<< NULL >>).
+
+A C-level C<< op_parent() >> function, and a C<< B >> C<< parent() >> method
+have been added; under a default build, they return C<< NULL >>, but when
+C<< -DPERL_OP_PARENT >> has been set, they return the parent of the current op.
+
+=back
+
+=head1 Selected Bug Fixes
+
+=over 4
+
+=item *
+
+C<< s///e >> on tainted utf8 strings got C<< pos() >> messed up. This bug,
+introduced in 5.20, is now fixed. [RT #122148]
+
+=item *
+
+A non-word boundary in a regular expression (C<< \B >>) did not always
+match the end of the string; in particular C<< q{} =~ /\B/ >> did not
+match. This bug, introduced in perl 5.14, is now fixed. [RT #122090]
+
+=item *
+
+C<< " P" =~ /(?=.*P)P/ >> should match, but did not. This is now fixed.
+[RT #122171].
+
+=back
+
+=head1 Acknowledgements
+
+Perl 5.21.2 represents approximately 4 weeks of development since Perl 5.21.1
+and contains approximately 11,000 lines of changes across 220 files from 27
+authors.
+
+Excluding auto-generated files, documentation and release tools, there were
+approximately 5,700 lines of changes to 140 .pm, .t, .c and .h files.
+
+Perl continues to flourish into its third decade thanks to a vibrant community
+of users and developers. The following people are known to have contributed the
+improvements that became Perl 5.21.2:
+
+Aaron Crane, Abhijit Menon-Sen, Abigail, Alexandr Ciornii, brian d foy, Brian
+Fraser, Chris 'BinGOs' Williams, Craig A. Berry, Daniel Dragan, David Golden,
+David Mitchell, Dmitri Tikhonov, George Greer, H.Merijn Brand, James E Keenan,
+Jarkko Hietaniemi, Karen Etheridge, Karl Williamson, Matthew Horsfall, Peter
+John Acklam, Peter Martini, Reini Urban, Ricardo Signes, Steve Hay, Tony Cook,
+Yves Orton, Ævar Arnfjörð Bjarmason.
+
+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 articles recently
+posted to the comp.lang.perl.misc newsgroup and the perl bug database at
+https://rt.perl.org/ . There may also be information at
+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 please send it
+to perl5-security-report@perl.org. This points to a closed subscription
+unarchived mailing list, which includes all the core committers, who will be
+able to help assess the impact of issues, figure out a resolution, and help
+co-ordinate the release of patches to mitigate or fix the problem across all
+platforms on which Perl is supported. Please only use this address for
+security issues in the Perl core, not for modules independently distributed on
+CPAN.
+
+=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
Instead Of: Use:
atof(s) Atof(s)
- atol(s) Atol(s)
+ atoi(s) grok_atou(s, &e)
+ atol(s) grok_atou(s, &e)
strtod(s, &p) Nothing. Just don't use it.
- strtol(s, &p, n) Strtol(s, &p, n)
- strtoul(s, &p, n) Strtoul(s, &p, n)
+ strtol(s, &p, n) grok_atou(s, &e)
+ strtoul(s, &p, n) grok_atou(s, &e)
Notice also the C<grok_bin>, C<grok_hex>, and C<grok_oct> functions in
F<numeric.c> for converting strings representing numbers in the respective
-bases into C<NV>s.
+bases into C<NV>s. Note that grok_atou() doesn't handle negative inputs,
+or leading whitespace (being purposefully strict).
+
+Note that strtol() and strtoul() may be disguised as Strtol(), Strtoul(),
+Atol(), Atoul(). Avoid those, too.
In theory C<Strtol> and C<Strtoul> may not be defined if the machine perl is
built on doesn't actually have strtol and strtoul. But as those 2
PL_srand_called = TRUE; }
exit(n) my_exit(n)
- system(s) Don't. Look at pp_system or use my_popen
+ system(s) Don't. Look at pp_system or use my_popen.
getenv(s) PerlEnv_getenv(s)
setenv(s, val) my_putenv(s, val)
Numeric literals are specified in any of the following floating point or
integer formats:
- 12345
- 12345.67
- .23E-10 # a very small number
- 3.14_15_92 # a very important number
- 4_294_967_296 # underscore for legibility
- 0xff # hex
- 0xdead_beef # more hex
- 0377 # octal (only numbers, begins with 0)
- 0b011011 # binary
+ 12345
+ 12345.67
+ .23E-10 # a very small number
+ 3.14_15_92 # a very important number
+ 4_294_967_296 # underscore for legibility
+ 0xff # hex
+ 0xdead_beef # more hex
+ 0377 # octal (only numbers, begins with 0)
+ 0b011011 # binary
+ 0x1.999ap-4 # hexadecimal floating point (the 'p' is required)
You are allowed to use underscores (underbars) in numeric literals
between digits for legibility (but not multiple underscores in a row:
representation. The hex() and oct() functions make these conversions
for you. See L<perlfunc/hex> and L<perlfunc/oct> for more details.
+Hexadecimal floating point can start just like a hexadecimal literal,
+and it can be followed by an optional fractional hexadecimal part,
+but it must be followed by C<p>, an optional sign, and a power of two.
+The format is useful for accurately presenting floating point values,
+avoiding conversions to or from decimal floating point, and therefore
+avoiding possible loss in precision. Notice that while most current
+platforms use the 64-bit IEEE 754 floating point, not all do.
+
You can also embed newlines directly in your strings, i.e., they can end
on a different line than they begin. This is nice, but if you forget
your trailing quote, the error will not be reported until Perl finds
=head1 NAME
-perldelta - what is new for perl v5.21.2
+perldelta - what is new for perl v5.21.3
=head1 DESCRIPTION
-This document describes differences between the 5.21.1 release and the 5.21.2
+This document describes differences between the 5.21.2 release and the 5.21.3
release.
-If you are upgrading from an earlier release such as 5.21.0, first read
-L<perl5211delta>, which describes differences between 5.21.0 and 5.21.1.
+If you are upgrading from an earlier release such as 5.21.1, first read
+L<perl5212delta>, which describes differences between 5.21.1 and 5.21.2.
=head1 Core Enhancements
-=head2 Better heuristics on older platforms for determining locale UTF8ness
+=head2 C<defined(@array = LIST)> is no longer fatal
-On platforms that implement neither the C99 standard nor the POSIX 2001
-standard, determining if the current locale is UTF8 or not depends on
-heuristics. These are improved in this release.
+In 5.21.1, C<defined(@array)> was made fatal. This has been relaxed
+to not die if the argument is assigning to an array.
-=head1 Security
+=head2 Floating point parsing has been improved
-=head2 Perl is now always compiled with -D_FORTIFY_SOURCE=2 if available
+Parsing and printing of floating point values has been improved.
-The 'code hardening' option called C<_FORTIFY_SOURCE>, available in
-gcc 4.*, is now always used for compiling Perl, if available.
+As a completely new feature, hexadecimal floating point literals
+(like 0x1.23p-4) are now supported, and they can be output with
+C<printf %a>.
-Note that this isn't necessarily a huge step since in many platforms
-the step had already been taken several years ago: many Linux
-distributions (like Fedora) have been using this option for Perl,
-and OS X has enforced the same for many years.
+=head1 Security
+=head2 The L<Safe> module could allow outside packages to be replaced
-=head1 Deprecations
+Critical bugfix: outside packages could be replaced. L<Safe> has
+been patched to 2.38 to address this.
-=head2 C<< /\C/ >> character class
+=head1 Incompatible Changes
-This character class, which matches a single byte, even if it appears
-in a multi-byte character has been deprecated. Matching single bytes
-in a multi-byte character breaks encapsulation, and can corrupt utf8
-strings.
+=head2 S<C<use UNIVERSAL '...'>> is now a fatal error
-=head1 Performance Enhancements
+Importing functions from C<UNIVERSAL> has been deprecated since v5.12, and
+is now a fatal error. S<C<"use UNIVERSAL">> without any arguments is still
+allowed.
+
+=head1 Modules and Pragmata
+
+=head2 Updated Modules and Pragmata
=over 4
=item *
-Refactoring of C<< pp_tied >> and CC<< pp_ref >> for small improvements.
+L<B::Debug> has been upgraded from version 1.19 to 1.21.
=item *
-Pathtools don't try to load XS on miniperl.
+L<Config::Perl::V> has been upgraded from version 0.20 to 0.22.
=item *
-A typo fix reduces the size of the C<< OP >> structure.
+L<CPAN::Meta> has been upgraded from version 2.141520 to 2.142060.
=item *
-Hash lookups where the key is a constant is faster.
+L<CPAN::Meta::Requirements> has been upgraded from version 2.125 to 2.126.
-=back
+=item *
-=head1 Modules and Pragmata
+L<ExtUtils::CBuilder> was moved from F<dist> to F<cpan>.
-=head2 Updated Modules and Pragmata
+=item *
-=over 4
+L<ExtUtils::CBuilder> has been upgraded from version 0.280216 to 0.280217.
=item *
-L<arybase> has been upgraded from version 0.07 to 0.08.
+L<ExtUtils::Install> was moved from F<dist> to F<cpan>.
=item *
-L<B> has been upgraded from version 1.49 to 1.50.
+L<ExtUtils::Manifest> has been upgraded from version 1.64 to 1.65.
+It was also moved from F<dist> to F<cpan>.
=item *
-L<Devel::Peek> has been upgraded from version 1.17 to 1.18.
+L<HTTP::Tiny> has been upgraded from version 0.043 to 0.047.
=item *
-L<experimental> has been upgraded from version 0.007 to 0.008.
+L<IPC::Open3> has been upgraded from version 1.17 to 1.18.
=item *
-L<ExtUtils::Manifest> has been upgraded from version 1.63 to 1.64.
+L<Module::CoreList> has been upgraded from version 5.021002 to 5.021003.
=item *
-L<File::Copy> has been upgraded from version 2.29 to 2.30.
+L<Opcode> has been upgraded from version 1.27 to 1.28.
=item *
-The PathTools module collection (L<File::Spec> and friends) has been
-upgraded from version 3.48 to 3.49.
+L<perl5db.pl> has been upgraded from version 1.45 to 1.46.
=item *
-L<Filter::Simple> has been upgraded from version 0.91 to 0.92.
+L<perlfaq> has been upgraded from version 5.0150044 to 5.0150045.
=item *
-L<Hash::Util> has been upgraded from version 0.17 to 0.18.
+L<POSIX> has been upgraded from version 1.41 to 1.42.
=item *
-L<IO> has been upgraded from version 1.32 to 1.33.
+L<Safe> has been upgraded from version 2.37 to 2.38.
=item *
-L<IO::Socket::IP> has been upgraded from version 0.29 to 0.31.
-
-A better fix for subclassing C<connect()>.
-L<[cpan #95983]|https://rt.cpan.org/Ticket/Display.html?id=95983>
-L<[cpan #97050]|https://rt.cpan.org/Ticket/Display.html?id=97050>
+L<Socket> has been upgraded from version 2.014 to 2.015.
=item *
-L<IPC::Open3> has been upgraded from version 1.16 to 1.17.
+L<Sys::Hostname> has been upgraded from version 1.18 to 1.19
=item *
-L<Math::BigInt> has been upgraded from version 1.9995 to 1.9996.
+L<UNIVERSAL> has been upgraded from version 1.11 to 1.12.
-Correct handling of subclasses.
-L<[cpan #96254]|https://rt.cpan.org/Ticket/Display.html?id=96254>
-L<[cpan #96329]|https://rt.cpan.org/Ticket/Display.html?id=96329>
+=back
-=item *
+=head1 Documentation
-L<Module::CoreList> has been upgraded from version 5.021001_01 to 5.021002.
+=head2 Changes to Existing Documentation
-=item *
+=head3 L<perlexperiment>
-L<Pod::Usage> has been upgraded from version 1.63 to 1.64.
+=over 4
=item *
-L<POSIX> has been upgraded from version 1.40 to 1.41.
+Added reference to L<feature>.
-=item *
+=back
-L<threads> has been upgraded from version 1.94 to 1.95.
+=head3 L<perlguts>
+
+=over 4
=item *
-L<warnings> has been upgraded from version 1.24 to 1.26.
+Details on C level symbols and libperl.t added.
=back
-=head1 Documentation
+=head3 L<perlhacktips>
-=head2 Changes to Existing Documentation
+=over 4
+
+=item *
+
+Recommended replacements for tmpfile, atoi, strtol, and strtoul added.
-=head3 L<< perlpolicy >>
+=back
+
+=head3 L<perlop>
=over 4
=item *
-We now have a code of conduct for the I<< p5p >> mailing list, as documented
-in L<< perlpolicy/STANDARDS OF CONDUCT >>.
+ASCII v. EBCDIC clarifications added.
=back
-=head3 L<< perlfunc >>
+=head3 L<perlsec>
=over 4
=item *
-Improve documentation of C<< our >>.
+Comments added on algorithmic complexity and tied hashes.
=back
-=head3 L<< perlsyn >>
+=head3 L<perlvms>
=over 4
=item *
-The empty conditional in C<< for >> and C<< while >> is now documented
-in L<< perlsyn >>.
+Updated documentation on environment and shell interaction in VMS.
=back
=head1 Diagnostics
+The following additions or changes have been made to diagnostic output,
+including warnings and fatal error messages. For the complete list of
+diagnostic messages, see L<perldiag>.
+
=head2 New Diagnostics
+=head3 New Errors
+
+=over 4
+
+=item *
+
+L<Hexadecimal float: internal error|perldiag/"Hexadecimal float: internal error">
+
+(F) Something went horribly bad in hexadecimal float handling.
+
+=item *
+
+L<Hexadecimal float: unsupported long double format|perldiag/"Hexadecimal float: unsupported long double format">
+
+(F) You have configured Perl to use long doubles but
+the internals of the long double format are unknown,
+therefore the hexadecimal float output is impossible.
+
+=back
+
=head3 New Warnings
=over 4
=item *
-L<Argument "%s" treated as 0 in increment (++)|perldiag/"Argument "%s" treated
-as 0 in increment (++)">
+L<Hexadecimal float: exponent overflow|perldiag/"Hexadecimal float: exponent overflow">
+
+(W overflow) The hexadecimal floating point has larger exponent
+than the floating point supports.
+
+=item *
+
+L<Hexadecimal float: exponent underflow|perldiag/"Hexadecimal float: exponent underflow">
-(W numeric) The indicated string was fed as an argument to the C<++> operator
-which expects either a number or a string matching C</^[a-zA-Z]*[0-9]*\z/>.
-See L<perlop/Auto-increment and Auto-decrement> for details.
+(W overflow) The hexadecimal floating point has smaller exponent
+than the floating point supports.
=item *
-L<Redundant argument in %s|perldiag/Redundant argument in %s>
+L<Hexadecimal float: mantissa overflow|perldiag/"Hexadecimal float: mantissa overflow">
-(W redundant) You called a function with more arguments than other
-arguments you supplied indicated would be needed. Currently only
-emitted when a printf-type format required fewer arguments than were
-supplied, but might be used in the future for e.g. L<perlfunc/pack>.
+(W overflow) The hexadecimal floating point literal had more bits in
+the mantissa (the part between the 0x and the exponent, also known as
+the fraction or the significand) than the floating point supports.
-The warnings category C<< redundant >> is new. See also [RT #121025]
+=item *
+
+L<Hexadecimal float: precision loss|perldiag/"Hexadecimal float: precision loss">
+
+(W overflow) The hexadecimal floating point had internally more
+digits than could be output. This can be caused by unsupported
+long double formats, or by 64-bit integers not being available
+(needed to retrieve the digits under some configurations).
=back
-=head1 Configuration and Compilation
+=head2 Changes to Existing Diagnostics
=over 4
=item *
-A new compilation flag, C<< -DPERL_OP_PARENT >> is available. For details,
-see the discussion below at L<< /Internal Changes >>.
+C<require> with no argument or undef used to warn about a Null filename; now
+it dies with C<Missing or undefined argument to require>.
=back
-=head1 Testing
+=head1 Configuration and Compilation
=over 4
=item *
-C<< test.pl >> now allows C<< plan skip_all => $reason >>, to make it
-more compatible with C<< Test::More >>.
+MurmurHash64A and MurmurHash64B can now be configured as the internal hash
+function.
=back
=over 4
+=item Android
+
+Build support has been improved for cross-compiling in general and for
+Android in particular.
+
=item Solaris
-Builds on Solaris 10 with C<-Dusedtrace> would fail early since make
-didn't follow implied dependencies to build C<perldtrace.h>. Added an
-explicit dependency to C<depend>.
-L<[perl #120120]|https://rt.perl.org/Ticket/Display.html?id=120120>
+C<c99> options have been cleaned up, hints look for C<solstudio>
+as well as C<SUNWspro>, and support for native C<setenv> has been added.
+
+=item VMS
+
+C<finite>, C<finitel>, and C<isfinite> detection has been added to
+C<configure.com>, environment handling has had some minor changes, and
+a fix for legacy feature checking status.
+
+=item Windows
+
+C<%I64d> is now being used instead of C<%lld> for MinGW.
=back
=item *
-The following private API functions had their context parameter removed,
-C<Perl_cast_ulong>, C<Perl_cast_i32>, C<Perl_cast_iv>, C<Perl_cast_uv>,
-C<Perl_cv_const_sv>, C<Perl_mg_find>, C<Perl_mg_findext>, C<Perl_mg_magical>,
-C<Perl_mini_mktime>, C<Perl_my_dirfd>, C<Perl_sv_backoff>, C<Perl_utf8_hop>.
-
-Users of the public API prefix-less calls remain unaffected.
+Added L<perlapi/sync_locale>.
+Changing the program's locale should be avoided by XS code. Nevertheless,
+certain non-Perl libraries called from XS, such as C<Gtk> do so. When this
+happens, Perl needs to be told that the locale has changed. Use this function
+to do so, before returning to Perl.
=item *
-Experimental support for ops in the optree to be able to locate their
-parent, if any. A general-purpose function, C<< op_sibling_splice() >>
-allows for general manipulating an C<< op_sibling >> chain. The last op
-in such a chain is now marked with the field C<< op_lastsib >>.
-
-A new build define, C<< -DPERL_OP_PARENT >> has been added; if
-given, it forces the core to use C<< op_lastsib >> to detect the
-last sibling in a chain, freeing the last C<< op_sibling >> pointer,
-which then points back to the parent (instead of being C<< NULL >>).
-
-A C-level C<< op_parent() >> function, and a C<< B >> C<< parent() >> method
-have been added; under a default build, they return C<< NULL >>, but when
-C<< -DPERL_OP_PARENT >> has been set, they return the parent of the current op.
+Added L<perlapi/grok_atou> as a safer replacement for atoi and strtol.
=back
=item *
-C<< s///e >> on tainted utf8 strings got C<< pos() >> messed up. This bug,
-introduced in 5.20, is now fixed. [RT #122148]
+Failing to compile C<use Foo> in an eval could leave a spurious
+C<BEGIN> subroutine definition, which would produce a "Subroutine
+BEGIN redefined" warning on the next use of C<use>, or other C<BEGIN>
+block. [perl #122107]
+
+=item *
+
+C<method { BLOCK } ARGS> syntax now correctly parses the arguments if they
+begin with an opening brace. [perl #46947]
=item *
-A non-word boundary in a regular expression (C<< \B >>) did not always
-match the end of the string; in particular C<< q{} =~ /\B/ >> did not
-match. This bug, introduced in perl 5.14, is now fixed. [RT #122090]
+External libraries and Perl may have different ideas of what the locale is.
+This is problematic when parsing version strings if the locale's numeric
+separator has been changed. Version parsing has been patched to ensure
+it handles the locales correctly. [perl #121930]
=item *
-C<< " P" =~ /(?=.*P)P/ >> should match, but did not. This is now fixed.
-[RT #122171].
+A bug has been fixed where zero-length assertions and code blocks inside of a
+regex could cause C<pos> to see an incorrect value. [perl #122460]
=back
=head1 Acknowledgements
-Perl 5.21.2 represents approximately 4 weeks of development since Perl 5.21.1
-and contains approximately 11,000 lines of changes across 220 files from 27
+Perl 5.21.3 represents approximately 4 weeks of development since Perl 5.21.2
+and contains approximately 21,000 lines of changes across 250 files from 25
authors.
Excluding auto-generated files, documentation and release tools, there were
-approximately 5,700 lines of changes to 140 .pm, .t, .c and .h files.
+approximately 18,000 lines of changes to 160 .pm, .t, .c and .h files.
Perl continues to flourish into its third decade thanks to a vibrant community
of users and developers. The following people are known to have contributed the
-improvements that became Perl 5.21.2:
-
-Aaron Crane, Abhijit Menon-Sen, Abigail, Alexandr Ciornii, brian d foy, Brian
-Fraser, Chris 'BinGOs' Williams, Craig A. Berry, Daniel Dragan, David Golden,
-David Mitchell, Dmitri Tikhonov, George Greer, H.Merijn Brand, James E Keenan,
-Jarkko Hietaniemi, Karen Etheridge, Karl Williamson, Matthew Horsfall, Peter
-John Acklam, Peter Martini, Reini Urban, Ricardo Signes, Steve Hay, Tony Cook,
-Yves Orton, Ævar Arnfjörð Bjarmason.
+improvements that became Perl 5.21.3:
+
+Aaron Crane, Abigail, Alberto Simões, Andy Dougherty, Brian Fraser, Chad
+Granum, Chris 'BinGOs' Williams, Craig A. Berry, Dagfinn Ilmari Mannsåker,
+Daniel Dragan, David Mitchell, Father Chrysostomos, H.Merijn Brand, James E
+Keenan, Jan Dubois, Jarkko Hietaniemi, Karen Etheridge, Karl Williamson, Lukas
+Mai, Peter Martini, Rafael Garcia-Suarez, syber, Tony Cook, Vladimir Marek,
+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
C</^[a-zA-Z]*[0-9]*\z/>. See L<perlop/Auto-increment and
Auto-decrement> for details.
-=item charnames alias definitions may not contain a sequence of multiple spaces
-
-(F) You defined a character name which had multiple space
-characters in a row. Change them to single spaces. Usually these
-names are defined in the C<:alias> import argument to C<use charnames>, but
-they could be defined by a translator installed into C<$^H{charnames}>.
-See L<charnames/CUSTOM ALIASES>.
-
-=item charnames alias definitions may not contain trailing white-space
-
-(F) You defined a character name which ended in a space
-character. Remove the trailing space(s). Usually these names are
-defined in the C<:alias> import argument to C<use charnames>, but they
-could be defined by a translator installed into C<$^H{charnames}>.
-See L<charnames/CUSTOM ALIASES>.
-
=item assertion botched: %s
(X) The malloc package that comes with Perl had an internal failure.
must either both be scalars or both be lists. Otherwise Perl won't
know which context to supply to the right side.
+=item <> at require-statement should be quotes
+
+(F) You wrote C<< require <file> >> when you should have written
+C<require 'file'>.
+
=item Attempt to access disallowed key '%s' in a restricted hash
(F) The failing code has attempted to get or set a key which is not in
iterate over %ENV, it encountered a logical name or symbol definition
which was too long, so it was truncated to the string shown.
-=item \C is deprecated in regex; marked by <-- HERE in m/%s/
-
-(D deprecated, regexp) The \C character class is deprecated, and will
-become a compile-time error in a future release of perl (tentatively
-v5.24). This construct allows you to match a single byte of what makes up
-a multi-byte single UTF8 character, and breaks encapsulation. It is
-currently also very buggy. If you really need to process the individual
-bytes, you probably want to convert your string to one where each
-underlying byte is stored as a character, with utf8::encode().
-
=item Callback called exit
(F) A subroutine invoked from an external package via call_sv()
=item Can't use a hash as a reference
(F) You tried to use a hash as a reference, as in
-C<< %foo->{"bar"} >> or C<< %$ref->{"hello"} >>. Versions of perl <= 5.6.1
-used to allow this syntax, but shouldn't have.
+C<< %foo->{"bar"} >> or C<< %$ref->{"hello"} >>. Versions of perl
+<= 5.22.0 used to allow this syntax, but shouldn't
+have. This was deprecated in perl 5.6.1.
=item Can't use an array as a reference
(F) You tried to use an array as a reference, as in
-C<< @foo->[23] >> or C<< @$ref->[99] >>. Versions of perl <= 5.6.1 used to
-allow this syntax, but shouldn't have.
+C<< @foo->[23] >> or C<< @$ref->[99] >>. Versions of perl <= 5.22.0
+used to allow this syntax, but shouldn't have. This
+was deprecated in perl 5.6.1.
=item Can't use anonymous symbol table for method lookup
unpack("s", "\x{f3}b")
+=item charnames alias definitions may not contain a sequence of multiple spaces
+
+(F) You defined a character name which had multiple space characters
+in a row. Change them to single spaces. Usually these names are
+defined in the C<:alias> import argument to C<use charnames>, but they
+could be defined by a translator installed into C<$^H{charnames}>. See
+L<charnames/CUSTOM ALIASES>.
+
+=item charnames alias definitions may not contain trailing white-space
+
+(F) You defined a character name which ended in a space
+character. Remove the trailing space(s). Usually these names are
+defined in the C<:alias> import argument to C<use charnames>, but they
+could be defined by a translator installed into C<$^H{charnames}>.
+See L<charnames/CUSTOM ALIASES>.
+
+=item \C is deprecated in regex; marked by <-- HERE in m/%s/
+
+(D deprecated, regexp) The \C character class is deprecated, and will
+become a compile-time error in a future release of perl (tentatively
+v5.24). This construct allows you to match a single byte of what makes up
+a multi-byte single UTF8 character, and breaks encapsulation. It is
+currently also very buggy. If you really need to process the individual
+bytes, you probably want to convert your string to one where each
+underlying byte is stored as a character, with utf8::encode().
+
=item "\c%c" is more clearly written simply as "%s"
(W syntax) The C<\cI<X>> construct is intended to be a way to specify
=item %s: Command not found
(A) You've accidentally run your script through B<csh> or another shell
-instead of Perl. Check the #! line, or manually feed your script
-into Perl yourself. The #! line at the top of your file could look like
+instead of Perl. Check the #! line, or manually feed your script into
+Perl yourself. The #! line at the top of your file could look like
#!/usr/bin/perl -w
(F) The parser has given up trying to parse the program after 10 errors.
Further error messages would likely be uninformative.
+=item Hexadecimal float: exponent overflow
+
+(W overflow) The hexadecimal floating point has larger exponent
+than the floating point supports.
+
+=item Hexadecimal float: exponent underflow
+
+(W overflow) The hexadecimal floating point has smaller exponent
+than the floating point supports.
+
+=item Hexadecimal float: internal error
+
+(F) Something went horribly bad in hexadecimal float handling.
+
+=item Hexadecimal float: mantissa overflow
+
+(W overflow) The hexadecimal floating point literal had more bits in
+the mantissa (the part between the 0x and the exponent, also known as
+the fraction or the significand) than the floating point supports.
+
+=item Hexadecimal float: precision loss
+
+(W overflow) The hexadecimal floating point had internally more
+digits than could be output. This can be caused by unsupported
+long double formats, or by 64-bit integers not being available
+(needed to retrieve the digits under some configurations).
+
+=item Hexadecimal float: unsupported long double format
+
+(F) You have configured Perl to use long doubles but
+the internals of the long double format are unknown,
+therefore the hexadecimal float output is impossible.
+
=item Hexadecimal number > 0xffffffff non-portable
(W portable) The hexadecimal number you specified is larger than 2**32-1
function, i.e. C<\p{IsFoo}> or C<\p{InFoo}>.
See L<perlunicode/User-Defined Character Properties> and L<perlsec>.
-=item In '(?...)', the '(' and '?' must be adjacent in regex;
-marked by S<<-- HERE> in m/%s/
-
-(F) The two-character sequence C<"(?"> in
-this context in a regular expression pattern should be an
-indivisible token, with nothing intervening between the C<"(">
-and the C<"?">, but you separated them.
-
=item Integer overflow in format string for %s
(F) The indexes and widths specified in the format string of C<printf()>
operators arguments found inside the parentheses. See
L<perlop/Terms and List Operators (Leftward)>.
+=item In '(?...)', the '(' and '?' must be adjacent in regex;
+marked by S<<-- HERE> in m/%s/
+
+(F) The two-character sequence C<"(?"> in this context in a regular
+expression pattern should be an indivisible token, with nothing
+intervening between the C<"("> and the C<"?">, but you separated them
+with whitespace.
+
=item Invalid %s attribute: %s
(F) The indicated attribute for a subroutine or variable was not recognized
other cases where we can statically determine that arguments to
functions are missing, e.g. for the L<perlfunc/pack> function.
-=item Redundant argument in %s
-
-(W redundant) You called a function with more arguments than other
-arguments you supplied indicated would be needed. Currently only
-emitted when a printf-type format required fewer arguments than were
-supplied, but might be used in the future for e.g. L<perlfunc/pack>.
-
=item Missing argument to -%c
(F) The argument to the indicated command line switch must follow
(S syntax) This is an educated guess made in conjunction with the message
"%s found where operator expected". Often the missing operator is a comma.
+=item Missing or undefined argument to require
+
+(F) You tried to call require with no argument or with an undefined
+value as an argument. Require expects either a package name or a
+file-specification as an argument. See L<perlfunc/require>.
+
=item Missing right brace on \%c{} in regex; marked by S<<-- HERE> in m/%s/
(F) Missing right brace in C<\x{...}>, C<\p{...}>, C<\P{...}>, or C<\N{...}>.
just mention it again somehow to suppress the message. The C<our>
declaration is also provided for this purpose.
-NOTE: This warning detects package symbols that have been used only
-once. This means lexical variables will never trigger this warning.
-It also means that all of the package variables $c, @c, %c, as well
-as *c, &c, sub c{}, c(), and c (the filehandle or
+NOTE: This warning detects package symbols that have been used
+only once. This means lexical variables will never trigger this
+warning. It also means that all of the package variables $c, @c,
+%c, as well as *c, &c, sub c{}, c(), and c (the filehandle or
format) are considered the same; if a program uses $c only once
but also uses any of the others it will not trigger this warning.
Symbols beginning with an underscore and symbols using special
F<SYS$TIMEZONE_DIFFERENTIAL> to translate to the number of seconds which
need to be added to UTC to get local time.
-=item Null filename used
-
-(F) You can't require the null filename, especially because on many
-machines that means the current directory! See L<perlfunc/require>.
-
=item NULL OP IN RUN
(S debugging) Some internal routine called run() with a null opcode
folding rules are not accurate. This may lead to incorrect results.
Please report this as a bug using the L<perlbug> utility.
+=item PerlIO layer ':win32' is experimental
+
+(S experimental::win32_perlio) The C<:win32> PerlIO layer is
+experimental. If you want to take the risk of using this layer,
+simply disable this warning:
+
+ no warnings "experimental::win32_perlio";
+
=item Perl_my_%s() not available
(F) Your platform has very uncommon byte-order and integer size,
Both numeric and string values are accepted, but note that string values are
case sensitive. The default for this setting is "RANDOM" or 1.
-=item PerlIO layer ':win32' is experimental
-
-(S experimental::win32_perlio) The C<:win32> PerlIO layer is
-experimental. If you want to take the risk of using this layer,
-simply disable this warning:
-
- no warnings "experimental::win32_perlio";
-
=item pid %x not a child
(W exec) A warning peculiar to VMS. Waitpid() was asked to wait for a
believes it found an infinite loop in the C<@ISA> hierarchy. This is a
crude check that bails out after 100 levels of C<@ISA> depth.
+=item Redundant argument in %s
+
+(W redundant) You called a function with more arguments than other
+arguments you supplied indicated would be needed. Currently only
+emitted when a printf-type format required fewer arguments than were
+supplied, but might be used in the future for e.g. L<perlfunc/pack>.
+
=item refcnt_dec: fd %d%s
=item refcnt: fd %d%s
interpreted as the != (numeric not equal) and ~ (1's complement)
operators: probably not what you intended.
-=item <> at require-statement should be quotes
-
-(F) You wrote C<< require <file> >> when you should have written
-C<require 'file'>.
-
=item /%s/ should probably be written as "%s"
(W syntax) You have used a pattern where Perl expected to find a string,
marked by <-- HERE in m/%s/
(D deprecated, regexp) You used a literal C<"{"> character in a regular
-expression pattern. You should change to use C<"\{"> instead, because a future
-version of Perl (tentatively v5.26) will consider this to be a syntax error. If
-the pattern delimiters are also braces, any matching right brace
-(C<"}">) should also be escaped to avoid confusing the parser, for
-example,
+expression pattern. You should change to use C<"\{"> instead, because a
+future version of Perl (tentatively v5.26) will consider this to be a
+syntax error. If the pattern delimiters are also braces, any matching
+right brace (C<"}">) should also be escaped to avoid confusing the parser,
+for example,
qr{abc\{def\}ghi}
=item Unicode non-character U+%X is illegal for open interchange
(S nonchar) Certain codepoints, such as U+FFFE and U+FFFF, are
-defined by the Unicode standard to be non-characters. Those are
-legal codepoints, but are reserved for internal use; so, applications
-shouldn't attempt to exchange them. An application may not be
-expecting any of these characters at all, and receiving them
-may lead to bugs. If you know what you are doing
-you can turn off this warning by C<no warnings 'nonchar';>.
-
-This is not really a "serious" error, but it is supposed to be raised
-by default even if warnings are not enabled, and currently the only
-way to do that in Perl is to mark it as serious.
+defined by the Unicode standard to be non-characters. Those
+are legal codepoints, but are reserved for internal use; so,
+applications shouldn't attempt to exchange them. An application
+may not be expecting any of these characters at all, and receiving
+them may lead to bugs. If you know what you are doing you can
+turn off this warning by C<no warnings 'nonchar';>.
+
+This is not really a "severe" error, but it is supposed to be
+raised by default even if warnings are not enabled, and currently
+the only way to do that in Perl is to mark it as serious.
=item Unicode surrogate U+%X is illegal in UTF-8
=back
+=head1 SEE ALSO
+
+For a complete list of features check L<feature>.
+
=head1 AUTHORS
brian d foy C<< <brian.d.foy@gmail.com> >>
delete $hash{$key}; # This is safe
}
+Tied hashes may have a different ordering behaviour to perl's hash
+implementation.
+
This prints out your environment like the printenv(1) program,
but in a different order:
as each other. See L<perlsec/"Algorithmic Complexity Attacks"> for
details on why hash order is randomized. Aside from the guarantees
provided here the exact details of Perl's hash algorithm and the hash
-traversal order are subject to change in any release of Perl.
+traversal order are subject to change in any release of Perl. Tied hashes
+may behave differently to Perl's hashes with respect to changes in order on
+insertion and deletion of items.
As a side effect, calling keys() resets the internal iterator of the HASH or
ARRAY (see L</each>). In particular, calling keys() in void context resets
%p a pointer (outputs the Perl value's address in hexadecimal)
%n special: *stores* the number of characters output so far
into the next argument in the parameter list
+ %a hexadecimal floating point
+ %A like %a, but using upper-case letters
Finally, for backward (and we do mean "backward") compatibility, Perl
permits these unnecessary but widely-supported conversions:
by C<%e>, C<%E>, C<%g> and C<%G> for numbers with the modulus of the
exponent less than 100 is system-dependent: it may be three or less
(zero-padded as necessary). In other words, 1.23 times ten to the
-99th may be either "1.23e99" or "1.23e099".
+99th may be either "1.23e99" or "1.23e099". Similarly for C<%a> and C<%A>:
+the exponent or the hexadecimal digits may float: especially the
+"long doubles" Perl configuration option may cause surprises.
Between the C<%> and the format letter, you may specify several
additional attributes controlling the interpretation of the format.
as each other. See L<perlsec/"Algorithmic Complexity Attacks"> for
details on why hash order is randomized. Aside from the guarantees
provided here the exact details of Perl's hash algorithm and the hash
-traversal order are subject to change in any release of Perl.
+traversal order are subject to change in any release of Perl. Tied hashes
+may behave differently to Perl's hashes with respect to changes in order on
+insertion and deletion of items.
As a side effect, calling values() resets the HASH or ARRAY's internal
iterator, see L</each>. (In particular, calling values() in void context
to use C<dVAR> in your coding to "declare the global variables"
when you are using them. dTHX does this for you automatically.
-To see whether you have non-const data you can use a BSD-compatible C<nm>:
+To see whether you have non-const data you can use a BSD (or GNU)
+compatible C<nm>:
nm libperl.a | grep -v ' [TURtr] '
-If this displays any C<D> or C<d> symbols, you have non-const data.
+If this displays any C<D> or C<d> symbols (or possibly C<C> or C<c>),
+you have non-const data. The symbols the C<grep> removed are as follows:
+C<Tt> are I<text>, or code, the C<Rr> are I<read-only> (const) data,
+and the C<U> is <undefined>, external symbols referred to.
+
+The test F<t/porting/libperl.t> does this kind of symbol sanity
+checking on C<libperl.a>.
For backward compatibility reasons defining just PERL_GLOBAL_STRUCT
doesn't actually hide all symbols inside a big global struct: some
=head2 Security problems
Last but not least, here are various tips for safer coding.
+See also L<perlclib> for libc/stdio replacements one should use.
=over 4
=item *
+Do not use tmpfile()
+
+Use mkstemp() instead.
+
+=item *
+
Do not use strcpy() or strcat() or strncpy() or strncat()
Use my_strlcpy() and my_strlcat() instead: they either use the native
simply skipped without any notice.
L<https://sourceware.org/bugzilla/show_bug.cgi?id=6530>.
+=item *
+
+Do not use atoi()
+
+Use grok_atou() instead. atoi() has ill-defined behavior on overflows,
+and cannot be used for incremental parsing. It is also affected by locale,
+which is bad.
+
+=item *
+
+Do not use strtol() or strtoul()
+
+Use grok_atou() instead. strtol() or strtoul() (or their IV/UV-friendly
+macro disguises, Strtol() and Strtoul(), or Atol() and Atoul() are
+affected by locale, which is bad.
+
=back
=head1 DEBUGGING
Ricardo 5.21.0 2014-May-27 The 5.21 development track
Matthew H 5.21.1 2014-Jun-20
Abigail 5.21.2 2014-Jul-20
+ Peter 5.21.3 2014-Aug-20
=head2 SELECTED RELEASE SIZES
\c[ chr(27)
\c] chr(29)
\c^ chr(30)
- \c? chr(127)
+ \c_ chr(31)
+ \c? chr(127) # (on ASCII platforms)
In other words, it's the character whose code point has had 64 xor'd with
-its uppercase. C<\c?> is DELETE because C<ord("?") ^ 64> is 127, and
+its uppercase. C<\c?> is DELETE on ASCII platforms because
+S<C<ord("?") ^ 64>> is 127, and
C<\c@> is NULL because the ord of "@" is 64, so xor'ing 64 itself produces 0.
Also, C<\c\I<X>> yields C< chr(28) . "I<X>"> for any I<X>, but cannot come at the
On ASCII platforms, the resulting characters from the list above are the
complete set of ASCII controls. This isn't the case on EBCDIC platforms; see
-L<perlebcdic/OPERATOR DIFFERENCES> for the complete list of what these
-sequences mean on both ASCII and EBCDIC platforms.
+L<perlebcdic/OPERATOR DIFFERENCES> for a full discussion of the
+differences between these for ASCII versus EBCDIC platforms.
-Use of any other character following the "c" besides those listed above is
-discouraged, and some are deprecated with the intention of removing
-those in a later Perl version. What happens for any of these
-other characters currently though, is that the value is derived by xor'ing
-with the seventh bit, which is 64.
+Use of any other character following the C<"c"> besides those listed above is
+discouraged, and as of Perl v5.20, the only characters actually allowed
+are the printable ASCII ones, minus the left brace C<"{">. What happens
+for any of the allowed other characters is that the value is derived by
+xor'ing with the seventh bit, which is 64, and a warning raised if
+enabled. Using the non-allowed characters generates a fatal error.
To get platform independent controls, you can use C<\N{...}>.
C<\o{}>, or convert to something else, such as to hex and use C<\x{}>
instead.
-Having fewer than 3 digits may lead to a misleading warning message that says
-that what follows is ignored. For example, C<"\128"> in the ASCII character set
-is equivalent to the two characters C<"\n8">, but the warning C<Illegal octal
-digit '8' ignored> will be thrown. If C<"\n8"> is what you want, you can
-avoid this warning by padding your octal number with C<0>'s: C<"\0128">.
-
=item [8]
Several constructs above specify a character by a number. That number
after the trailing delimiter.
Once upon a time, Perl would recompile regular expressions
unnecessarily, and this modifier was useful to tell it not to do so, in the
-interests of speed. But now, the only reasons to use C</o> are either:
+interests of speed. But now, the only reasons to use C</o> are one of:
=over
\o{}, \000 character whose ordinal is the given octal number
\l lowercase next char (think vi)
\u uppercase next char (think vi)
- \L lowercase till \E (think vi)
- \U uppercase till \E (think vi)
- \Q quote (disable) pattern metacharacters till \E
+ \L lowercase until \E (think vi)
+ \U uppercase until \E (think vi)
+ \Q quote (disable) pattern metacharacters until \E
\E end either case modification or quoted section, think vi
Details are in L<perlop/Quote and Quote-like Operators>.
matches a word that follows a tab, without including the tab in C<$&>.
Works only for fixed-width look-behind.
-There is a special form of this construct, called C<\K>, which causes the
+There is a special form of this construct, called C<\K> (available since
+Perl 5.10.0), which causes the
regex engine to "keep" everything it had matched prior to the C<\K> and
not include it in C<$&>. This effectively provides variable-length
look-behind. The use of C<\K> inside of another look-around assertion
permutations (use e.g. the CPAN modules C<Algorithm::Permute> or
C<Algorithm::FastPermute>), or for any cryptographic applications.
+Tied hashes may have their own ordering and algorithmic complexity
+attacks.
+
=item *
Regular expressions - Perl's regular expression engine is so called NFA
=item CRTL_ENV
-This string tells Perl to consult the CRTL's internal C<environ>
-array of key-value pairs, using I<name> as the key. In most cases,
-this contains only a few keys, but if Perl was invoked via the C
-C<exec[lv]e()> function, as is the case for CGI processing by some
-HTTP servers, then the C<environ> array may have been populated by
-the calling program.
+This string tells Perl to consult the CRTL's internal C<environ> array
+of key-value pairs, using I<name> as the key. In most cases, this
+contains only a few keys, but if Perl was invoked via the C
+C<exec[lv]e()> function, as is the case for some embedded Perl
+applications or when running under a shell such as GNV bash, the
+C<environ> array may have been populated by the calling program.
=item CLISYM_[LOCAL]
you make while Perl is running do not affect the behavior of C<%ENV>.
If F<PERL_ENV_TABLES> is not defined, then Perl defaults to consulting
first the logical name tables specified by F<LNM$FILE_DEV>, and then
-the CRTL C<environ> array.
+the CRTL C<environ> array. This default order is reversed when the
+logical name F<GNV$UNIX_SHELL> is defined, such as when running under
+GNV bash.
In all operations on %ENV, the key string is treated as if it
were entirely uppercase, regardless of the case actually
(ASCII C<\0>) character, since a logical name cannot translate to a
zero-length string. (This restriction does not apply to CLI symbols
or CRTL C<environ> values; they are set to the empty string.)
-An element of the CRTL C<environ> array can be set only if your
-copy of Perl knows about the CRTL's C<setenv()> function. (This is
-present only in some versions of the DECCRTL; check C<$Config{d_setenv}>
-to see whether your copy of Perl was built with a CRTL that has this
-function.)
-
-When an element of C<%ENV> is set to C<undef>,
-the element is looked up as if it were being read, and if it is
-found, it is deleted. (An item "deleted" from the CRTL C<environ>
-array is set to the empty string; this can only be done if your
-copy of Perl knows about the CRTL C<setenv()> function.) Using
-C<delete> to remove an element from C<%ENV> has a similar effect,
-but after the element is deleted, another attempt is made to
-look up the element, so an inner-mode logical name or a name in
-another location will replace the logical name just deleted.
-In either case, only the first value found searching PERL_ENV_TABLES
-is altered. It is not possible at present to define a search list
+
+When an element of C<%ENV> is set to C<undef>, the element is looked
+up as if it were being read, and if it is found, it is deleted. (An
+item "deleted" from the CRTL C<environ> array is set to the empty
+string.) Using C<delete> to remove an element from C<%ENV> has a
+similar effect, but after the element is deleted, another attempt is
+made to look up the element, so an inner-mode logical name or a name
+in another location will replace the logical name just deleted. In
+either case, only the first value found searching PERL_ENV_TABLES is
+altered. It is not possible at present to define a search list
logical name via %ENV.
The element C<$ENV{DEFAULT}> is special: when read, it returns
}
}
else if (UTF8_IS_DOWNGRADEABLE_START(*s)) {
+ if (
#ifdef USE_LOCALE_CTYPE
/* In locale, we quote all non-ASCII Latin1 chars.
* Otherwise use the quoting rules */
- if (IN_LC_RUNTIME(LC_CTYPE)
- || _isQUOTEMETA(TWO_BYTE_UTF8_TO_NATIVE(*s, *(s + 1))))
+
+ IN_LC_RUNTIME(LC_CTYPE)
+ ||
+#endif
+ _isQUOTEMETA(TWO_BYTE_UTF8_TO_NATIVE(*s, *(s + 1))))
{
to_quote = TRUE;
}
-#endif
}
else if (is_QUOTEMETA_high(s)) {
to_quote = TRUE;
bool path_searchable;
sv = POPs;
+ SvGETMAGIC(sv);
if ( (SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) {
sv = sv_2mortal(new_version(sv));
if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
RETPUSHYES;
}
- name = SvPV_const(sv, len);
+ if (!SvOK(sv))
+ DIE(aTHX_ "Missing or undefined argument to require");
+ name = SvPV_nomg_const(sv, len);
if (!(name && len > 0 && *name))
- DIE(aTHX_ "Null filename used");
+ DIE(aTHX_ "Missing or undefined argument to require");
+
if (!IS_SAFE_PATHNAME(name, len, "require")) {
DIE(aTHX_ "Can't locate %s: %s",
pv_escape(newSVpvs_flags("",SVs_TEMP),SvPVX(sv),SvCUR(sv),
if (GvIO(gv) && IoIFP(GvIOp(gv)))
fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
else if (name && isDIGIT(*name))
- fd = atoi(name);
+ fd = grok_atou(name, NULL);
else
FT_RETURNUNDEF;
if (fd < 0) {
dTARGET;
const char *tmps;
char buf[MAXPATHLEN];
- int len;
+ SSize_t len;
TAINT;
tmps = POPpconstx;
+ /* NOTE: if the length returned by readlink() is sizeof(buf) - 1,
+ * it is impossible to know whether the result was truncated. */
len = readlink(tmps, buf, sizeof(buf) - 1);
if (len < 0)
RETPUSHUNDEF;
+ if (len != -1)
+ buf[len] = '\0';
PUSHp(buf, len);
RETURN;
#else
PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv);
PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp);
+PERL_CALLCONV UV Perl_grok_atou(const char* pv, const char** endptr)
+ __attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_GROK_ATOU \
+ assert(pv)
+
PERL_CALLCONV UV Perl_grok_bin(pTHX_ const char* start, STRLEN* len_p, I32* flags, NV *result)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
#define PERL_ARGS_ASSERT_SWASH_INIT \
assert(pkg); assert(name); assert(listsv)
+PERL_CALLCONV void Perl_sync_locale(pTHX);
PERL_CALLCONV void Perl_sys_init(int* argc, char*** argv)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
#define PERL_ARGS_ASSERT_BAD_TYPE_PV \
assert(t); assert(name); assert(kid)
+STATIC void S_clear_special_blocks(pTHX_ const char *const fullname, GV *const gv, CV *const cv)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2)
+ __attribute__nonnull__(pTHX_3);
+#define PERL_ARGS_ASSERT_CLEAR_SPECIAL_BLOCKS \
+ assert(fullname); assert(gv); assert(cv)
+
STATIC void S_cop_free(pTHX_ COP *cop)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_COP_FREE \
else if ( PL_regkind[OP(scan)] == BRANCHJ
/* Lookbehind, or need to calculate parens/evals/stclass: */
&& (scan->flags || data || (flags & SCF_DO_STCLASS))
- && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) {
+ && (OP(scan) == IFMATCH || OP(scan) == UNLESSM))
+ {
if ( OP(scan) == UNLESSM &&
scan->flags == 0 &&
OP(NEXTOPER(NEXTOPER(scan))) == NOTHING &&
*/
ssc_init(pRExC_state, data->start_class);
} else {
- /* AND before and after: combine and continue */
+ /* AND before and after: combine and continue. These
+ * assertions are zero-length, so can match an EMPTY
+ * string */
ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl);
+ ANYOF_FLAGS(data->start_class) |= ANYOF_EMPTY_STRING;
}
}
}
if (f & SCF_DO_STCLASS_AND) {
ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl);
+ ANYOF_FLAGS(data->start_class) |= ANYOF_EMPTY_STRING;
}
if (data) {
if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR))
else if (*RExC_parse == '?') { /* (?...) */
bool is_logical = 0;
const char * const seqstart = RExC_parse;
+ const char * endptr;
if (has_intervening_patws) {
RExC_parse++;
vFAIL("In '(?...)', the '(' and '?' must be adjacent");
case '5': case '6': case '7': case '8': case '9':
RExC_parse--;
parse_recursion:
- num = atoi(RExC_parse);
- parse_start = RExC_parse - 1; /* MJD */
- if (*RExC_parse == '-')
- RExC_parse++;
- while (isDIGIT(*RExC_parse))
- RExC_parse++;
+ {
+ bool is_neg = FALSE;
+ parse_start = RExC_parse - 1; /* MJD */
+ if (*RExC_parse == '-') {
+ RExC_parse++;
+ is_neg = TRUE;
+ }
+ num = grok_atou(RExC_parse, &endptr);
+ if (endptr)
+ RExC_parse = (char*)endptr;
+ if (is_neg) {
+ /* Some limit for num? */
+ num = -num;
+ }
+ }
if (*RExC_parse!=')')
vFAIL("Expecting close bracket");
REGTAIL(pRExC_state, ret, tail);
goto insert_if;
}
+ /* Fall through to ‘Unknown switch condition’ at the
+ end of the if/else chain. */
}
else if ( RExC_parse[0] == '<' /* (?(<NAME>)...) */
|| RExC_parse[0] == '\'' ) /* (?('NAME')...) */
RExC_parse++;
parno = 0;
if (RExC_parse[0] >= '1' && RExC_parse[0] <= '9' ) {
- parno = atoi(RExC_parse++);
- while (isDIGIT(*RExC_parse))
- RExC_parse++;
+ parno = grok_atou(RExC_parse, &endptr);
+ if (endptr)
+ RExC_parse = (char*)endptr;
} else if (RExC_parse[0] == '&') {
SV *sv_dat;
RExC_parse++;
/* (?(1)...) */
char c;
char *tmp;
- parno = atoi(RExC_parse++);
-
- while (isDIGIT(*RExC_parse))
- RExC_parse++;
+ parno = grok_atou(RExC_parse, &endptr);
+ if (endptr)
+ RExC_parse = (char*)endptr;
ret = reganode(pRExC_state, GROUPP, parno);
insert_if_check_paren:
but I can't figure out why. -- dmq*/
return ret;
}
- else {
- RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1;
- vFAIL("Unknown switch condition (?(...))");
- }
+ RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1;
+ vFAIL("Unknown switch condition (?(...))");
}
case '[': /* (?[ ... ]) */
return handle_regex_sets(pRExC_state, NULL, flagp, depth,
next++;
}
if (*next == '}') { /* got one */
+ const char* endptr;
if (!maxpos)
maxpos = next;
RExC_parse++;
- min = atoi(RExC_parse);
+ min = grok_atou(RExC_parse, &endptr);
if (*maxpos == ',')
maxpos++;
else
maxpos = RExC_parse;
- max = atoi(maxpos);
+ max = grok_atou(maxpos, &endptr);
if (!max && *maxpos != '0')
max = REG_INFTY; /* meaning "infinity" */
else if (max >= REG_INFTY)
}
-/* return atoi(p), unless it's too big to sensibly be a backref,
+/* Parse backref decimal value, unless it's too big to sensibly be a backref,
* in which case return I32_MAX (rather than possibly 32-bit wrapping) */
static I32
S_backref_value(char *p)
{
- char *q = p;
-
- for (;isDIGIT(*q); q++) {} /* calculate length of num */
- if (q - p == 0 || q - p > 9)
+ const char* endptr;
+ UV val = grok_atou(p, &endptr);
+ if (endptr == p || endptr == NULL || val > I32_MAX)
return I32_MAX;
- return atoi(p);
+ return (I32)val;
}
S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode *p,
const regnode *val,U32 depth)
{
- dVAR;
regnode *scan;
U8 exact = PSEUDO;
#ifdef EXPERIMENTAL_INPLACESCAN
Perl_regdump(pTHX_ const regexp *r)
{
#ifdef DEBUGGING
- dVAR;
SV * const sv = sv_newmortal();
SV *dsv= sv_newmortal();
RXi_GET_DECL(r,ri);
Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_info *reginfo)
{
#ifdef DEBUGGING
- dVAR;
int k;
/* Should be synchronized with * ANYOF_ #xdefines in regcomp.h */
PERL_ARGS_ASSERT_PUT_LATIN1_CHARCLASS_INNARDS;
for (i = 0; i < 256; i++) {
- if (i < 256 && BITMAP_TEST((U8 *) bitmap,i)) {
+ if (BITMAP_TEST((U8 *) bitmap,i)) {
/* The character at index i should be output. Find the next
* character that should NOT be output */
int j;
- for (j = i + 1; j <= 256; j++) {
+ for (j = i + 1; j < 256; j++) {
if (! BITMAP_TEST((U8 *) bitmap, j)) {
break;
}
const regnode *last, const regnode *plast,
SV* sv, I32 indent, U32 depth)
{
- dVAR;
U8 op = PSEUDO; /* Arbitrary non-END op. */
const regnode *next;
const regnode *optstart= NULL;
case _CC_ENUM_BLANK: return is_HORIZWS_high(character);
case _CC_ENUM_XDIGIT: return is_XDIGIT_high(character);
case _CC_ENUM_VERTSPACE: return is_VERTWS_high(character);
- default: return 0; /* Things like CNTRL are always
- below 256 */
+ default: break;
}
- assert(0); /* NOTREACHED */
- return FALSE;
+ return FALSE; /* Things like CNTRL are always below 256 */
}
/*
const bool utf8_target = reginfo->is_utf8_target;
- UV c1 = CHRTEST_NOT_A_CP_1;
- UV c2 = CHRTEST_NOT_A_CP_2;
+ UV c1 = (UV)CHRTEST_NOT_A_CP_1;
+ UV c2 = (UV)CHRTEST_NOT_A_CP_2;
bool use_chrtest_void = FALSE;
const bool is_utf8_pat = reginfo->is_utf8_pat;
st->u.keeper.val = rex->offs[0].start;
rex->offs[0].start = locinput - reginfo->strbeg;
PUSH_STATE_GOTO(KEEPS_next, next, locinput);
- assert(0); /*NOTREACHED*/
+ /* NOTREACHED */
+ assert(0);
+
case KEEPS_next_fail:
/* rollback the start point change */
rex->offs[0].start = st->u.keeper.val;
sayNO_SILENT;
- assert(0); /*NOTREACHED*/
+ /* NOTREACHED */
+ assert(0);
case MEOL: /* /..$/m */
if (!NEXTCHR_IS_EOS && nextchr != '\n')
REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5])
);
sayNO_SILENT;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
/* FALLTHROUGH */
case TRIE: /* (ab|cd) */
);
goto trie_first_try; /* jump into the fail handler */
}}
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case TRIE_next_fail: /* we failed - try next alternative */
{
if (ST.accepted > 1 || has_cutgroup) {
PUSH_STATE_GOTO(TRIE_next, scan, (char*)uc);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
/* only one choice left - just continue */
DEBUG_EXECUTE_r({
locinput = (char*)uc;
continue; /* execute rest of RE */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
#undef ST
/* and then jump to the code we share with EVAL */
goto eval_recurse_doit;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case EVAL: /* /(?{A})B/ /(??{A})B/ and /(?(?{A})X|Y)B/ */
if (cur_eval && cur_eval->locinput==locinput) {
cur_eval = st;
/* now continue from first node in postoned RE */
PUSH_YES_STATE_GOTO(EVAL_AB, startpoint, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
case EVAL_AB: /* cleanup after a successful (??{A})B */
}
}
goto fake_end;
- /*NOTREACHED*/
+ /* NOTREACHED */
case GROUPP: /* (?(1)) */
n = ARG(scan); /* which paren pair */
ST.lastloc = NULL; /* this will be updated by WHILEM */
PUSH_YES_STATE_GOTO(CURLYX_end, PREVOPER(next), locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
case CURLYX_end: /* just finished matching all of A*B */
cur_curlyx = ST.prev_curlyx;
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case CURLYX_end_fail: /* just failed to match all of A*B */
regcpblow(ST.cp);
cur_curlyx = ST.prev_curlyx;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
#undef ST
REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_pre, A, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
/* If degenerate A matches "", assume A done. */
REGCP_SET(ST.lastcp);
PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B,
locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
/* Prefer A over B for maximal matching. */
cur_curlyx->u.curlyx.lastloc = locinput;
REGCP_SET(ST.lastcp);
PUSH_STATE_GOTO(WHILEM_A_max, A, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
goto do_whilem_B_max;
}
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case WHILEM_B_min: /* just matched B in a minimal match */
case WHILEM_B_max: /* just matched B in a maximal match */
cur_curlyx = ST.save_curlyx;
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case WHILEM_B_max_fail: /* just failed to match B in a maximal match */
cur_curlyx = ST.save_curlyx;
cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
cur_curlyx->u.curlyx.count--;
CACHEsayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case WHILEM_A_min_fail: /* just failed to match A in a minimal match */
/* FALLTHROUGH */
cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
cur_curlyx->u.curlyx.count--;
CACHEsayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
REGCP_UNWIND(ST.lastcp);
cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
PUSH_YES_STATE_GOTO(WHILEM_B_max, ST.save_curlyx->u.curlyx.B,
locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
cur_curlyx = ST.save_curlyx;
PUSH_STATE_GOTO(WHILEM_A_min,
/*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS,
locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
#undef ST
#define ST st->u.branch
} else {
PUSH_STATE_GOTO(BRANCH_next, scan, locinput);
}
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case CUTGROUP: /* /(*THEN)/ */
sv_yes_mark = st->u.mark.mark_name = scan->flags ? NULL :
MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
PUSH_STATE_GOTO(CUTGROUP_next, next, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case CUTGROUP_next_fail:
do_cutgroup = 1;
if (st->u.mark.mark_name)
sv_commit = st->u.mark.mark_name;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case BRANCH_next:
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case BRANCH_next_fail: /* that branch failed; try the next, if any */
if (do_cutgroup) {
sayNO_SILENT;
}
continue; /* execute next BRANCH[J] op */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case MINMOD: /* next op will be non-greedy, e.g. A*? */
minmod = 1;
curlym_do_A: /* execute the A in /A{m,n}B/ */
PUSH_YES_STATE_GOTO(CURLYM_A, ST.A, locinput); /* match A */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case CURLYM_A: /* we've just matched an A */
ST.count++;
}
PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput); /* match B */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case CURLYM_B_fail: /* just failed to match a B */
REGCP_UNWIND(ST.cp);
REGCP_SET(ST.cp);
goto curly_try_B_max;
}
- assert(0); /* NOTREACHED */
-
+ /* NOTREACHED */
+ assert(0);
case CURLY_B_min_known_fail:
/* failed to find B in a non-greedy match where c1,c2 valid */
}
PUSH_STATE_GOTO(CURLY_B_min_known, ST.B, locinput);
}
- assert(0); /* NOTREACHED */
-
+ /* NOTREACHED */
+ assert(0);
case CURLY_B_min_fail:
/* failed to find B in a non-greedy match where c1,c2 invalid */
}
}
sayNO;
- assert(0); /* NOTREACHED */
-
+ /* NOTREACHED */
+ assert(0);
curly_try_B_max:
/* a successful greedy match: now try to match B */
if (ST.c1 == CHRTEST_VOID || could_match) {
CURLY_SETPAREN(ST.paren, ST.count);
PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
}
/* FALLTHROUGH */
/* execute body of (?...A) */
PUSH_YES_STATE_GOTO(IFMATCH_A, NEXTOPER(NEXTOPER(scan)), newstart);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
case IFMATCH_A_fail: /* body of (?...A) failed */
if (!scan->flags)
sv_yes_mark = sv_commit = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]);
PUSH_STATE_GOTO(COMMIT_next, next, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case COMMIT_next_fail:
no_final = 1;
case OPFAIL: /* (*FAIL) */
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
#define ST st->u.mark
case MARKPOINT: /* (*MARK:foo) */
mark_state = st;
ST.mark_loc = locinput;
PUSH_YES_STATE_GOTO(MARKPOINT_next, next, locinput);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case MARKPOINT_next:
mark_state = ST.prev_mark;
sayYES;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case MARKPOINT_next_fail:
if (popmark && sv_eq(ST.mark_name,popmark))
sv_yes_mark = mark_state ?
mark_state->u.mark.mark_name : NULL;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
case SKIP: /* (*SKIP) */
if (scan->flags) {
}
no_final = 1;
sayNO;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
#undef ST
case LNBREAK: /* \R */
/* switch break jumps here */
scan = next; /* prepare to execute the next op and ... */
continue; /* ... jump back to the top, reusing st */
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
push_yes_state:
/* push a state that backtracks on success */
locinput = pushinput;
st = newst;
continue;
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
}
* the terminating point.
*/
Perl_croak(aTHX_ "corrupted regexp pointers");
- /*NOTREACHED*/
+ /* NOTREACHED */
sayNO;
yes:
default:
Perl_croak(aTHX_ "panic: regrepeat() called with unrecognized node type %d='%s'", OP(p), PL_reg_name[OP(p)]);
- assert(0); /* NOTREACHED */
+ /* NOTREACHED */
+ assert(0);
}
STATIC void
S_del_sv(pTHX_ SV *p)
{
- dVAR;
-
PERL_ARGS_ASSERT_DEL_SV;
if (DEBUG_D_TEST) {
STATIC void
S_not_a_number(pTHX_ SV *const sv)
{
- dVAR;
char tmpbuf[64];
const char *pv;
STATIC void
S_not_incrementable(pTHX_ SV *const sv) {
- dVAR;
char tmpbuf[64];
const char *pv;
sv_vcatpvfn_flags(sv, pat, patlen, args, svargs, svmax, maybe_tainted, SV_GMAGIC|SV_SMAGIC);
}
+/* vhex will contain the values (0..15) of the hex digits ("nybbles"
+ * of 4 bits); 1 for the implicit 1, and at most 128 bits of mantissa,
+ * four bits per xdigit. */
+#define VHEX_SIZE (1+128/4)
+
+/* If we do not have a known long double format, (including not using
+ * long doubles, or long doubles being equal to doubles) then we will
+ * fall back to the ldexp/frexp route, with which we can retrieve at
+ * most as many bits as our widest unsigned integer type is. We try
+ * to get a 64-bit unsigned integer even if we are not having 64-bit
+ * UV. */
+#if defined(HAS_QUAD) && defined(Uquad_t)
+# define MANTISSATYPE Uquad_t
+# define MANTISSASIZE 8
+#else
+# define MANTISSATYPE UV /* May lose precision if UVSIZE is not 8. */
+# define MANTISSASIZE UVSIZE
+#endif
+
+/* S_hextract() is a helper for Perl_sv_vcatpvfn_flags, for extracting
+ * the hexadecimal values (for %a/%A). The nv is the NV where the value
+ * are being extracted from (either directly from the long double in-memory
+ * presentation, or from the uquad computed via frexp+ldexp). frexp also
+ * is used to update the exponent. vhex is the pointer to the beginning
+ * of the output buffer (of VHEX_SIZE).
+ *
+ * The tricky part is that S_hextract() needs to be called twice:
+ * the first time with vend as NULL, and the second time with vend as
+ * the pointer returned by the first call. What happens is that on
+ * the first round the output size is computed, and the intended
+ * extraction sanity checked. On the second round the actual output
+ * (the extraction of the hexadecimal values) takes place.
+ * Sanity failures cause fatal failures during both rounds. */
+STATIC U8*
+S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
+{
+ U8* v = vhex;
+ int ix;
+ int ixmin = 0, ixmax = 0;
+
+ /* XXX Inf/NaN/denormal handling in the HEXTRACT_IMPLICIT_BIT,
+ * and elsewhere. */
+
+ /* These macros are just to reduce typos, they have multiple
+ * repetitions below, but usually only one (or sometimes two)
+ * of them is really being used. */
+ /* HEXTRACT_OUTPUT() extracts the high nybble first. */
+#define HEXTRACT_OUTPUT() \
+ STMT_START { \
+ *v++ = nvp[ix] >> 4; \
+ *v++ = nvp[ix] & 0xF; \
+ } STMT_END
+#define HEXTRACT_COUNT() \
+ STMT_START { \
+ v += 2; \
+ if (ix < ixmin) \
+ ixmin = ix; \
+ else if (ix > ixmax) \
+ ixmax = ix; \
+ } STMT_END
+#define HEXTRACT_IMPLICIT_BIT() \
+ if (exponent) { \
+ if (vend) \
+ *v++ = 1; \
+ else \
+ v++; \
+ }
+
+ /* First see if we are using long doubles. */
+#if NVSIZE > DOUBLESIZE && LONG_DOUBLEKIND != LONG_DOUBLE_IS_DOUBLE
+ const U8* nvp = (const U8*)(&nv);
+# define HEXTRACTSIZE NVSIZE
+ (void)Perl_frexp(PERL_ABS(nv), exponent);
+# if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+ /* Used in e.g. VMS and HP-UX IA-64, e.g. -0.1L:
+ * 9a 99 99 99 99 99 99 99 99 99 99 99 99 99 fb 3f */
+ /* The bytes 13..0 are the mantissa/fraction,
+ * the 15,14 are the sign+exponent. */
+ HEXTRACT_IMPLICIT_BIT();
+ for (ix = 13; ix >= 0; ix--) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+ /* Used in e.g. Solaris Sparc and HP-UX PA-RISC, e.g. -0.1L:
+ * bf fb 99 99 99 99 99 99 99 99 99 99 99 99 99 9a */
+ /* The bytes 2..15 are the mantissa/fraction,
+ * the 0,1 are the sign+exponent. */
+ HEXTRACT_IMPLICIT_BIT();
+ for (ix = 2; ix <= 15; ix++) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+ /* x86 80-bit "extended precision", 64 bits of mantissa / fraction /
+ * significand, 15 bits of exponent, 1 bit of sign. NVSIZE can
+ * be either 12 (ILP32, Solaris x86) or 16 (LP64, Linux and OS X),
+ * meaning that 2 or 6 bytes are empty padding. */
+ /* The bytes 7..0 are the mantissa/fraction */
+ /* There explicitly is *no* implicit bit in this case. */
+ for (ix = 7; ix >= 0; ix--) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+ /* The last 8 bytes are the mantissa/fraction.
+ * (does this format ever happen?) */
+ /* There explicitly is *no* implicit bit in this case. */
+ for (ix = LONGDBLSIZE - 8; ix < LONGDBLSIZE; ix++) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+ /* Where is this used?
+ *
+ * Guessing that the format would be the reverse
+ * of big endian, i.e. for -0.1L:
+ * 9a 99 99 99 99 99 59 3c 9a 99 99 99 99 99 b9 bf */
+ HEXTRACT_IMPLICIT_BIT();
+ for (ix = 13; ix >= 8; ix--) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+ for (ix = 5; ix >= 0; ix--) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+ /* Used in e.g. PPC/Power (AIX) and MIPS.
+ *
+ * The mantissa bits are in two separate stretches,
+ * e.g. for -0.1L:
+ * bf b9 99 99 99 99 99 9a 3c 59 99 99 99 99 99 9a
+ *
+ * Note that this blind copying might be considered not to be
+ * the right thing, since the first double already does
+ * rounding (0x9A as opposed to 0x99). But then again, we
+ * probably should just copy the bits as they are?
+ */
+ HEXTRACT_IMPLICIT_BIT();
+ for (ix = 2; ix < 8; ix++) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+ for (ix = 10; ix < 16; ix++) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# else
+ Perl_croak(aTHX_
+ "Hexadecimal float: unsupported long double format");
+# endif
+#else
+ /* If not using long doubles (or if the long double format is
+ * known but not yet supported), try to retrieve the mantissa bits
+ * via frexp+ldexp. */
+
+ NV norm = Perl_frexp(PERL_ABS(nv), exponent);
+ /* Theoretically we have all the bytes [0, MANTISSASIZE-1] to
+ * inspect; but in practice we don't want the leading nybbles that
+ * are zero. With the common IEEE 754 value for NV_MANT_DIG being
+ * 53, we want the limit byte to be (int)((53-1)/8) == 6.
+ *
+ * Note that this is _not_ inspecting the in-memory format of the
+ * nv (as opposed to the long double method), but instead the UV
+ * retrieved with the frexp+ldexp invocation. */
+# if MANTISSASIZE * 8 > NV_MANT_DIG
+ MANTISSATYPE mantissa = Perl_ldexp(norm, NV_MANT_DIG);
+ int limit_byte = (NV_MANT_DIG - 1) / 8;
+# else
+ /* There will be low-order precision loss. Try to salvage as many
+ * bits as possible. Will truncate, not round. */
+ MANTISSATYPE mantissa =
+ Perl_ldexp(norm,
+ /* The highest possible shift by two that fits in the
+ * mantissa and is aligned (by four) the same was as
+ * NV_MANT_DIG. */
+ MANTISSASIZE * 8 - (4 - NV_MANT_DIG % 4));
+ int limit_byte = MANTISSASIZE - 1;
+# endif
+ const U8* nvp = (const U8*)(&mantissa);
+# define HEXTRACTSIZE MANTISSASIZE
+ /* We make here the wild assumption that the endianness of doubles
+ * is similar to the endianness of integers, and that there is no
+ * middle-endianness. This may come back to haunt us (the rumor
+ * has it that ARM can be quite haunted).
+ *
+ * We generate 4-bit xdigits (nybble/nibble) instead of 8-bit
+ * bytes, since we might need to handle printf precision, and also
+ * insert the radix.
+ */
+# if BYTEORDER == 0x12345678 || BYTEORDER == 0x1234 || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \
+ LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+ /* Little endian. */
+ for (ix = limit_byte; ix >= 0; ix--) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# else
+ /* Big endian. */
+ for (ix = MANTISSASIZE - 1 - limit_byte; ix < MANTISSASIZE; ix++) {
+ if (vend)
+ HEXTRACT_OUTPUT();
+ else
+ HEXTRACT_COUNT();
+ }
+# endif
+ /* If there are not enough bits in MANTISSATYPE, we couldn't get
+ * all of them, issue a warning.
+ *
+ * Note that NV_PRESERVES_UV_BITS would not help here, it is the
+ * wrong way around. */
+# if NV_MANT_DIG > MANTISSASIZE * 8
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "Hexadecimal float: precision loss");
+# endif
+#endif
+ /* Croak for various reasons: if the output pointer escaped the
+ * output buffer, if the extraction index escaped the extraction
+ * buffer, or if the ending output pointer didn't match the
+ * previously computed value. */
+ if (v <= vhex || v - vhex >= VHEX_SIZE ||
+ ixmin < 0 || ixmax >= HEXTRACTSIZE ||
+ (vend && v != vend))
+ Perl_croak(aTHX_ "Hexadecimal float: internal error");
+ return v;
+}
+
void
Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
va_list *const args, SV **const svargs, const I32 svmax, bool *const maybe_tainted,
/* large enough for "%#.#f" --chip */
/* what about long double NVs? --jhi */
bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
+ bool hexfp = FALSE;
DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED;
case 'e': case 'E':
case 'f':
case 'g': case 'G':
+ case 'a': case 'A':
if (vectorize)
goto unknown;
/* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything
else. frexp() has some unspecified behaviour for those three */
if (c != 'e' && c != 'E' && (nv * 0) == 0) {
- i = PERL_INT_MIN;
- /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
- will cast our (long double) to (double) */
- (void)Perl_frexp(nv, &i);
- if (i == PERL_INT_MIN)
- Perl_die(aTHX_ "panic: frexp");
- if (i > 0)
- need = BIT_DIGITS(i);
+ i = PERL_INT_MIN;
+ /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
+ will cast our (long double) to (double) */
+ (void)Perl_frexp(nv, &i);
+ if (i == PERL_INT_MIN)
+ Perl_die(aTHX_ "panic: frexp");
+ hexfp = (c == 'a' || c == 'A');
+ if (UNLIKELY(hexfp)) {
+ /* Hexadecimal floating point: this size
+ * computation probably overshoots, but that is
+ * better than undershooting. */
+ need +=
+ (nv < 0) + /* possible unary minus */
+ 2 + /* "0x" */
+ 1 + /* the very unlikely carry */
+ 1 + /* "1" */
+ 1 + /* "." */
+ /* We want one byte per each 4 bits in the
+ * mantissa. This works out to about 0.83
+ * bytes per NV decimal digit (of 4 bits):
+ * (NV_DIG * log(10)/log(2)) / 4,
+ * we overestimate by using 5/6 (0.8333...) */
+ ((NV_DIG * 5) / 6 + 1) +
+ 2 + /* "p+" */
+ (i >= 0 ? BIT_DIGITS(i) : 1 + BIT_DIGITS(-i)) +
+ 1; /* \0 */
+#ifdef USE_LOCALE_NUMERIC
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+ if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC))
+ need += SvLEN(PL_numeric_radix_sv);
+ RESTORE_LC_NUMERIC();
+#endif
+ }
+ else if (i > 0) {
+ need = BIT_DIGITS(i);
+ } /* if i < 0, the number of digits is hard to predict. */
}
need += has_precis ? precis : 6; /* known default */
break;
}
}
- {
+
+ if (UNLIKELY(hexfp)) {
+ /* Hexadecimal floating point. */
+ char* p = PL_efloatbuf;
+ U8 vhex[VHEX_SIZE];
+ U8* v = vhex; /* working pointer to vhex */
+ U8* vend; /* pointer to one beyond last digit of vhex */
+ U8* vfnz = NULL; /* first non-zero */
+ const bool lower = (c == 'a');
+ /* At output the values of vhex (up to vend) will
+ * be mapped through the xdig to get the actual
+ * human-readable xdigits. */
+ const char* xdig = PL_hexdigit;
+ int zerotail = 0; /* how many extra zeros to append */
+ int exponent; /* exponent of the floating point input */
+
+ vend = S_hextract(aTHX_ nv, &exponent, vhex, NULL);
+ S_hextract(aTHX_ nv, &exponent, vhex, vend);
+
+ if (nv < 0)
+ *p++ = '-';
+ else if (plus)
+ *p++ = plus;
+ *p++ = '0';
+ if (lower) {
+ *p++ = 'x';
+ }
+ else {
+ *p++ = 'X';
+ xdig += 16; /* Use uppercase hex. */
+ }
+
+ /* Find the first non-zero xdigit. */
+ for (v = vhex; v < vend; v++) {
+ if (*v) {
+ vfnz = v;
+ break;
+ }
+ }
+
+ if (vfnz) {
+ U8* vlnz = NULL; /* The last non-zero. */
+
+ /* Find the last non-zero xdigit. */
+ for (v = vend - 1; v >= vhex; v--) {
+ if (*v) {
+ vlnz = v;
+ break;
+ }
+ }
+
+ /* Adjust the exponent so that the first output
+ * xdigit aligns with the 4-bit nybbles. */
+ exponent -= NV_MANT_DIG % 4 ? NV_MANT_DIG % 4 : 4;
+
+ if (precis > 0) {
+ v = vhex + precis + 1;
+ if (v < vend) {
+ /* Round away from zero: if the tail
+ * beyond the precis xdigits is equal to
+ * or greater than 0x8000... */
+ bool round = *v > 0x8;
+ if (!round && *v == 0x8) {
+ for (v++; v < vend; v++) {
+ if (*v) {
+ round = TRUE;
+ break;
+ }
+ }
+ }
+ if (round) {
+ for (v = vhex + precis; v >= vhex; v--) {
+ if (*v < 0xF) {
+ (*v)++;
+ break;
+ }
+ *v = 0;
+ if (v == vhex) {
+ /* If the carry goes all the way to
+ * the front, we need to output
+ * a single '1'. This goes against
+ * the "xdigit and then radix"
+ * but since this is "cannot happen"
+ * category, that is probably good. */
+ *p++ = xdig[1];
+ }
+ }
+ }
+ /* The new effective "last non zero". */
+ vlnz = vhex + precis;
+ }
+ else {
+ zerotail = precis - (vlnz - vhex);
+ }
+ }
+
+ v = vhex;
+ *p++ = xdig[*v++];
+
+ /* The radix is always output after the first
+ * non-zero xdigit, or if alt. */
+ if (vfnz < vlnz || alt) {
+#ifndef USE_LOCALE_NUMERIC
+ *p++ = '.';
+#else
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+ if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) {
+ STRLEN n;
+ const char* r = SvPV(PL_numeric_radix_sv, n);
+ Copy(r, p, n, char);
+ p += n;
+ }
+ else {
+ *p++ = '.';
+ }
+ RESTORE_LC_NUMERIC();
+#endif
+ }
+
+ while (v <= vlnz)
+ *p++ = xdig[*v++];
+
+ while (zerotail--)
+ *p++ = '0';
+ }
+ else {
+ *p++ = '0';
+ exponent = 0;
+ }
+
+ elen = p - PL_efloatbuf;
+ elen += my_snprintf(p, PL_efloatsize - elen,
+ "%c%+d", lower ? 'p' : 'P',
+ exponent);
+
+ if (elen < width) {
+ if (left) {
+ /* Pad the back with spaces. */
+ memset(PL_efloatbuf + elen, ' ', width - elen);
+ }
+ else if (fill == '0') {
+ /* Insert the zeros between the "0x" and
+ * the digits, otherwise we end up with
+ * "0000xHHH..." */
+ STRLEN nzero = width - elen;
+ char* zerox = PL_efloatbuf + 2;
+ Move(zerox, zerox + nzero, elen - 2, char);
+ memset(zerox, fill, nzero);
+ }
+ else {
+ /* Move it to the right. */
+ Move(PL_efloatbuf, PL_efloatbuf + width - elen,
+ elen, char);
+ /* Pad the front with spaces. */
+ memset(PL_efloatbuf, ' ', width - elen);
+ }
+ elen = width;
+ }
+ }
+ else {
char *ptr = ebuf + sizeof ebuf;
*--ptr = '\0';
*--ptr = c;
* that is safe to use, even though it's not literal */
GCC_DIAG_IGNORE(-Wformat-nonliteral);
#if defined(HAS_LONG_DOUBLE)
- elen = ((intsize == 'q')
- ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
- : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
+ elen = ((intsize == 'q')
+ ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
+ : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
#else
- elen = my_sprintf(PL_efloatbuf, ptr, nv);
+ elen = my_sprintf(PL_efloatbuf, ptr, nv);
#endif
GCC_DIAG_RESTORE;
}
+
float_converted:
eptr = PL_efloatbuf;
struct xpvinvlist {
_XPV_HEAD;
- IV prev_index;
- STRLEN iterator;
- bool is_offset; /* */
+ IV prev_index; /* caches result of previous invlist_search() */
+ STRLEN iterator; /* Stores where we are in iterating */
+ bool is_offset; /* The data structure for all inversion lists
+ begins with an element for code point U+0000.
+ If this bool is set, the actual list contains
+ that 0; otherwise, the list actually begins
+ with the following element. Thus to invert
+ the list, merely toggle this flag */
};
/* This structure works in 3 ways - regular scalar, GV with GP, or fast
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='undef'
+d_ldexpl='undef'
d_libm_lib_version='undef'
d_link='undef'
d_localtime64='undef'
libm_lib_version='0'
libperl='libperl.a'
localtime_r_proto='0'
+longdblkind=0
longdblsize=8
longlongsize=8
longsize='4'
'../cpan/CPAN' => 1,
'../cpan/Devel-PPPort' => 1,
'../cpan/Encode' => 1,
+ '../cpan/ExtUtils-Command' => 1,
'../cpan/ExtUtils-Constant' => 1,
+ '../cpan/ExtUtils-Install' => 1,
'../cpan/ExtUtils-MakeMaker' => 1,
+ '../cpan/ExtUtils-Manifest' => 1,
'../cpan/File-Fetch' => 1,
'../cpan/IPC-Cmd' => 1,
'../cpan/IPC-SysV' => 1,
'../cpan/Test-Simple' => 1,
'../cpan/podlators' => 1,
'../dist/Cwd' => 1,
- '../dist/ExtUtils-Command' => 1,
- '../dist/ExtUtils-Install' => 1,
- '../dist/ExtUtils-Manifest' => 1,
'../dist/ExtUtils-ParseXS' => 1,
'../dist/Tie-File' => 1,
);
chdir 't';
}
-print "1..169\n";
+print "1..170\n";
sub failed {
my ($got, $expected, $name) = @_;
# ng: 'Missing $ on loop variable'
like $@, "^No such class a1b at ", 'TYPE of my of for statement';
+eval 'method {} {$_,undef}';
+like $@, qq/^Can't call method "method" on unblessed reference at /,
+ 'method BLOCK {...} does not try to disambiguate';
+
# Add new tests HERE (above this line)
# bug #74022: Loop on characters in \p{OtherIDContinue}
elsif ($^O eq 'VMS') {
$wd = `show default`;
}
-elsif ($ENV{PWD}) {
- $wd = $ENV{PWD};
-}
elsif ( $^O =~ /android/ || $^O eq 'nto' ) {
# On Android and Blackberry 10, pwd is a shell builtin, so plain `pwd`
# won't cut it
# op.c
defined(@a = (1,2,3));
EXPECT
-OPTION fatal
-Can't use 'defined(@array)' (Maybe you should just omit the defined()?) at - line 2.
########
# op.c
defined(%h);
ok !defined &{"CORE::$word"}, "no CORE::$word";
}
else {
- $tests += 4;
+ $tests += 2;
ok defined &{"CORE::$word"}, "defined &{'CORE::$word'}";
my $numargs =
$word eq 'delete' || $word eq 'exists' ? 1 :
(() = $proto =~ s/;.*//r =~ /\G$protochar/g);
- my $code =
- "#line 1 This-line-makes-__FILE__-easier-to-test.
- sub { () = (my$word("
- . ($args_for{$word} || join ",", map "\$$_", 1..$numargs)
- . "))}";
- my $core = $bd->coderef2text(eval $code =~ s/my/CORE::/r or die);
- my $my = $bd->coderef2text(eval $code or die);
- is $my, $core, "inlinability of CORE::$word with parens";
- $code =
- "#line 1 This-line-makes-__FILE__-easier-to-test.
- sub { () = (my$word "
- . ($args_for{$word} || join ",", map "\$$_", 1..$numargs)
- . ")}";
- $core = $bd->coderef2text(eval $code =~ s/my/CORE::/r or die);
- $my = $bd->coderef2text(eval $code or die);
- is $my, $core, "inlinability of CORE::$word without parens";
+ inlinable_ok($word, $args_for{$word} || join ",", map "\$$_", 1..$numargs);
# High-precedence tests
my $hpcode;
}
}
+sub inlinable_ok {
+ my ($word, $args, $desc_suffix) = @_;
+ $tests += 2;
+
+ $desc_suffix //= '';
+
+ for ([with => "($args)"], [without => " $args"]) {
+ my ($preposition, $full_args) = @$_;
+ my $core_code =
+ "#line 1 This-line-makes-__FILE__-easier-to-test.
+ sub { () = (CORE::$word$full_args) }";
+ my $my_code = $core_code =~ s/CORE::$word/my$word/r;
+ my $core = $bd->coderef2text(eval $core_code or die);
+ my $my = $bd->coderef2text(eval $my_code or die);
+ is $my, $core, "inlinability of CORE::$word $preposition parens $desc_suffix";
+ }
+}
+
$tests++;
# This subroutine is outside the warnings scope:
sub foo { goto &CORE::abs }
ok eval { *CORE::exit = \42 },
'[rt.cpan.org #74289] *CORE::foo is not accidentally made read-only';
+for my $word (qw<keys values each>) {
+ # mykeys() etc were aliased to \&CORE::keys etc above
+ my $code = qq{
+ no warnings 'experimental::autoderef';
+ my \$x = [];
+ () = my$word(\$x);
+ 'ok'
+ };
+ $tests++;
+ is(eval($code), 'ok', "inlined $word() on autoderef array") or diag $@;
+}
+
+inlinable_ok($_, '$_{k}', 'on hash')
+ for qw<delete exists>;
+
@UNIVERSAL::ISA = CORE;
is "just another "->ucfirst . "perl hacker,\n"->ucfirst,
"Just another Perl hacker,\n", 'coresubs do not return TARG';
--- /dev/null
+#!./perl
+
+use strict;
+
+use Config;
+
+BEGIN {
+ chdir 't' if -d 't';
+ require './test.pl';
+ eval '0x0p0';
+ print "# $@\n";
+}
+
+plan(tests => 79);
+
+# Test hexfloat literals.
+
+is(0x0p0, 0);
+is(0x0.p0, 0);
+is(0x.0p0, 0);
+is(0x0.0p0, 0);
+is(0x0.00p0, 0);
+
+is(0x1p0, 1);
+is(0x1.p0, 1);
+is(0x1.0p0, 1);
+is(0x1.00p0, 1);
+
+is(0x2p0, 2);
+is(0x2.p0, 2);
+is(0x2.0p0, 2);
+is(0x2.00p0, 2);
+
+is(0x1p1, 2);
+is(0x1.p1, 2);
+is(0x1.0p1, 2);
+is(0x1.00p1, 2);
+
+is(0x.1p0, 0.0625);
+is(0x0.1p0, 0.0625);
+is(0x0.10p0, 0.0625);
+is(0x0.100p0, 0.0625);
+
+# Positive exponents.
+is(0x1p2, 4);
+is(0x1p+2, 4);
+is(0x0p+0, 0);
+
+# Negative exponents.
+is(0x1p-1, 0.5);
+is(0x1.p-1, 0.5);
+is(0x1.0p-1, 0.5);
+is(0x0p-0, 0);
+
+is(0x1p+2, 4);
+is(0x1p-2, 0.25);
+
+is(0x3p+2, 12);
+is(0x3p-2, 0.75);
+
+# Shifting left.
+is(0x1p2, 1 << 2);
+is(0x1p3, 1 << 3);
+is(0x3p4, 3 << 4);
+is(0x3p5, 3 << 5);
+is(0x12p23, 0x12 << 23);
+
+# Shifting right.
+is(0x1p-2, 1 / (1 << 2));
+is(0x1p-3, 1 / (1 << 3));
+is(0x3p-4, 3 / (1 << 4));
+is(0x3p-5, 3 / (1 << 5));
+is(0x12p-23, 0x12 / (1 << 23));
+
+# Negative sign.
+is(-0x1p+2, -4);
+is(-0x1p-2, -0.25);
+is(-0x0p+0, 0);
+is(-0x0p-0, 0);
+
+is(0x0.10p0, 0.0625);
+is(0x0.1p0, 0.0625);
+is(0x.1p0, 0.0625);
+
+is(0x12p+3, 144);
+is(0x12p-3, 2.25);
+
+# Hexdigits (lowercase).
+is(0x9p+0, 9);
+is(0xap+0, 10);
+is(0xfp+0, 15);
+is(0x10p+0, 16);
+is(0x11p+0, 17);
+is(0xabp+0, 171);
+is(0xab.cdp+0, 171.80078125);
+
+# Uppercase hexdigits and exponent prefix.
+is(0xAp+0, 10);
+is(0xFp+0, 15);
+is(0xABP+0, 171);
+is(0xAB.CDP+0, 171.80078125);
+
+# Underbars.
+is(0xa_b.c_dp+1_2, 703696);
+
+# Note that the hexfloat representation is not unique
+# since the exponent can be shifted: no different from
+# 3e4 cf 30e3 cf 30000.
+
+# Needs to use within() instead of is() because of long doubles.
+within(0x1.999999999999ap-4, 0.1, 1e-9);
+within(0x3.3333333333333p-5, 0.1, 1e-9);
+within(0xc.ccccccccccccdp-7, 0.1, 1e-9);
+
+my $warn;
+
+local $SIG{__WARN__} = sub { $warn = shift };
+
+sub get_warn() {
+ my $save = $warn;
+ undef $warn;
+ return $save;
+}
+
+{ # Test certain things that are not hexfloats and should stay that way.
+ eval '0xp3';
+ like(get_warn(), qr/Missing operator before p3/);
+
+ eval '5p3';
+ like(get_warn(), qr/Missing operator before p3/);
+
+ my @a;
+ eval '@a = 0x3..5';
+ is("@a", "3 4 5");
+
+ eval '$a = eval "0x.3"';
+ is($a, '03');
+
+ eval '$a = eval "0xc.3"';
+ is($a, '123');
+}
+
+# Test warnings.
+SKIP:
+{
+ if ($Config{nv_preserves_uv_bits} == 53) {
+ local $^W = 1;
+
+ eval '0x1_0000_0000_0000_0p0';
+ is(get_warn(), undef);
+
+ eval '0x2_0000_0000_0000_0p0';
+ like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
+
+ eval '0x1.0000_0000_0000_0p0';
+ is(get_warn(), undef);
+
+ eval '0x2.0000_0000_0000_0p0';
+ like(get_warn(), qr/^Hexadecimal float: mantissa overflow/);
+
+ eval '0x.1p-1021';
+ is(get_warn(), undef);
+
+ eval '0x.1p-1023';
+ like(get_warn(), qr/^Hexadecimal float: exponent underflow/);
+
+ eval '0x1.fffffffffffffp+1023';
+ is(get_warn(), undef);
+
+ eval '0x1.fffffffffffffp+1024';
+ like(get_warn(), qr/^Hexadecimal float: exponent overflow/);
+ } else {
+ print "# skipping warning tests\n";
+ skip "nv_preserves_uv_bits is $Config{nv_preserves_uv_bits} not 53", 8;
+ }
+}
+
+# sprintf %a/%A testing is done in sprintf2.t,
+# trickier than necessary because of long doubles,
+# and because looseness of the spec.
--- /dev/null
+#!perl
+use strict;
+use warnings;
+
+BEGIN {
+ chdir 't';
+ require './test.pl';
+}
+
+plan(tests => 10);
+
+my @warns;
+local $SIG{__WARN__}= sub { push @warns, $_[0] };
+my $error;
+
+eval "require; 1" or $error = $@;
+ok(1, "Check that eval 'require' does not segv");
+ok(0 == @warns, "We expect the eval to die, without producing warnings");
+like($error, qr/Missing or undefined argument to require/, "Make sure we got the error we expect");
+
+@warns= ();
+$error= undef;
+
+sub TIESCALAR{bless[]}
+sub STORE{}
+sub FETCH{}
+tie my $x, "";
+$x = "x";
+eval 'require $x; 1' or $error = $@;
+ok(0 == @warns,
+ 'no warnings from require $tied_undef_after_str_assignment');
+like($error, qr/^Missing or undefined argument to require/,
+ "Make sure we got the error we expect");
+
+@warns= ();
+$error= undef;
+
+$x = 3;
+eval 'require $x; 1' or $error = $@;
+ok(0 == @warns,
+ 'no warnings from require $tied_undef_after_num_assignment');
+like($error, qr/^Missing or undefined argument to require/,
+ "Make sure we got the error we expect");
+
+@warns= ();
+$error= undef;
+
+*CORE::GLOBAL::require = *CORE::GLOBAL::require = sub { };
+eval "require; 1" or $error = $@;
+ok(1, "Check that eval 'require' on overloaded require does not segv");
+ok(0 == @warns, "We expect the eval to die, without producing warnings");
+
+# NOTE! The following test does NOT represent a commitment or promise that the following logic is
+# the *right* thing to do. It may well not be. But this is how it works now, and we want to test it.
+# IOW, do not use this test as the basis to argue that this is how it SHOULD work. Thanks, yves.
+ok(!defined($error), "We do not expect the overloaded version of require to die from no arguments");
+
+
+
>%6. 6s< >''< >%6. 6s INVALID REDUNDANT< >(See use of $w in code above)<
>%6 .6s< >''< >%6 .6s INVALID REDUNDANT<
>%6.6 s< >''< >%6.6 s INVALID REDUNDANT<
->%A< >''< >%A INVALID REDUNDANT<
+>%A< >0< >< >%A tested in sprintf2.t skip: all<
>%B< >2**32-1< >11111111111111111111111111111111<
>%+B< >2**32-1< >11111111111111111111111111111111<
>%#B< >2**32-1< >0B11111111111111111111111111111111<
>%#X< >2**32-1< >0XFFFFFFFF<
>%Y< >''< >%Y INVALID REDUNDANT<
>%Z< >''< >%Z INVALID REDUNDANT<
->%a< >''< >%a INVALID REDUNDANT<
+>%a< >0< >< >%a tested in sprintf2.t skip: all<
>%b< >2**32-1< >11111111111111111111111111111111<
>%+b< >2**32-1< >11111111111111111111111111111111<
>%#b< >2**32-1< >0b11111111111111111111111111111111<
eval { my $q = pack "q", 0 };
my $Q = $@ eq '';
-plan tests => 1406 + ($Q ? 0 : 12);
+# %a and %A depend on the floating point config
+# This totally doesn't test non-IEEE-754 float formats.
+my @hexfloat;
+print "# uvsize = $Config{uvsize}\n";
+print "# nvsize = $Config{nvsize}\n";
+print "# nv_preserves_uv_bits = $Config{nv_preserves_uv_bits}\n";
+print "# d_quad = $Config{d_quad}\n";
+if ($Config{nvsize} == 8 &&
+ (
+ # IEEE-754 64-bit ("double precision"), the most common out there
+ ($Config{uvsize} == 8 && $Config{nv_preserves_uv_bits} == 53)
+ ||
+ # If we have a quad we can still get the mantissa bits.
+ ($Config{uvsize} == 4 && $Config{d_quad})
+ )
+ ) {
+ @hexfloat = (
+ [ '%a', '0', '0x0p+0' ],
+ [ '%a', '1', '0x1p+0' ],
+ [ '%a', '1.0', '0x1p+0' ],
+ [ '%a', '0.5', '0x1p-1' ],
+ [ '%a', '0.25', '0x1p-2' ],
+ [ '%a', '0.75', '0x1.8p-1' ],
+ [ '%a', '3.14', '0x1.91eb851eb851fp+1' ],
+ [ '%a', '-1.0', '-0x1p+0' ],
+ [ '%a', '-3.14', '-0x1.91eb851eb851fp+1' ],
+ [ '%a', '0.1', '0x1.999999999999ap-4' ],
+ [ '%a', '1/7', '0x1.2492492492492p-3' ],
+ [ '%a', 'sqrt(2)', '0x1.6a09e667f3bcdp+0' ],
+ [ '%a', 'exp(1)', '0x1.5bf0a8b145769p+1' ],
+ [ '%a', '2**-10', '0x1p-10' ],
+ [ '%a', '2**10', '0x1p+10' ],
+ [ '%a', '1e-9', '0x1.12e0be826d695p-30' ],
+ [ '%a', '1e9', '0x1.dcd65p+29' ],
+
+ [ '%#a', '1', '0x1.p+0' ],
+ [ '%+a', '1', '+0x1p+0' ],
+ [ '%+a', '-1', '-0x1p+0' ],
+ [ '% a', ' 1', ' 0x1p+0' ],
+ [ '% a', '-1', '-0x1p+0' ],
+
+ [ '%8a', '3.14', '0x1.91eb851eb851fp+1' ],
+ [ '%13a', '3.14', '0x1.91eb851eb851fp+1' ],
+ [ '%20a', '3.14', '0x1.91eb851eb851fp+1' ],
+ [ '%.4a', '3.14', '0x1.91ecp+1' ],
+ [ '%.5a', '3.14', '0x1.91eb8p+1' ],
+ [ '%.6a', '3.14', '0x1.91eb85p+1' ],
+ [ '%.20a', '3.14', '0x1.91eb851eb851f0000000p+1' ],
+ [ '%20.10a', '3.14', ' 0x1.91eb851eb8p+1' ],
+ [ '%20.15a', '3.14', '0x1.91eb851eb851f00p+1' ],
+ [ '% 20.10a', '3.14', ' 0x1.91eb851eb8p+1' ],
+ [ '%020.10a', '3.14', '0x0001.91eb851eb8p+1' ],
+
+ [ '%30a', '3.14', ' 0x1.91eb851eb851fp+1' ],
+ [ '%-30a', '3.14', '0x1.91eb851eb851fp+1 ' ],
+ [ '%030a', '3.14', '0x00000000001.91eb851eb851fp+1' ],
+ [ '%-030a', '3.14', '0x1.91eb851eb851fp+1 ' ],
+
+ [ '%.40a', '3.14',
+ '0x1.91eb851eb851f000000000000000000000000000p+1' ],
+
+ [ '%A', '3.14', '0X1.91EB851EB851FP+1' ],
+ );
+} elsif (($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
+ # 80-bit ("extended precision") long double, pack F is the NV
+ # cd cc cc cc cc cc cc cc fb bf 00 00 00 00 00 00
+ # cd cc cc cc cc cc cc cc fb bf 00 00
+ (pack("F", 0.1) =~ /^\xCD/ || # LE
+ pack("F", 0.1) =~ /\xCD$/)) { # BE (if this ever happens)
+ @hexfloat = (
+ [ '%a', '0', '0x0p+0' ],
+ [ '%a', '1', '0x8p-3' ],
+ [ '%a', '1.0', '0x8p-3' ],
+ [ '%a', '0.5', '0x8p-4' ],
+ [ '%a', '0.25', '0x8p-5' ],
+ [ '%a', '0.75', '0xcp-4' ],
+ [ '%a', '3.14', '0xc.8f5c28f5c28f5c3p-2' ],
+ [ '%a', '-1.0', '-0x8p-3' ],
+ [ '%a', '-3.14', '-0xc.8f5c28f5c28f5c3p-2' ],
+ [ '%a', '0.1', '0xc.ccccccccccccccdp-7' ],
+ [ '%a', '1/7', '0x9.249249249249249p-6' ],
+ [ '%a', 'sqrt(2)', '0xb.504f333f9de6484p-3' ],
+ [ '%a', 'exp(1)', '0xa.df85458a2bb4a9bp-2' ],
+ [ '%a', '2**-10', '0x8p-13' ],
+ [ '%a', '2**10', '0x8p+7' ],
+ [ '%a', '1e-9', '0x8.9705f4136b4a597p-33' ],
+ [ '%a', '1e9', '0xe.e6b28p+26' ],
+
+ [ '%#a', '1', '0x8.p-3' ],
+ [ '%+a', '1', '+0x8p-3' ],
+ [ '%+a', '-1', '-0x8p-3' ],
+ [ '% a', ' 1', ' 0x8p-3' ],
+ [ '% a', '-1', '-0x8p-3' ],
+
+ [ '%8a', '3.14', '0xc.8f5c28f5c28f5c3p-2' ],
+ [ '%13a', '3.14', '0xc.8f5c28f5c28f5c3p-2' ],
+ [ '%20a', '3.14', '0xc.8f5c28f5c28f5c3p-2' ],
+ [ '%.4a', '3.14', '0xc.8f5cp-2' ],
+ [ '%.5a', '3.14', '0xc.8f5c3p-2' ],
+ [ '%.6a', '3.14', '0xc.8f5c29p-2' ],
+ [ '%.20a', '3.14', '0xc.8f5c28f5c28f5c300000p-2' ],
+ [ '%20.10a', '3.14', ' 0xc.8f5c28f5c3p-2' ],
+ [ '%20.15a', '3.14', '0xc.8f5c28f5c28f5c3p-2' ],
+ [ '% 20.10a', '3.14', ' 0xc.8f5c28f5c3p-2' ],
+ [ '%020.10a', '3.14', '0x000c.8f5c28f5c3p-2' ],
+
+ [ '%30a', '3.14', ' 0xc.8f5c28f5c28f5c3p-2' ],
+ [ '%-30a', '3.14', '0xc.8f5c28f5c28f5c3p-2 ' ],
+ [ '%030a', '3.14', '0x00000000c.8f5c28f5c28f5c3p-2' ],
+ [ '%-030a', '3.14', '0xc.8f5c28f5c28f5c3p-2 ' ],
+
+ [ '%.40a', '3.14',
+ '0xc.8f5c28f5c28f5c30000000000000000000000000p-2' ],
+
+ [ '%A', '3.14', '0XC.8F5C28F5C28F5C3P-2' ],
+ );
+} elsif (
+ # IEEE 754 128-bit ("quadruple precision"), e.g. IA-64 (Itanium) in VMS
+ $Config{nvsize} == 16 &&
+ # 9a 99 99 99 99 99 99 99 99 99 99 99 99 99 fb 3f (LE), pack F is the NV
+ # (compare this with "double-double")
+ (pack("F", 0.1) =~ /^\x9A\x99{6}/ || # LE
+ pack("F", 0.1) =~ /\x99{6}x9A$/) # BE
+ ) {
+ @hexfloat = (
+ [ '%a', '0', '0x1p-1' ],
+ [ '%a', '1', '0x1p+0' ],
+ [ '%a', '1.0', '0x1p+0' ],
+ [ '%a', '0.5', '0x1p-1' ],
+ [ '%a', '0.25', '0x1p-2' ],
+ [ '%a', '0.75', '0x1.8p-1' ],
+ [ '%a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%a', '-1', '-0x1p+0' ],
+ [ '%a', '-3.14', '-0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%a', '0.1', '0x1.999999999999999999999999999ap-4' ],
+ [ '%a', '1/7', '0x1.2492492492492492492492492492p-3' ],
+ [ '%a', 'sqrt(2)', '0x1.6a09e667f3bcc908b2fb1366ea95p+0' ],
+ [ '%a', 'exp(1)', '0x1.5bf0a8b1457695355fb8ac404e7ap+1' ],
+ [ '%a', '2**-10', '0x1p-10' ],
+ [ '%a', '2**10', '0x1p+10' ],
+ [ '%a', '1e-09', '0x1.12e0be826d694b2e62d01511f12ap-30' ],
+ [ '%a', '1e9', '0x1.dcd65p+29' ],
+
+ [ '%#a', '1', '0x1.p+0' ],
+ [ '%+a', '1', '+0x1p+0' ],
+ [ '%+a', '-1', '-0x1p+0' ],
+ [ '% a', '1', ' 0x1p+0' ],
+ [ '% a', '-1', '-0x1p+0' ],
+
+ [ '%8a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%13a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%20a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%.4a', '3.14', '0x1.91ecp+1' ],
+ [ '%.5a', '3.14', '0x1.91eb8p+1' ],
+ [ '%.6a', '3.14', '0x1.91eb85p+1' ],
+ [ '%.20a', '3.14', '0x1.91eb851eb851eb851eb8p+1' ],
+ [ '%20.10a', '3.14', ' 0x1.91eb851eb8p+1' ],
+ [ '%20.15a', '3.14', '0x1.91eb851eb851eb8p+1' ],
+ [ '% 20.10a', '3.14', ' 0x1.91eb851eb8p+1' ],
+ [ '%020.10a', '3.14', '0x0001.91eb851eb8p+1' ],
+
+ [ '%30a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%-30a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%030a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+ [ '%-030a', '3.14', '0x1.91eb851eb851eb851eb851eb851fp+1' ],
+
+ [ '%.40a', '3.14',
+ '0x1.91eb851eb851eb851eb851eb851f000000000000p+1' ],
+
+ [ '%A', '3.14', '0X1.91EB851EB851EB851EB851EB851FP+1' ],
+ );
+} elsif (
+ # "double-double", two 64-bit doubles end to end
+ $Config{nvsize} == 16 &&
+ # bf b9 99 99 99 99 99 9a 3c 59 99 99 99 99 99 9a (BE), pack F is the NV
+ # (compare this with "quadruple precision")
+ (pack("F", 0.1) =~ /^\x9A\x99{5}\x59\x3C/ || # LE
+ pack("F", 0.1) =~ /\x3C\x59\x99{5}\x9A$/) # BE
+ ) {
+ # XXX these values are probably slightly wrong, even if
+ # the double-double extraction code gets fixed, the exact
+ # truncation/rounding effects are unknown.
+ @hexfloat = (
+ [ '%a', '0', '0x1p-1' ],
+ [ '%a', '1', '0x1p+0' ],
+ [ '%a', '1.0', '0x1p+0' ],
+ [ '%a', '0.5', '0x1p-1' ],
+ [ '%a', '0.25', '0x1p-2' ],
+ [ '%a', '0.75', '0x1.8p-1' ],
+ [ '%a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%a', '-1', '-0x1p+0' ],
+ [ '%a', '-3.14', '-0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%a', '0.1', '0x1.99999999999999999999999999ap-4' ],
+ [ '%a', '1/7', '0x1.249249249249249249249249249p-3' ],
+ [ '%a', 'sqrt(2)', '0x1.6a09e667f3bcc908b2fb1366ea9p+0' ],
+ [ '%a', 'exp(1)', '0x1.5bf0a8b1457695355fb8ac404e8p+1' ],
+ [ '%a', '2**-10', '0x1p-10' ],
+ [ '%a', '2**10', '0x1p+10' ],
+ [ '%a', '1e-09', '0x1.12e0be826d694b2e62d01511f13p-30' ],
+ [ '%a', '1e9', '0x1.dcd65p+29' ],
+
+ [ '%#a', '1', '0x1.p+0' ],
+ [ '%+a', '1', '+0x1p+0' ],
+ [ '%+a', '-1', '-0x1p+0' ],
+ [ '% a', '1', ' 0x1p+0' ],
+ [ '% a', '-1', '-0x1p+0' ],
+
+ [ '%8a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%13a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%20a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%.4a', '3.14', '0x1.91ecp+1' ],
+ [ '%.5a', '3.14', '0x1.91eb8p+1' ],
+ [ '%.6a', '3.14', '0x1.91eb85p+1' ],
+ [ '%.20a', '3.14', '0x1.91eb851eb851eb851eb8p+1' ],
+ [ '%20.10a', '3.14', ' 0x1.91eb851eb8p+1' ],
+ [ '%20.15a', '3.14', '0x1.91eb851eb851eb8p+1' ],
+ [ '% 20.10a', '3.14', ' 0x1.91eb851eb8p+1' ],
+ [ '%020.10a', '3.14', '0x0001.91eb851eb8p+1' ],
+
+ [ '%30a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%-30a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%030a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+ [ '%-030a', '3.14', '0x1.91eb851eb851eb851eb851eb852p+1' ],
+
+ [ '%.40a', '3.14',
+ '0x1.91eb851eb851eb851eb851eb8520000000000000p+1' ],
+
+ [ '%A', '3.14', '0X1.91EB851EB851EB851EB851EB852P+1' ],
+ );
+} else {
+ print "# no hexfloat tests\n";
+}
+
+plan tests => 1406 + ($Q ? 0 : 12) + @hexfloat;
use strict;
use Config;
$o::count = 0;
() = sprintf "%.1s", $o;
is $o::count, '1', 'sprinf %.1s overload count';
+
+for my $t (@hexfloat) {
+ my ($format, $arg, $expected) = @$t;
+ $arg = eval $arg;
+ my $result = sprintf($format, $arg);
+ is($result, $expected, "'$format' '$arg' -> '$result' cf '$expected'");
+}
'stat $ioref resets stat type';
{
- my @statbuf = stat STDOUT;
+ open(FOO, ">$tmpfile") || DIE("Can't open temp test file: $!");
+ my @statbuf = stat FOO;
stat "test.pl";
- my @lstatbuf = lstat *STDOUT{IO};
+ my @lstatbuf = lstat *FOO{IO};
is "@lstatbuf", "@statbuf", 'lstat $ioref reverts to regular fstat';
+ close(FOO);
+ unlink $tmpfile or print "# unlink failed: $!\n";
}
SKIP: {
require './test.pl';
}
-plan( tests => 33 );
+plan( tests => 34 );
sub empty_sub {}
is $str[1], $str[0],
'Pure-Perl sub clobbering sub whose DESTROY assigns to the glob';
}
+
+# [perl #122107] previously this would return
+# Subroutine BEGIN redefined at (eval 2) line 2.
+fresh_perl_is(<<'EOS', "", { stderr => 1 },
+use strict; use warnings; eval q/use File::{Spec}/; eval q/use File::Spec/;
+EOS
+ "check special blocks are cleared on error");
local $ENV{PATH} = $tmp;
is(eval { `$echo 1` }, undef);
- like($@, qr/^Insecure directory in \$ENV\{PATH}/);
+ # Message can be different depending on whether echo
+ # is a builtin or not
+ like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/);
}
SKIP: {
require "./test.pl";
}
-plan tests => 144;
+plan tests => 143;
$a = {};
bless $a, "Bob";
like $@, qr/^Invalid version format/;
my $subs = join ' ', sort grep { defined &{"UNIVERSAL::$_"} } keys %UNIVERSAL::;
-## The test for import here is *not* because we want to ensure that UNIVERSAL
-## can always import; it is an historical accident that UNIVERSAL can import.
if ('a' lt 'A') {
- is $subs, "can import isa DOES VERSION";
+ is $subs, "can isa DOES VERSION";
} else {
- is $subs, "DOES VERSION can import isa";
+ is $subs, "DOES VERSION can isa";
}
ok $a->isa("UNIVERSAL");
ok ! UNIVERSAL::isa("\xff\xff\xff\0", 'HASH');
{
- package Pickup;
- no warnings "deprecated";
- use UNIVERSAL qw( isa can VERSION );
-
- ::ok isa "Pickup", UNIVERSAL;
- ::cmp_ok can( "Pickup", "can" ), '==', \&UNIVERSAL::can;
- ::ok VERSION "UNIVERSAL" ;
-}
-
-{
# test isa() and can() on magic variables
"Human" =~ /(.*)/;
ok $1->isa("Human");
my $m;
local $SIG{__WARN__} = sub { $m = $_[0] };
eval "use UNIVERSAL 'can'";
- like($m, qr/^UNIVERSAL->import is deprecated/,
- "deprecation warning for UNIVERSAL->import('can')");
+ like($@, qr/^UNIVERSAL does not export anything\b/,
+ "error for UNIVERSAL->import('can')");
+ is($m, undef,
+ "no deprecation warning for UNIVERSAL->import('can')");
undef $m;
eval "use UNIVERSAL";
+ is($@, "",
+ "no error for UNIVERSAL->import");
is($m, undef,
"no deprecation warning for UNIVERSAL->import");
}
podlators cpan/podlators/scripts/pod2man.PL f81acf53f3ff46cdcc5ebdd661c5d13eb35d20d6
podlators cpan/podlators/scripts/pod2text.PL b4693fcfe4a0a1b38a215cfb8985a65d5d025d69
version cpan/version/lib/version.pm fa9931d4db05aff9a0a6ef558610b1a472d9306e
-version vutil.c abd88f59a6e0cfe7b4e45b1859f414042ea254aa
+version vutil.c 668f17ca43e2527645674d29ba772b86330d5663
version vxs.inc 9064aacbdfe42bb584a068f62b505dd11dbb4dc4
pod/perltru64.pod Verbatim line length including indents exceeds 79 by 5
pod/perlvms.pod ? Should you be using F<...> or maybe L<...> instead of 1
pod/perlwin32.pod Verbatim line length including indents exceeds 79 by 12
-porting/epigraphs.pod Verbatim line length including indents exceeds 79 by 18
+porting/epigraphs.pod Verbatim line length including indents exceeds 79 by 23
porting/expand-macro.pl Verbatim line length including indents exceeds 79 by 2
porting/release_managers_guide.pod Verbatim line length including indents exceeds 79 by 6
porting/todo.pod Verbatim line length including indents exceeds 79 by 7
# Bb: uninitialized data (bss)
# Ss: uninitialized data "for small objects"
$symbols->{data}{bss}{$1}{$symbols->{o}}++;
- } elsif (/^0{16} D _LIB_VERSION$/) {
+ } elsif (/^D _LIB_VERSION$/) {
# Skip the _LIB_VERSION (not ours, probably libm)
} elsif (/^[DdGg] (\w+)$/) {
# Dd: initialized data
ok(! exists $symbols{text}{Perl_GetVars}, "has no Perl_GetVars");
}
+# See the comments in the beginning for what "undefined symbols"
+# really means. We *should* have many of those, that is a good thing.
ok(keys %{$symbols{undef}}, "has undefined symbols");
+# There are certain symbols we expect to see.
+
# memchr, memcmp, memcpy should be used all over the place.
#
-# chmod, socket, getenv, sigaction, time are system/library
-# calls that should each see at least one use.
-my @good = qw(memchr memcmp memcpy
- chmod socket getenv sigaction time);
-if ($Config{usedl}) {
- push @good, 'dlopen';
+# chmod, socket, getenv, sigaction, sqrt, time are system/library
+# calls that should each see at least one use. sqrt can be sqrtl
+# if so configured.
+my %expected = (
+ memchr => 'd_memchr',
+ memcmp => 'd_memcmp',
+ memcpy => 'd_memcpy',
+ chmod => undef, # There is no Configure symbol for chmod.
+ socket => 'd_socket',
+ getenv => undef, # There is no Configure symbol for getenv,
+ sigaction => 'd_sigaction',
+ time => 'd_time',
+ );
+
+if ($Config{uselongdouble} && $Config{d_longdbl}) {
+ $expected{sqrtl} = 'd_sqrtl';
+} else {
+ $expected{sqrt} = undef; # There is no Configure symbol for sqrt.
+}
+
+# DynaLoader will use dlopen, unless we are building static,
+# and in the platforms we are supporting in this test.
+if ($Config{usedl} ) {
+ $expected{dlopen} = 'd_dlopen';
}
-for my $good (@good) {
- my @o = exists $symbols{undef}{$good} ?
- sort keys %{ $symbols{undef}{$good} } : ();
- ok(@o, "uses $good (@o)");
+
+for my $symbol (sort keys %expected) {
+ if (defined $expected{$symbol} && !$Config{$expected{$symbol}}) {
+ SKIP: {
+ skip("no $symbol");
+ }
+ next;
+ }
+ my @o = exists $symbols{undef}{$symbol} ?
+ sort keys %{ $symbols{undef}{$symbol} } : ();
+ # In some FreeBSD versions memcmp disappears (compiler inlining?).
+ if (($^O eq 'freebsd' ||
+ (defined $fake_style && $fake_style eq 'freebsd')) &&
+ $symbol eq 'memcmp' && @o == 0) {
+ SKIP: {
+ skip("freebsd memcmp");
+ }
+ } else {
+ ok(@o, "uses $symbol (@o)");
+ }
}
+# There are certain symbols we expect NOT to see.
+#
# gets is horribly unsafe.
#
-# fgets should not be used (Perl has its own API), even without perlio.
+# fgets should not be used (Perl has its own API, sv_gets),
+# even without perlio.
#
# tmpfile is unsafe.
#
-# strcpy, strcat, strncpy, strncpy are unsafe.
+# strcat, strcpy, strncat, strncpy are unsafe.
#
# sprintf and vsprintf should not be used because
# Perl has its own safer and more portable implementations.
# (One exception: for certain floating point outputs
-# the native sprintf is still used, see below.)
+# the native sprintf is still used in some platforms, see below.)
+#
+# atoi has unsafe and undefined failure modes, and is affected by locale.
+# Its cousins include atol and atoll.
+#
+# strtol and strtoul are affected by locale.
+# Cousins include strtoq.
#
-# XXX: add atoi() to @bad - unsafe and undefined failure modes.
+# system should not be used, use pp_system or my_popen.
#
-my @bad = qw(gets fgets
- tmpfile
- strcpy strcat strncpy strncat tmpfile
- sprintf vsprintf);
-for my $bad (@bad) {
- my @o = exists $symbols{undef}{$bad} ?
- sort keys %{ $symbols{undef}{$bad} } : ();
+
+my %unexpected;
+
+for my $str (qw(system)) {
+ $unexpected{$str} = "d_$str";
+}
+
+for my $stdio (qw(gets fgets tmpfile sprintf vsprintf)) {
+ $unexpected{$stdio} = undef; # No Configure symbol for these.
+}
+for my $str (qw(strcat strcpy strncat strncpy)) {
+ $unexpected{$str} = undef; # No Configure symbol for these.
+}
+
+$unexpected{atoi} = undef; # No Configure symbol for atoi.
+$unexpected{atol} = undef; # No Configure symbol for atol.
+
+for my $str (qw(atoll strtol strtoul strtoq)) {
+ $unexpected{$str} = "d_$str";
+}
+
+for my $symbol (sort keys %unexpected) {
+ if (defined $unexpected{$symbol} && !$Config{$unexpected{$symbol}}) {
+ SKIP: {
+ skip("no $symbol");
+ }
+ next;
+ }
+ my @o = exists $symbols{undef}{$symbol} ?
+ sort keys %{ $symbols{undef}{$symbol} } : ();
# While sprintf() is bad in the general case,
# some platforms implement Gconvert via sprintf, in sv.o.
- if ($bad eq 'sprintf' &&
+ if ($symbol eq 'sprintf' &&
$Config{d_Gconvert} =~ /^sprintf/ &&
@o == 1 && $o[0] eq 'sv.o') {
SKIP: {
skip("uses sprintf for Gconvert in sv.o");
}
} else {
- is(@o, 0, "uses no $bad (@o)");
+ is(@o, 0, "uses no $symbol (@o)");
}
}
is($word, 'раб', "Handles UTF8 trie correctly");
}
+ { # [perl #122460]
+ my $a = "rdvark";
+ $a =~ /(?{})(?=[A-Za-z0-9_])a*?/g;
+ is (pos $a, 0, "optimizer correctly thinks (?=...) is 0-length");
+ }
+
#
# Keep the following tests last -- they may crash perl
#
'/(?(1)x|y|z)/' => 'Switch (?(condition)... contains too many branches {#} m/(?(1)x|y|{#}z)/',
'/(?(x)y|x)/' => 'Unknown switch condition (?(...)) {#} m/(?(x{#})y|x)/',
+ '/(?(??{}))/' => 'Unknown switch condition (?(...)) {#} m/(?(?{#}?{}))/',
+ '/(?(?[]))/' => 'Unknown switch condition (?(...)) {#} m/(?(?{#}[]))/',
'/(?/' => 'Sequence (? incomplete {#} m/(?{#}/',
my %complements;
foreach my $b (0..255) {
my %got;
- my $display_b = sprintf("\\x%02X", $b);
+ my $display_b = sprintf("0x%02X", $b);
for my $type ('utf8','not-utf8') {
my $str=chr($b).chr($b);
if ($type eq 'utf8') {
SKIP: {
eval { require POSIX; POSIX->import("locale_h"); };
- if ($@) { skip "Can't test locale (maybe you are missing POSIX)", 6; }
+ if ($@ || !eval { &POSIX::LC_ALL; 1 }) {
+ skip "Can't test locale (maybe you are missing POSIX)", 6;
+ }
setlocale(&POSIX::LC_ALL, "C");
use locale;
EOF
"", {}, "no locales where LC_NUMERIC breaks");
-{
+SKIP: {
+ skip("Windows stores locale defaults in the registry", 1 )
+ if $^O eq 'MSWin32';
local $ENV{LC_NUMERIC}; # So not taken as a default
local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
local $ENV{LANG}; # So not taken as a default
my $tmpfile = tempfile();
my $scriptfile = tempfile();
-my $b = pack("C*", unpack("U0C*", pack("U",256)));
+my $b = chr 256; utf8::encode $b;
$r = runperl( switches => [ '-CO', '-w' ],
prog => 'print chr(256)',
use utf8;
use open qw( :utf8 :std );
-plan tests => 93;
+plan tests => 90;
$a = {};
bless $a, "Bòb";
eval 'sub UNIVERSAL::slèèp {}';
ok $a->can("slèèp");
-{
- package Pìckùp;
- no warnings "deprecated";
- use UNIVERSAL qw( isa can VERSION );
-
- ::ok isa "Pìckùp", UNIVERSAL;
- ::cmp_ok can( "Pìckùp", "can" ), '==', \&UNIVERSAL::can;
- ::ok VERSION "UNIVERSAL" ;
-}
-
package Fòò;
sub DOES { 1 }
Perl_taint_proper(pTHX_ const char *f, const char *const s)
{
#if defined(HAS_SETEUID) && defined(DEBUGGING)
- dVAR;
-
PERL_ARGS_ASSERT_TAINT_PROPER;
{
STATIC int
S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp)
{
- dVAR;
-
PERL_ARGS_ASSERT_TOKEREPORT;
if (DEBUG_T_TEST) {
if (*e != '\n' && *e != '\0')
return; /* false alarm */
- line_num = atoi(n)-1;
+ line_num = grok_atou(n, &e) - 1;
if (t - s > 0) {
const STRLEN len = t - s;
#ifdef DEBUGGING
static const char* const exp_name[] =
{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
- "ATTRTERM", "TERMBLOCK", "POSTDEREF", "TERMORDORDOR"
+ "ATTRTERM", "TERMBLOCK", "XBLOCKTERM", "POSTDEREF",
+ "TERMORDORDOR"
};
#endif
PL_lex_allbrackets++;
PL_expect = XSTATE;
break;
+ case XBLOCKTERM:
+ PL_lex_brackstack[PL_lex_brackets++] = XTERM;
+ PL_lex_allbrackets++;
+ PL_expect = XSTATE;
+ break;
default: {
const char *t;
if (PL_oldoldbufptr == PL_last_lop)
if (!PL_lex_allbrackets &&
PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
- PREBLOCK(METHOD);
+ PL_expect = XBLOCKTERM;
+ PL_bufptr = s;
+ return REPORT(METHOD);
}
/* If followed by a bareword, see if it looks like indir obj. */
newUNOP(OP_RV2SV, 0,
newGVOP(OP_GV, 0, gv)));
}
- if (!readline_overriden)
- PL_lex_op->op_flags |= OPf_SPECIAL;
/* we created the ops in PL_lex_op, so make pl_yylval.ival a null op */
pl_yylval.ival = OP_NULL;
}
bool floatit; /* boolean: int or float? */
const char *lastub = NULL; /* position of last underbar */
static const char* const number_too_long = "Number too long";
+ /* Hexadecimal floating point.
+ *
+ * In many places (where we have quads and NV is IEEE 754 double)
+ * we can fit the mantissa bits of a NV into an unsigned quad.
+ * (Note that UVs might not be quads even when we have quads.)
+ * This will not work everywhere, though (either no quads, or
+ * using long doubles), in which case we have to resort to NV,
+ * which will probably mean horrible loss of precision due to
+ * multiple fp operations. */
+ bool hexfp = FALSE;
+ int total_bits = 0;
+#if NVSIZE == 8 && defined(HAS_QUAD) && defined(Uquad_t)
+# define HEXFP_UQUAD
+ Uquad_t hexfp_uquad = 0;
+ int hexfp_frac_bits = 0;
+#else
+# define HEXFP_NV
+ NV hexfp_nv = 0.0;
+#endif
+ NV hexfp_mult = 1.0;
+ UV high_non_zero = 0; /* highest digit */
PERL_ARGS_ASSERT_SCAN_NUM;
if (!overflowed) {
x = u << shift; /* make room for the digit */
+ total_bits += shift;
+
if ((x >> shift) != u
&& !(PL_hints & HINT_NEW_BINARY)) {
overflowed = TRUE;
* amount. */
n += (NV) b;
}
+
+ if (high_non_zero == 0 && b > 0)
+ high_non_zero = b;
+
+ /* this could be hexfp, but peek ahead
+ * to avoid matching ".." */
+#define HEXFP_PEEK(s) \
+ (((s[0] == '.') && \
+ (isXDIGIT(s[1]) || s[1] == 'p' || s[1] == 'P')) \
+ || s[0] == 'p' || s[0] == 'P')
+ if (UNLIKELY(HEXFP_PEEK(s))) {
+ goto out;
+ }
+
break;
}
}
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number");
}
+ if (UNLIKELY(HEXFP_PEEK(s))) {
+ /* Do sloppy (on the underbars) but quick detection
+ * (and value construction) for hexfp, the decimal
+ * detection will shortly be more thorough with the
+ * underbar checks. */
+ const char* h = s;
+#ifdef HEXFP_UQUAD
+ hexfp_uquad = u;
+#else /* HEXFP_NV */
+ hexfp_nv = u;
+#endif
+ if (*h == '.') {
+#ifdef HEXFP_NV
+ NV mult = 1 / 16.0;
+#endif
+ h++;
+ while (isXDIGIT(*h) || *h == '_') {
+ if (isXDIGIT(*h)) {
+ U8 b = XDIGIT_VALUE(*h);
+ total_bits += shift;
+#ifdef HEXFP_UQUAD
+ hexfp_uquad <<= shift;
+ hexfp_uquad |= b;
+ hexfp_frac_bits += shift;
+#else /* HEXFP_NV */
+ hexfp_nv += b * mult;
+ mult /= 16.0;
+#endif
+ }
+ h++;
+ }
+ }
+
+ if (total_bits >= 4) {
+ if (high_non_zero < 0x8)
+ total_bits--;
+ if (high_non_zero < 0x4)
+ total_bits--;
+ if (high_non_zero < 0x2)
+ total_bits--;
+ }
+
+ if (total_bits > 0 && (*h == 'p' || *h == 'P')) {
+ bool negexp = FALSE;
+ h++;
+ if (*h == '+')
+ h++;
+ else if (*h == '-') {
+ negexp = TRUE;
+ h++;
+ }
+ if (isDIGIT(*h)) {
+ I32 hexfp_exp = 0;
+ while (isDIGIT(*h) || *h == '_') {
+ if (isDIGIT(*h)) {
+ hexfp_exp *= 10;
+ hexfp_exp += *h - '0';
+#ifdef NV_MIN_EXP
+ if (negexp &&
+ -hexfp_exp < NV_MIN_EXP - 1) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "Hexadecimal float: exponent underflow");
+#endif
+ break;
+ }
+ else {
+#ifdef NV_MAX_EXP
+ if (!negexp &&
+ hexfp_exp > NV_MAX_EXP - 1) {
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "Hexadecimal float: exponent overflow");
+ break;
+ }
+#endif
+ }
+ }
+ h++;
+ }
+ if (negexp)
+ hexfp_exp = -hexfp_exp;
+#ifdef HEXFP_UQUAD
+ hexfp_exp -= hexfp_frac_bits;
+#endif
+ hexfp_mult = pow(2.0, hexfp_exp);
+ hexfp = TRUE;
+ goto decimal;
+ }
+ }
+ }
+
if (overflowed) {
if (n > 4294967295.0)
Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE),
decimal:
d = PL_tokenbuf;
e = PL_tokenbuf + sizeof PL_tokenbuf - 6; /* room for various punctuation */
- floatit = FALSE;
+ floatit = FALSE;
+ if (hexfp) {
+ floatit = TRUE;
+ *d++ = '0';
+ *d++ = 'x';
+ s = start + 2;
+ }
/* read next group of digits and _ and copy into d */
- while (isDIGIT(*s) || *s == '_') {
+ while (isDIGIT(*s) || *s == '_' ||
+ UNLIKELY(hexfp && isXDIGIT(*s))) {
/* skip underscores, checking for misplaced ones
if -w is on
*/
/* copy, ignoring underbars, until we run out of digits.
*/
- for (; isDIGIT(*s) || *s == '_'; s++) {
+ for (; isDIGIT(*s) || *s == '_' ||
+ UNLIKELY(hexfp && isXDIGIT(*s));
+ s++) {
/* fixed length buffer check */
if (d >= e)
Perl_croak(aTHX_ "%s", number_too_long);
}
/* read exponent part, if present */
- if ((*s == 'e' || *s == 'E') && strchr("+-0123456789_", s[1])) {
- floatit = TRUE;
+ if (((*s == 'e' || *s == 'E') ||
+ UNLIKELY(hexfp && (*s == 'p' || *s == 'P'))) &&
+ strchr("+-0123456789_", s[1])) {
+ floatit = TRUE;
+
+ /* regardless of whether user said 3E5 or 3e5, use lower 'e',
+ ditto for p (hexfloats) */
+ if ((*s == 'e' || *s == 'E')) {
+ /* At least some Mach atof()s don't grok 'E' */
+ *d++ = 'e';
+ }
+ else if (UNLIKELY(hexfp && (*s == 'p' || *s == 'P'))) {
+ *d++ = 'p';
+ }
+
s++;
- /* regardless of whether user said 3E5 or 3e5, use lower 'e' */
- *d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
/* stray preinitial _ */
if (*s == '_') {
STORE_NUMERIC_LOCAL_SET_STANDARD();
/* terminate the string */
*d = '\0';
- nv = Atof(PL_tokenbuf);
+ if (UNLIKELY(hexfp)) {
+# ifdef NV_MANT_DIG
+ if (total_bits > NV_MANT_DIG)
+ Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
+ "Hexadecimal float: mantissa overflow");
+# endif
+#ifdef HEXFP_UQUAD
+ nv = hexfp_uquad * hexfp_mult;
+#else /* HEXFP_NV */
+ nv = hexfp_nv * hexfp_mult;
+#endif
+ } else {
+ nv = Atof(PL_tokenbuf);
+ }
RESTORE_NUMERIC_LOCAL();
- sv = newSVnv(nv);
+ sv = newSVnv(nv);
}
if ( floatit
* C preprocessor can make decisions based on it. It is only
* defined if the system supports long doubles.
*/
+/* LONG_DOUBLEKIND:
+ * LONG_DOUBLEKIND will be one of
+ * LONG_DOUBLE_IS_DOUBLE
+ * LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
+ * LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN
+ * LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
+ * LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
+ * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN
+ * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN
+ * LONG_DOUBLE_IS_UNKNOWN_FORMAT
+ * It is only defined if the system supports long doubles.
+ */
/*#define HAS_LONG_DOUBLE / **/
#ifdef HAS_LONG_DOUBLE
#define LONG_DOUBLESIZE 8 /**/
+#define LONG_DOUBLEKIND 0 /**/
+#define LONG_DOUBLE_IS_DOUBLE 0
+#define LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN 1
+#define LONG_DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN 2
+#define LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN 3
+#define LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN 4
+#define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN 5
+#define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN 6
+#define LONG_DOUBLE_IS_UNKNOWN_FORMAT -1
#endif
/* HAS_LONG_LONG:
*/
/*#define HAS_FREXPL / **/
+/* HAS_LDEXPL:
+ * This symbol, if defined, indicates that the ldexpl routine is
+ * available to shift a long double floating-point number
+ * by an integral power of 2.
+ */
+/*#define HAS_LDEXPL / **/
+
/* HAS_STRUCT_FS_DATA:
* This symbol, if defined, indicates that the struct fs_data
* to do statfs() is supported.
#endif
/* Generated from:
- * 727eb338c23fdd320f556ca32fd7eb5473f68b6ce74db8cec7d83399a2621346 config_h.SH
- * 4b709c0b049c660c04c0932eaa8481f9ca6fdc697ec4ffaa86b7bef21ee886a8 uconfig.sh
+ * 5f68e17a9d9e989b824daf55d2adcad3b7af2becfa8f627c6cb1d0e376f7e1a5 config_h.SH
+ * 98397a7d818a024628d6b34e5903a8f408da96601a2a19471c480511f3c8d914 uconfig.sh
* ex: set ro: */
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='undef'
+d_ldexpl='undef'
d_libm_lib_version='undef'
d_link='undef'
d_localtime64='undef'
ld_can_script='define'
lib_ext='.a'
localtime_r_proto='0'
+longdblkind=0
longdblsize=8
longlongsize=8
longsize='4'
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='undef'
+d_ldexpl='undef'
d_libm_lib_version='undef'
d_link='undef'
d_localtime64='undef'
ivtype='long'
lib_ext='.a'
localtime_r_proto='0'
+longdblkind=0
longdblsize=8
longlongsize=8
longsize='8'
*lenp = 1;
}
else {
- *p = UTF8_TWO_BYTE_HI(converted);
- *(p+1) = UTF8_TWO_BYTE_LO(converted);
+ /* Result is known to always be < 256, so can use the EIGHT_BIT
+ * macros */
+ *p = UTF8_EIGHT_BIT_HI(converted);
+ *(p+1) = UTF8_EIGHT_BIT_LO(converted);
*lenp = 2;
}
}
lend = l + lcur;
if (*l == 'V') { /* Inversion list format */
- char *after_strtol = (char *) lend;
+ const char *after_atou = (char *) lend;
UV element0;
UV* other_elements_ptr;
/* The first number is a count of the rest */
l++;
- elements = Strtoul((char *)l, &after_strtol, 10);
+ elements = grok_atou((const char *)l, &after_atou);
if (elements == 0) {
invlist = _new_invlist(0);
}
else {
- l = (U8 *) after_strtol;
+ while (isSPACE(*l)) l++;
+ l = (U8 *) after_atou;
/* Get the 0th element, which is needed to setup the inversion list */
- element0 = (UV) Strtoul((char *)l, &after_strtol, 10);
- l = (U8 *) after_strtol;
+ while (isSPACE(*l)) l++;
+ element0 = (UV) grok_atou((const char *)l, &after_atou);
+ l = (U8 *) after_atou;
invlist = _setup_canned_invlist(elements, element0, &other_elements_ptr);
elements--;
if (l > lend) {
Perl_croak(aTHX_ "panic: Expecting %"UVuf" more elements than available", elements);
}
- *other_elements_ptr++ = (UV) Strtoul((char *)l, &after_strtol, 10);
- l = (U8 *) after_strtol;
+ while (isSPACE(*l)) l++;
+ *other_elements_ptr++ = (UV) grok_atou((const char *)l, &after_atou);
+ l = (U8 *) after_atou;
}
}
}
int wi;
/* The PERL_C_BACKTRACE_ON_WARN must be an integer of one or more. */
if ((ws = PerlEnv_getenv("PERL_C_BACKTRACE_ON_ERROR")) &&
- (wi = atoi(ws)) > 0) {
+ (wi = grok_atou(ws, NULL)) > 0) {
Perl_dump_c_backtrace(aTHX_ Perl_debug_log, wi, 1);
}
}
my_setenv_format(environ[i], nam, nlen, val, vlen);
} else {
# endif
-# if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__)
+ /* This next branch should only be called #if defined(HAS_SETENV), but
+ Configure doesn't test for that yet. For Solaris, setenv() and unsetenv()
+ were introduced in Solaris 9, so testing for HAS UNSETENV is sufficient.
+ */
+# if defined(__CYGWIN__)|| defined(__SYMBIAN32__) || defined(__riscos__) || (defined(__sun) && defined(HAS_UNSETENV))
# if defined(HAS_UNSETENV)
if (val == NULL) {
(void)unsetenv(nam);
if (*p) {
if (isDIGIT(*p)) {
- opt = (U32) atoi(p);
- while (isDIGIT(*p))
- p++;
+ const char* endptr;
+ opt = (U32) grok_atou(p, &endptr);
+ p = endptr;
if (*p && *p != '\n' && *p != '\r') {
if(isSPACE(*p)) goto the_end_of_the_opts_parser;
else
* The default implementation reads a single env var, PERL_MEM_LOG,
* expecting one or more of the following:
*
- * \d+ - fd fd to write to : must be 1st (atoi)
+ * \d+ - fd fd to write to : must be 1st (grok_atou)
* 'm' - memlog was PERL_MEM_LOG=1
* 's' - svlog was PERL_SV_LOG=1
* 't' - timestamp was PERL_MEM_LOG_TIMESTAMP=1
* timeval. */
{
STRLEN len;
- int fd = atoi(pmlenv);
+ const char* endptr;
+ int fd = grok_atou(pmlenv, &endptr); /* Ignore endptr. */
if (!fd)
fd = PERL_MEM_LOG_FD;
/* Given an output buffer end |p| and its |start|, matches
* for the atos output, extracting the source code location
- * if possible, returning NULL otherwise. */
+ * and returning non-NULL if possible, returning NULL otherwise. */
static const char* atos_parse(const char* p,
const char* start,
STRLEN* source_name_size,
STRLEN* source_line) {
- /* atos() outputs is something like:
+ /* atos() output is something like:
* perl_parse (in miniperl) (perl.c:2314)\n\n".
* We cannot use Perl regular expressions, because we need to
* stay low-level. Therefore here we have a rolled-out version
* The matched regular expression is roughly "\(.*:\d+\)\s*$" */
const char* source_number_start;
const char* source_name_end;
+ const char* source_line_end;
+ const char* close_paren;
/* Skip trailing whitespace. */
while (p > start && isspace(*p)) p--;
/* Now we should be at the close paren. */
if (p == start || *p != ')')
return NULL;
+ close_paren = p;
p--;
/* Now we should be in the line number. */
if (p == start || !isdigit(*p))
return NULL;
p++;
*source_name_size = source_name_end - p;
- *source_line = atoi(source_number_start);
+ *source_line = grok_atou(source_number_start, &source_line_end);
+ if (source_line_end != close_paren)
+ return NULL;
return p;
}
extra.pods : miniperl
@ @extra_pods.com
-PERLDELTA_CURRENT = [.pod]perl5212delta.pod
+PERLDELTA_CURRENT = [.pod]perl5213delta.pod
$(PERLDELTA_CURRENT) : [.pod]perldelta.pod
Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT)
}
}
if (retsts & 1) { eqv[eqvlen] = '\0'; return eqvlen; }
- else if (retsts == LIB$_NOSUCHSYM || retsts == LIB$_INVSYMNAM ||
- retsts == SS$_IVLOGNAM || retsts == SS$_IVLOGTAB ||
+ else if (retsts == LIB$_NOSUCHSYM ||
retsts == SS$_NOLOGNAM) {
+ /* Unsuccessful lookup is normal -- no need to set errno */
+ return 0;
+ }
+ else if (retsts == LIB$_INVSYMNAM ||
+ retsts == SS$_IVLOGNAM ||
+ retsts == SS$_IVLOGTAB) {
set_errno(EINVAL); set_vaxc_errno(retsts);
}
else _ckvmssts_noperl(retsts);
static char *__my_getenv_eqv = NULL;
char uplnm[LNM$C_NAMLENGTH+1], *cp2, *eqv;
unsigned long int idx = 0;
- int success, secure, saverr, savvmserr;
+ int success, secure;
int midx, flags;
SV *tmpsv;
if (sys) {
/* Impose security constraints only if tainting */
secure = PL_curinterp ? TAINTING_get : will_taint;
- saverr = errno; savvmserr = vaxc$errno;
}
else {
secure = 0;
success = vmstrnenv(lnm,eqv,idx,secure ? fildev : NULL,flags);
- /* Discard NOLOGNAM on internal calls since we're often looking
- * for an optional name, and this "error" often shows up as the
- * (bogus) exit status for a die() call later on. */
- if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
return success ? eqv : NULL;
}
unsigned long idx = 0;
int midx, flags;
static char *__my_getenv_len_eqv = NULL;
- int secure, saverr, savvmserr;
+ int secure;
SV *tmpsv;
midx = my_maxidx(lnm) + 1;
if (sys) {
/* Impose security constraints only if tainting */
secure = PL_curinterp ? TAINTING_get : will_taint;
- saverr = errno; savvmserr = vaxc$errno;
}
else {
secure = 0;
}
}
- /* Discard NOLOGNAM on internal calls since we're often looking
- * for an optional name, and this "error" often shows up as the
- * (bogus) exit status for a die() call later on. */
- if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
return *len ? buf : NULL;
}
*/
if (value > 0) {
status = simple_trnlnm(name, val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if (val_str[0] == 'D' || val_str[0] == '0' || val_str[0] == 'F')
return 0;
/* Allow an exception to bring Perl into the VMS debugger */
vms_debug_on_exception = 0;
status = simple_trnlnm("PERL_VMS_EXCEPTION_DEBUG", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
vms_debug_on_exception = 1;
/* Debug unix/vms file translation routines */
vms_debug_fileify = 0;
status = simple_trnlnm("PERL_VMS_FILEIFY_DEBUG", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
vms_debug_fileify = 1;
/* enable it so that the impact can be studied. */
vms_bug_stat_filename = 0;
status = simple_trnlnm("PERL_VMS_BUG_STAT_FILENAME", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
vms_bug_stat_filename = 1;
/* Create VTF-7 filenames from Unicode instead of UTF-8 */
vms_vtf7_filenames = 0;
status = simple_trnlnm("PERL_VMS_VTF7_FILENAMES", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
vms_vtf7_filenames = 1;
/* unlink all versions on unlink() or rename() */
vms_unlink_all_versions = 0;
- status = simple_trnlnm
- ("PERL_VMS_UNLINK_ALL_VERSIONS", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ status = simple_trnlnm("PERL_VMS_UNLINK_ALL_VERSIONS", val_str, sizeof(val_str));
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
vms_unlink_all_versions = 1;
/* Detect running under GNV Bash or other UNIX like shell */
gnv_unix_shell = 0;
status = simple_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
gnv_unix_shell = 1;
set_feature_default("DECC$FILENAME_UNIX_NO_VERSION", 1);
set_feature_default("DECC$FILENAME_UNIX_REPORT", 1);
set_feature_default("DECC$DISABLE_POSIX_ROOT", 0);
vms_unlink_all_versions = 1;
vms_posix_exit = 1;
+ /* Reverse default ordering of PERL_ENV_TABLES. */
+ defenv[0] = &crtlenvdsc;
+ defenv[1] = &fildevdsc;
}
/* Some reasonable defaults that are not CRTL defaults */
set_feature_default("DECC$EFS_CASE_PRESERVE", 1);
/* PCP mode requires creating /dev/null special device file */
decc_bug_devnull = 0;
status = simple_trnlnm("DECC_BUG_DEVNULL", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
decc_bug_devnull = 1;
#else
status = simple_trnlnm
("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_disable_to_vms_logname_translation = 1;
#ifndef __VAX
status = simple_trnlnm("DECC$EFS_CASE_PRESERVE", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_efs_case_preserve = 1;
#endif
status = simple_trnlnm("DECC$FILENAME_UNIX_REPORT", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_filename_unix_report = 1;
}
}
status = simple_trnlnm("DECC$FILENAME_UNIX_ONLY", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_filename_unix_only = 1;
}
}
status = simple_trnlnm("DECC$FILENAME_UNIX_NO_VERSION", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_filename_unix_no_version = 1;
}
}
status = simple_trnlnm("DECC$READDIR_DROPDOTNOTYPE", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) {
decc_readdir_dropdotnotype = 1;
/* USE POSIX/DCL Exit codes - Recommended, but needs to default to */
/* for strict backward compatibility */
- status = simple_trnlnm
- ("PERL_VMS_POSIX_EXIT", val_str, sizeof(val_str));
- if ($VMS_STATUS_SUCCESS(status)) {
+ status = simple_trnlnm("PERL_VMS_POSIX_EXIT", val_str, sizeof(val_str));
+ if (status) {
val_str[0] = _toupper(val_str[0]);
if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T'))
vms_posix_exit = 1;
char tbuf[64];
SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
char *buf;
+#ifdef USE_LOCALE_NUMERIC
+ const char * const cur_numeric = setlocale(LC_NUMERIC, NULL);
+ assert(cur_numeric);
+
+ /* XS code can set the locale without us knowing. To protect the
+ * version number parsing, which requires the radix character to be a
+ * dot, update our records as to what the locale is, so that our
+ * existing macro mechanism can correctly change it to a dot and back
+ * if necessary. This code is extremely unlikely to be in a loop, so
+ * the extra work will have a negligible performance impact. See [perl
+ * #121930].
+ *
+ * If the current locale is a standard one, but we are expecting it to
+ * be a different, underlying locale, update our records to make the
+ * underlying locale this (standard) one. If the current locale is not
+ * a standard one, we should be expecting a non-standard one, the same
+ * one that we have recorded as the underlying locale. If not, update
+ * our records. */
+ if (strEQ(cur_numeric, "C") || strEQ(cur_numeric, "POSIX")) {
+ if (! PL_numeric_standard) {
+ new_numeric(cur_numeric);
+ }
+ }
+ else if (PL_numeric_standard
+ || ! PL_numeric_name
+ || strNE(PL_numeric_name, cur_numeric))
+ {
+ new_numeric(cur_numeric);
+ }
+#endif
+ { /* Braces needed because macro just below declares a variable */
STORE_NUMERIC_LOCAL_SET_STANDARD();
LOCK_NUMERIC_STANDARD();
if (sv) {
}
UNLOCK_NUMERIC_STANDARD();
RESTORE_NUMERIC_LOCAL();
+ }
while (buf[len-1] == '0' && len > 0) len--;
if ( buf[len-1] == '.' ) len--; /* eat the trailing decimal */
version = savepvn(buf, len);
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER = \5.21.2
+#INST_VER = \5.21.3
#
# 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\perl5212delta.pod
+ copy ..\pod\perldelta.pod ..\pod\perl5213delta.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 \
- perl5212delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+ perl5213delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
perlapi.pod perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
d_killpg='undef'
d_lchown='undef'
d_ldbl_dig='define'
+d_ldexpl='undef'
d_libm_lib_version='undef'
d_link='define'
d_localtime64='undef'
localtime_r_proto='0'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblkind='3'
longdblsize='10'
longlongsize='8'
longsize='4'
d_killpg='define'
d_lchown='undef'
d_ldbl_dig='define'
+d_ldexpl='undef'
d_libm_lib_version='undef'
d_link='define'
d_localtime64='undef'
localtime_r_proto='0'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblkind='3'
longdblsize='12'
longlongsize='8'
longsize='4'
d_killpg='define'
d_lchown='undef'
d_ldbl_dig='define'
+d_ldexpl='undef'
d_libm_lib_version='undef'
d_link='define'
d_localtime64='undef'
localtime_r_proto='0'
locincpth='/usr/local/include /opt/local/include /usr/gnu/include /opt/gnu/include /usr/GNU/include /opt/GNU/include'
loclibpth='/usr/local/lib /opt/local/lib /usr/gnu/lib /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib'
+longdblkind='0'
longdblsize='8'
longlongsize='8'
longsize='4'
}
elsif ($opt{cc} =~ /\bgcc\b/) {
$int64 = 'long long';
- $int64f = 'll';
+ $int64f = 'I64';
}
# set large files options
# versioned installation can be obtained by setting INST_TOP above to a
# path that includes an arbitrary version string.
#
-#INST_VER *= \5.21.2
+#INST_VER *= \5.21.3
#
# 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\perl5212delta.pod
+ copy ..\pod\perldelta.pod ..\pod\perl5213delta.pod
$(PERLEXE) $(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 \
- perl5212delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+ perl5213delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
perlapi.pod perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
perl5210delta.pod \
perl5211delta.pod \
perl5212delta.pod \
+ perl5213delta.pod \
perl561delta.pod \
perl56delta.pod \
perl581delta.pod \
perl5210delta.man \
perl5211delta.man \
perl5212delta.man \
+ perl5213delta.man \
perl561delta.man \
perl56delta.man \
perl581delta.man \
perl5210delta.html \
perl5211delta.html \
perl5212delta.html \
+ perl5213delta.html \
perl561delta.html \
perl56delta.html \
perl581delta.html \
perl5210delta.tex \
perl5211delta.tex \
perl5212delta.tex \
+ perl5213delta.tex \
perl561delta.tex \
perl56delta.tex \
perl581delta.tex \
my @toolchain = qw(cpan/AutoLoader/lib
dist/Carp/lib
dist/PathTools dist/PathTools/lib
- dist/ExtUtils-Command/lib
- dist/ExtUtils-Install/lib
+ cpan/ExtUtils-Command/lib
+ cpan/ExtUtils-Install/lib
cpan/ExtUtils-MakeMaker/lib
- dist/ExtUtils-Manifest/lib
+ cpan/ExtUtils-Manifest/lib
cpan/File-Path/lib
ext/re
dist/Term-ReadLine/lib
projects / platform / upstream / perl.git / commitdiff