From ef52929137a06c83465ff3aeb9b85edffc5b0f70 Mon Sep 17 00:00:00 2001 From: DongHun Kwak Date: Wed, 28 Jun 2017 10:34:38 +0900 Subject: [PATCH] Imported Upstream version 5.21.3 Change-Id: I8163ac965a23257bc7b82488cbb9f5f6590089ec Signed-off-by: DongHun Kwak --- AUTHORS | 3 + Configure | 100 +++- Cross/config.sh-arm-linux | 42 +- Cross/config.sh-arm-linux-n770 | 40 +- INSTALL | 28 +- MANIFEST | 63 +- META.json | 7 +- META.yml | 7 +- Makefile.SH | 15 +- NetWare/Makefile | 4 +- NetWare/config.wc | 2 + NetWare/config_H.wc | 10 +- Porting/Glossary | 11 + Porting/Maintainers.pl | 32 +- Porting/config.sh | 44 +- Porting/config_H | 18 +- Porting/deparse-skips.txt | 8 +- Porting/epigraphs.pod | 43 ++ Porting/perldelta_template.pod | 2 +- Porting/release_managers_guide.pod | 2 +- Porting/sync-with-cpan | 14 +- Porting/todo.pod | 4 +- README.cygwin | 2 +- README.haiku | 4 +- README.macosx | 8 +- README.os2 | 2 +- README.vms | 4 +- av.c | 2 +- caretx.c | 8 +- cflags.SH | 11 + config_h.SH | 28 + configure.com | 23 +- cpan/B-Debug/Debug.pm | 4 +- .../lib/CPAN/Meta/Requirements.pm | 284 ++++++++- cpan/CPAN-Meta/lib/CPAN/Meta.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm | 24 +- cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/History.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm | 248 ++++++++ cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm | 4 +- cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm | 4 +- cpan/CPAN-Meta/t/merge.t | 118 ++++ cpan/Config-Perl-V/V.pm | 92 +-- cpan/Config-Perl-V/t/00_pod.t | 7 - cpan/Config-Perl-V/t/01_pod.t | 7 - cpan/Config-Perl-V/t/10_base.t | 4 +- cpan/Config-Perl-V/t/20_plv56.t | 79 +++ cpan/Config-Perl-V/t/21_plv58.t | 86 +++ cpan/Config-Perl-V/t/{20_plv510.t => 22_plv510.t} | 7 +- cpan/Config-Perl-V/t/23_plv512.t | 86 +++ cpan/Config-Perl-V/t/24_plv514.t | 88 +++ cpan/Config-Perl-V/t/25_plv516.t | 89 +++ cpan/Config-Perl-V/t/25_plv5162.t | 181 ++++++ cpan/Config-Perl-V/t/{21_plv518.t => 26_plv518.t} | 25 +- cpan/Config-Perl-V/t/26_plv5182.t | 115 ++++ cpan/Config-Perl-V/t/27_plv5200.t | 120 ++++ .../ExtUtils-Command/lib/ExtUtils/Command.pm | 0 {dist => cpan}/ExtUtils-Command/t/cp.t | 0 {dist => cpan}/ExtUtils-Command/t/eu_command.t | 0 .../ExtUtils-Command}/t/lib/TieOut.pm | 0 {dist => cpan}/ExtUtils-Install/Changes | 0 .../ExtUtils-Install/lib/ExtUtils/Install.pm | 0 .../ExtUtils-Install/lib/ExtUtils/Installed.pm | 0 .../ExtUtils-Install/lib/ExtUtils/Packlist.pm | 0 {dist => cpan}/ExtUtils-Install/t/Install.t | 0 {dist => cpan}/ExtUtils-Install/t/InstallWithMM.t | 0 {dist => cpan}/ExtUtils-Install/t/Installapi2.t | 0 {dist => cpan}/ExtUtils-Install/t/Installed.t | 0 {dist => cpan}/ExtUtils-Install/t/Packlist.t | 0 {dist => cpan}/ExtUtils-Install/t/can_write_dir.t | 0 .../t/lib/MakeMaker/Test/Setup/BFD.pm | 0 .../ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm | 0 .../ExtUtils-Install}/t/lib/TieOut.pm | 0 .../ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP | 0 .../ExtUtils-Manifest/lib/ExtUtils/Manifest.pm | 9 +- {dist => cpan}/ExtUtils-Manifest/t/Manifest.t | 11 +- cpan/HTTP-Tiny/lib/HTTP/Tiny.pm | 658 +++++++++++---------- cpan/HTTP-Tiny/t/002_croakage.t | 12 + cpan/HTTP-Tiny/t/020_headers.t | 9 + cpan/HTTP-Tiny/t/140_proxy.t | 14 + cpan/Socket/Socket.pm | 4 +- cpan/Socket/t/getaddrinfo.t | 22 +- cpan/Socket/t/getnameinfo.t | 26 +- cpan/Socket/t/socketpair.t | 5 + cpan/Time-HiRes/t/itimer.t | 6 +- cpan/perlfaq/lib/perlfaq.pm | 5 +- cpan/perlfaq/lib/perlfaq1.pod | 2 +- cpan/perlfaq/lib/perlfaq5.pod | 6 +- cpan/perlfaq/lib/perlfaq7.pod | 2 +- deb.c | 4 - dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm | 2 +- .../lib/ExtUtils/CBuilder/Base.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Unix.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/VMS.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/aix.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/android.pm | 4 +- .../lib/ExtUtils/CBuilder/Platform/cygwin.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/darwin.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/dec_osf.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/os2.pm | 2 +- dist/Module-CoreList/Changes | 3 + dist/Module-CoreList/lib/Module/CoreList.pm | 69 ++- dist/Module-CoreList/lib/Module/CoreList.pod | 2 +- .../lib/Module/CoreList/TieHashDelta.pm | 2 +- dist/Module-CoreList/lib/Module/CoreList/Utils.pm | 9 +- dist/Safe/Changes | 11 +- dist/Safe/MANIFEST | 7 +- dist/Safe/Safe.pm | 2 +- dist/Safe/t/safesecurity.t | 32 + dist/autouse/t/autouse.t | 12 +- doio.c | 2 +- embed.fnc | 4 + embed.h | 3 + ext/DynaLoader/dlutils.c | 2 +- ext/GDBM_File/t/fatal.t | 4 + ext/IPC-Open3/lib/IPC/Open3.pm | 15 +- ext/Opcode/Opcode.pm | 2 +- ext/Opcode/Opcode.xs | 6 +- ext/POSIX/POSIX.xs | 9 +- ext/POSIX/lib/POSIX.pm | 2 +- ext/POSIX/lib/POSIX.pod | 2 +- ext/POSIX/t/is.t | 19 +- ext/POSIX/t/iscrash | 20 + ext/Sys-Hostname/Hostname.pm | 2 +- ext/Sys-Hostname/Hostname.xs | 7 - ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/numeric.xs | 27 + ext/XS-APItest/t/grok.t | 144 +++++ gv.c | 2 +- hints/catamount.sh | 4 +- hints/dos_djgpp.sh | 6 +- hints/solaris_2.sh | 29 +- hv_func.h | 138 +++++ intrpvar.h | 4 +- lib/UNIVERSAL.pm | 29 +- lib/perl5db.pl | 4 +- lib/utf8_heavy.pl | 2 +- locale.c | 44 +- malloc.c | 4 +- mg.c | 12 +- myconfig.SH | 2 +- numeric.c | 96 ++- op.c | 41 +- op.h | 1 - pad.c | 4 - patchlevel.h | 4 +- perl.c | 24 +- perl.h | 27 +- plan9/config.plan9 | 10 +- plan9/config_sh.sample | 40 +- pod/.gitignore | 2 +- pod/perl.pod | 1 + pod/perl5212delta.pod | 377 ++++++++++++ pod/perlclib.pod | 15 +- pod/perldata.pod | 27 +- pod/perldelta.pod | 301 ++++++---- pod/perldiag.pod | 204 ++++--- pod/perlexperiment.pod | 4 + pod/perlfunc.pod | 17 +- pod/perlguts.pod | 11 +- pod/perlhacktips.pod | 23 + pod/perlhist.pod | 1 + pod/perlop.pod | 29 +- pod/perlre.pod | 9 +- pod/perlsec.pod | 3 + pod/perlvms.pod | 43 +- pp.c | 9 +- pp_ctl.c | 8 +- pp_sys.c | 8 +- proto.h | 13 + regcomp.c | 76 +-- regexec.c | 141 +++-- sv.c | 468 ++++++++++++++- sv.h | 11 +- symbian/config.sh | 2 + t/TEST | 6 +- t/comp/parser.t | 6 +- t/io/fs.t | 3 - t/lib/warnings/op | 2 - t/op/coresubs.t | 52 +- t/op/hexfp.t | 180 ++++++ t/op/require_override.t | 59 ++ t/op/sprintf.t | 4 +- t/op/sprintf2.t | 242 +++++++- t/op/stat.t | 7 +- t/op/sub.t | 9 +- t/op/taint.t | 4 +- t/op/universal.t | 26 +- t/porting/customized.dat | 2 +- t/porting/known_pod_issues.dat | 2 +- t/porting/libperl.t | 118 +++- t/re/pat_advanced.t | 6 + t/re/reg_mesg.t | 2 + t/re/reg_posixcc.t | 2 +- t/re/subst.t | 4 +- t/run/locale.t | 4 +- t/run/switchC.t | 2 +- t/uni/universal.t | 12 +- taint.c | 2 - toke.c | 196 +++++- uconfig.h | 32 +- uconfig.sh | 2 + uconfig64.sh | 2 + utf8.c | 23 +- util.c | 30 +- vms/descrip_mms.template | 2 +- vms/vms.c | 62 +- vutil.c | 32 + win32/Makefile | 6 +- win32/config.ce | 2 + win32/config.gc | 2 + win32/config.vc | 2 + win32/config_sh.PL | 2 +- win32/makefile.mk | 6 +- win32/pod.mak | 4 + write_buildcustomize.pl | 6 +- 221 files changed, 5661 insertions(+), 1361 deletions(-) create mode 100644 cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm create mode 100644 cpan/CPAN-Meta/t/merge.t delete mode 100644 cpan/Config-Perl-V/t/00_pod.t delete mode 100644 cpan/Config-Perl-V/t/01_pod.t create mode 100644 cpan/Config-Perl-V/t/20_plv56.t create mode 100644 cpan/Config-Perl-V/t/21_plv58.t rename cpan/Config-Perl-V/t/{20_plv510.t => 22_plv510.t} (92%) create mode 100644 cpan/Config-Perl-V/t/23_plv512.t create mode 100644 cpan/Config-Perl-V/t/24_plv514.t create mode 100644 cpan/Config-Perl-V/t/25_plv516.t create mode 100644 cpan/Config-Perl-V/t/25_plv5162.t rename cpan/Config-Perl-V/t/{21_plv518.t => 26_plv518.t} (84%) create mode 100644 cpan/Config-Perl-V/t/26_plv5182.t create mode 100644 cpan/Config-Perl-V/t/27_plv5200.t rename {dist => cpan}/ExtUtils-Command/lib/ExtUtils/Command.pm (100%) rename {dist => cpan}/ExtUtils-Command/t/cp.t (100%) rename {dist => cpan}/ExtUtils-Command/t/eu_command.t (100%) rename {dist/ExtUtils-Install => cpan/ExtUtils-Command}/t/lib/TieOut.pm (100%) rename {dist => cpan}/ExtUtils-Install/Changes (100%) rename {dist => cpan}/ExtUtils-Install/lib/ExtUtils/Install.pm (100%) rename {dist => cpan}/ExtUtils-Install/lib/ExtUtils/Installed.pm (100%) rename {dist => cpan}/ExtUtils-Install/lib/ExtUtils/Packlist.pm (100%) rename {dist => cpan}/ExtUtils-Install/t/Install.t (100%) rename {dist => cpan}/ExtUtils-Install/t/InstallWithMM.t (100%) rename {dist => cpan}/ExtUtils-Install/t/Installapi2.t (100%) rename {dist => cpan}/ExtUtils-Install/t/Installed.t (100%) rename {dist => cpan}/ExtUtils-Install/t/Packlist.t (100%) rename {dist => cpan}/ExtUtils-Install/t/can_write_dir.t (100%) rename {dist => cpan}/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm (100%) rename {dist => cpan}/ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm (100%) rename {dist/ExtUtils-Command => cpan/ExtUtils-Install}/t/lib/TieOut.pm (100%) rename {dist => cpan}/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP (100%) rename {dist => cpan}/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm (99%) rename {dist => cpan}/ExtUtils-Manifest/t/Manifest.t (98%) create mode 100644 dist/Safe/t/safesecurity.t create mode 100644 ext/POSIX/t/iscrash create mode 100644 pod/perl5212delta.pod create mode 100644 t/op/hexfp.t create mode 100644 t/op/require_override.t diff --git a/AUTHORS b/AUTHORS index 177e64d..934c50c 100644 --- a/AUTHORS +++ b/AUTHORS @@ -197,6 +197,7 @@ Cary D. Renzema Casey R. Tweten Casey West Castor Fu +Chad Granum Chaim Frenkel Charles Bailey Charles F. Randall @@ -1123,6 +1124,7 @@ Stian Seeberg Sullivan Beck Sven Strickroth Sven Verdoolaege +syber SynaptiCAD, Inc. Takis Psarogiannakopoulos Taro KAWAGISHI @@ -1197,6 +1199,7 @@ Vincent Pit Vishal Bhatia Vlad Harchev Vladimir Alexiev +Vladimir Marek Vladimir Timofeev Volker Schatz W. Geoffrey Rommel diff --git a/Configure b/Configure index a267266..aab3f03 100755 --- a/Configure +++ b/Configure @@ -585,6 +585,7 @@ d_isnanl='' d_killpg='' d_lchown='' d_ldbl_dig='' +d_ldexpl='' d_libm_lib_version='' d_link='' d_localtime_r='' @@ -593,6 +594,7 @@ localtime_r_proto='' d_locconv='' d_lockf='' d_longdbl='' +longdblkind='' longdblsize='' d_longlong='' longlongsize='' @@ -2521,7 +2523,7 @@ egrep) esac case "$less" in '') ;; -*) if $less -R /dev/null; then +*) if $less -R /dev/null 2>&1; then echo "Substituting less -R for less." less="$less -R" _less=$less @@ -15426,6 +15428,10 @@ $rm -f ldbl_dig.? 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 @@ -15792,6 +15798,9 @@ if $test "$uselongdouble" = "$define"; then message="$message frexpl" fi fi + if $test "$d_ldexpl" != "$define"; then + message="$message ldexpl" + fi if $test "$message" != ""; then $cat <&4 @@ -15958,6 +15967,91 @@ $echo "(IV will be "$ivtype", $ivsize bytes)" $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 <try.c +#$i_float I_FLOAT +#$i_stdlib I_STDLIB +#define LONGDBLSIZE $longdblsize +#ifdef I_FLOAT +#include +#endif +#ifdef I_STDLIB +#include +#endif +#include +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 <>Cppsym.know +./tr '-' '_' <>Cppsym.know $osname EOSH ./tr '[a-z]' '[A-Z]' < Cppsym.know > Cppsym.a @@ -23223,6 +23317,7 @@ d_isnanl='$d_isnanl' 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' @@ -23727,6 +23822,7 @@ lns='$lns' localtime_r_proto='$localtime_r_proto' locincpth='$locincpth' loclibpth='$loclibpth' +longdblkind='$longdblkind' longdblsize='$longdblsize' longlongsize='$longlongsize' longsize='$longsize' diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index a5f612e..abccb2c 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -32,12 +32,12 @@ alignbytes='4' 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='' @@ -56,7 +56,7 @@ castflags='0' 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' @@ -300,6 +300,7 @@ d_isnanl='define' d_killpg='define' d_lchown='define' d_ldbl_dig='define' +d_ldexpl='define' d_libm_lib_version='define' d_link='define' d_localtime64='undef' @@ -735,7 +736,7 @@ inc_version_list=' ' 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='' @@ -743,13 +744,13 @@ installman1dir='./install_me_here/usr/share/man/man1' 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' @@ -795,6 +796,7 @@ lns='/bin/ln -s' 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' @@ -878,8 +880,8 @@ pmake='' 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' @@ -944,17 +946,17 @@ sig_num='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 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' @@ -993,7 +995,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='2' +subversion='3' sysman='/usr/share/man/man1' tail='' tar='' @@ -1084,8 +1086,8 @@ vendorprefix='' 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' @@ -1099,9 +1101,9 @@ config_args='' 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 diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index fd05947..19d9121 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -32,12 +32,12 @@ alignbytes='4' 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='' @@ -55,7 +55,7 @@ castflags='0' 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' @@ -699,7 +699,7 @@ inc_version_list=' ' 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='' @@ -707,13 +707,13 @@ installman1dir='./install_me_here/usr/share/man/man1' 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' @@ -841,8 +841,8 @@ pmake='' 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' @@ -903,17 +903,17 @@ sig_num='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 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' @@ -950,7 +950,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='2' +subversion='3' sysman='/usr/share/man/man1' tail='' tar='' @@ -1035,8 +1035,8 @@ vendorprefix='' 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' @@ -1050,9 +1050,9 @@ config_args='' 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 diff --git a/INSTALL b/INSTALL index 5b27206..378ed6f 100644 --- a/INSTALL +++ b/INSTALL @@ -563,7 +563,7 @@ The directories set up by Configure fall into three broad categories. =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 @@ -2416,7 +2416,7 @@ http://www.chiark.greenend.org.uk/~sgtatham/bugs.html =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. @@ -2490,9 +2490,9 @@ won't interfere with another version. (The defaults guarantee this for 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. @@ -2507,11 +2507,11 @@ yet. =head2 Upgrading from 5.21.1 or earlier -B 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.) @@ -2544,15 +2544,15 @@ Firstly, the bare minimum to run this script 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. diff --git a/MANIFEST b/MANIFEST index d747c74..8479f03 100644 --- a/MANIFEST +++ b/MANIFEST @@ -186,11 +186,17 @@ cpan/Compress-Raw-Zlib/zlib-src/zlib.h Compress::Raw::Zlib 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 @@ -232,6 +238,7 @@ cpan/CPAN/lib/CPAN/Version.pm Simple math with different flavors of version str 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 @@ -296,6 +303,7 @@ cpan/CPAN-Meta/t/data-valid/META-1_0.yml 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 @@ -929,12 +937,29 @@ cpan/encoding-warnings/t/3-normal.t tests for encoding::warnings 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 @@ -1040,6 +1065,9 @@ cpan/ExtUtils-MakeMaker/t/VERSION_FROM.t See if MakeMaker's VERSION_FROM works 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 @@ -2882,26 +2910,6 @@ dist/ExtUtils-CBuilder/t/01-basic.t tests for ExtUtils::CBuilder 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 @@ -3209,7 +3217,8 @@ dist/Safe/t/safe3.t See if Safe works 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 @@ -3671,6 +3680,7 @@ ext/POSIX/lib/POSIX.pod POSIX extension documentation 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 @@ -4440,6 +4450,7 @@ pod/perl5182delta.pod Perl changes in version 5.18.2 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 @@ -5078,6 +5089,7 @@ t/op/hash-rt85026.t See if hash iteration/deletion works 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 @@ -5139,6 +5151,7 @@ t/op/ref.t See if refs and objects 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) diff --git a/META.json b/META.json index d824832..256c67d 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "perl5-porters@perl.org" ], "dynamic_config" : 1, - "generated_by" : "CPAN::Meta version 2.141520", + "generated_by" : "CPAN::Meta version 2.142060", "license" : [ "perl_5" ], @@ -27,9 +27,6 @@ "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", @@ -127,5 +124,5 @@ "url" : "http://perl5.git.perl.org/" } }, - "version" : "5.021002" + "version" : "5.021003" } diff --git a/META.yml b/META.yml index 5abdd8d..d0a211e 100644 --- a/META.yml +++ b/META.yml @@ -4,7 +4,7 @@ author: - 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 @@ -25,9 +25,6 @@ no_index: - 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 @@ -114,4 +111,4 @@ resources: homepage: http://www.perl.org/ license: http://dev.perl.org/licenses/ repository: http://perl5.git.perl.org/ -version: '5.021002' +version: '5.021003' diff --git a/Makefile.SH b/Makefile.SH index 703e5f9..cbeed00 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -489,7 +489,7 @@ mini_obj = $(minindt_obj) $(MINIDTRACE_O) 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 @@ -660,7 +660,7 @@ generate_uudmap$(OBJ_EXT): mg_raw.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 < { - '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'], }, @@ -224,9 +224,13 @@ use File::Glob qw(:case); }, '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' => { @@ -282,10 +286,11 @@ use File::Glob qw(:case); # 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}, @@ -293,11 +298,13 @@ use File::Glob qw(:case); }, '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}, ], }, @@ -430,7 +437,7 @@ use File::Glob qw(:case); 'ExtUtils::Command' => { 'DISTRIBUTION' => 'FLORA/ExtUtils-Command-1.18.tar.gz', - 'FILES' => q[dist/ExtUtils-Command], + 'FILES' => q[cpan/ExtUtils-Command], 'EXCLUDED' => [qr{^t/release-}], }, @@ -451,7 +458,7 @@ use File::Glob qw(:case); '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 @@ -478,8 +485,8 @@ use File::Glob qw(:case); }, '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/)], }, @@ -576,10 +583,11 @@ use File::Glob qw(:case); }, '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', @@ -780,7 +788,7 @@ use File::Glob qw(:case); }, 'Module::CoreList' => { - 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.021001.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.021002.tar.gz', 'FILES' => q[dist/Module-CoreList], }, @@ -856,7 +864,7 @@ use File::Glob qw(:case); }, '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 diff --git a/Porting/config.sh b/Porting/config.sh index e66cab1..6f76268 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -39,12 +39,12 @@ alignbytes='4' 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='' @@ -309,6 +309,7 @@ d_isnanl='define' 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' @@ -752,7 +753,7 @@ incpath='' 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='' @@ -760,13 +761,13 @@ installman1dir='/pro/local/man/man1' 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' @@ -813,6 +814,7 @@ lns='/usr/bin/ln -s' localtime_r_proto='0' locincpth='/pro/local/include' loclibpth='/pro/local/lib' +longdblkind='3' longdblsize='12' longlongsize='8' longsize='4' @@ -887,7 +889,7 @@ perl_patchlevel='' 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' @@ -896,8 +898,8 @@ pmake='' 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' @@ -963,17 +965,17 @@ sig_num='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 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' @@ -999,7 +1001,7 @@ src='.' 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' @@ -1012,7 +1014,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='2' +subversion='3' sysman='/usr/share/man/man1' sysroot='' tail='' @@ -1110,8 +1112,8 @@ vendorprefix='' 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' @@ -1121,10 +1123,10 @@ zcat='' 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. diff --git a/Porting/config_H b/Porting/config_H index 2018e50..dc21a7b 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -960,8 +960,8 @@ * 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. @@ -2068,8 +2068,8 @@ * 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 @@ -2119,8 +2119,8 @@ * 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. @@ -2142,8 +2142,8 @@ * 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: @@ -4326,7 +4326,7 @@ * 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 diff --git a/Porting/deparse-skips.txt b/Porting/deparse-skips.txt index a493caa..82071f2 100644 --- a/Porting/deparse-skips.txt +++ b/Porting/deparse-skips.txt @@ -56,9 +56,13 @@ __DEPARSE_FAILURES__ ../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 @@ -271,10 +275,6 @@ __DEPARSE_FAILURES__ ../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 diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index ffd4ab4..20f4230 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -17,6 +17,49 @@ Consult your favorite dictionary for details. =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 + + 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 diff --git a/Porting/perldelta_template.pod b/Porting/perldelta_template.pod index 9c777b9..9e4ce59 100644 --- a/Porting/perldelta_template.pod +++ b/Porting/perldelta_template.pod @@ -378,7 +378,7 @@ here. XXX Generate this with: - perl Porting/acknowledgements.pl v5.21.2..HEAD + perl Porting/acknowledgements.pl v5.21.3..HEAD =head1 Reporting Bugs diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index 873b475..099cc9d 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -955,7 +955,7 @@ Bootstrap the CPAN client on the clean install: 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: diff --git a/Porting/sync-with-cpan b/Porting/sync-with-cpan index fdbc6ad..d0cc1d6 100755 --- a/Porting/sync-with-cpan +++ b/Porting/sync-with-cpan @@ -157,12 +157,20 @@ my @problematic = ( ); +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; diff --git a/Porting/todo.pod b/Porting/todo.pod index 448ef59..b67f106 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -467,7 +467,7 @@ Natively 64-bit systems need neither -Duse64bitint nor -Duse64bitall. 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? @@ -1168,7 +1168,7 @@ L =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 diff --git a/README.cygwin b/README.cygwin index 02ab4fb..691da50 100644 --- a/README.cygwin +++ b/README.cygwin @@ -390,7 +390,7 @@ Cygwin processes have their own pid, which is different from the 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, which is not -the winpid. Use C and C +the winpid. Use C and C to translate between them. =item * Cygwin vs. Windows errors diff --git a/README.haiku b/README.haiku index bb51185..16aa478 100644 --- a/README.haiku +++ b/README.haiku @@ -22,9 +22,9 @@ The build procedure is completely standard: 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 diff --git a/README.macosx b/README.macosx index 51cede3..40ffd47 100644 --- a/README.macosx +++ b/README.macosx @@ -10,9 +10,9 @@ perlmacosx - Perl under Mac OS X 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 @@ -20,7 +20,7 @@ This document briefly describes Perl under Mac OS X. =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', diff --git a/README.os2 b/README.os2 index de27e85..46278a8 100644 --- a/README.os2 +++ b/README.os2 @@ -619,7 +619,7 @@ C in F, see L<"PERLLIB_PREFIX">. =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), you diff --git a/README.vms b/README.vms index b584eac..99a5649 100644 --- a/README.vms +++ b/README.vms @@ -142,11 +142,11 @@ You may need to set up a foreign symbol for the unpacking utility of 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. diff --git a/av.c b/av.c index 49fef00..0029191 100644 --- a/av.c +++ b/av.c @@ -776,7 +776,7 @@ Perl_av_len(pTHX_ AV *av) 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 after +The number of elements in the array will be C 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 is diff --git a/caretx.c b/caretx.c index bf5ba85..5d3318c 100644 --- a/caretx.c +++ b/caretx.c @@ -99,7 +99,13 @@ Perl_set_caret_X(pTHX) { } # 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 diff --git a/cflags.SH b/cflags.SH index 83fc3f8..6bfa188 100755 --- a/cflags.SH +++ b/cflags.SH @@ -306,6 +306,17 @@ case "$gccversion" in ;; 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: diff --git a/config_h.SH b/config_h.SH index c565a6c..168feee 100755 --- a/config_h.SH +++ b/config_h.SH @@ -1935,9 +1935,30 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * 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: @@ -3596,6 +3617,13 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un */ #$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. diff --git a/configure.com b/configure.com index abea303..1fb5fb3 100644 --- a/configure.com +++ b/configure.com @@ -3343,6 +3343,7 @@ $ uquadtype = "unsigned long long" $ quadkind = "3" $! $ d_frexpl = "define" +$ d_ldexpl = "define" $ d_modfl = "define" $ d_modflproto = "define" $ ELSE @@ -3364,6 +3365,7 @@ $ uquadtype = "undef" $ quadkind = "undef" $! $ d_frexpl = "undef" +$ d_ldexpl = "undef" $ d_modfl = "undef" $ d_modflproto = "undef" $ ENDIF @@ -3586,6 +3588,7 @@ $ GOSUB link_ok $ IF link_status .NE. good_link $ THEN $ longdblsize="0" +$ longdblkind="0" $ d_longdbl="undef" $ echo "You do not have long double." $ ELSE @@ -3593,6 +3596,7 @@ $ echo "You have long double." $ 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 @@ -5964,8 +5968,14 @@ $ WC "d_fd_set='" + d_fd_set + "'" $ 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'" @@ -6054,13 +6064,19 @@ $ WC "d_ipv6_mreq='define'" $ 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'" @@ -6507,6 +6523,7 @@ $ WC "libs='" + libs + "'" $ WC "libswanted='" + "'" $ WC "libswanted_uselargefiles='" + "'" $ WC "longdblsize='" + longdblsize + "'" +$ WC "longdblkind='" + longdblkind + "'" $ WC "longlongsize='" + longlongsize + "'" $ WC "longsize='" + longsize + "'" $ IF uselargefiles .OR. uselargefiles .EQS. "define" diff --git a/cpan/B-Debug/Debug.pm b/cpan/B-Debug/Debug.pm index c4a1a33..e9a83ae 100644 --- a/cpan/B-Debug/Debug.pm +++ b/cpan/B-Debug/Debug.pm @@ -1,6 +1,6 @@ package B::Debug; -our $VERSION = '1.19'; +our $VERSION = '1.21'; use strict; require 5.006; @@ -361,7 +361,7 @@ EOT 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 { diff --git a/cpan/CPAN-Meta-Requirements/lib/CPAN/Meta/Requirements.pm b/cpan/CPAN-Meta-Requirements/lib/CPAN/Meta/Requirements.pm index 621550c..c1193a0 100644 --- a/cpan/CPAN-Meta-Requirements/lib/CPAN/Meta/Requirements.pm +++ b/cpan/CPAN-Meta-Requirements/lib/CPAN/Meta/Requirements.pm @@ -1,14 +1,55 @@ 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 or F files in CPAN distributions, +#pod and as defined by L; +#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 -- 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 ); @@ -28,6 +69,7 @@ sub _version_object { 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; @@ -56,6 +98,57 @@ sub _version_object { 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 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)) { @@ -77,6 +170,17 @@ BEGIN { } } +#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) = @_; @@ -92,6 +196,22 @@ sub add_requirements { 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) = @_; @@ -102,6 +222,15 @@ sub accepts_module { 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) = @_; @@ -116,6 +245,17 @@ sub clear_requirement { 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 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 instead.) +#pod +#pod =cut sub requirements_for_module { my ($self, $module) = @_; @@ -124,9 +264,23 @@ sub requirements_for_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) = @_; @@ -155,6 +309,12 @@ sub __modify_entry_for { $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) = @_; @@ -166,12 +326,61 @@ sub is_simple { return 1; } +#pod =method is_finalized +#pod +#pod This method returns true if the requirements have been finalized by having the +#pod C 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 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 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) = @_; @@ -182,6 +391,38 @@ sub as_string_hash { 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. 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=>). Extra whitespace is allowed. +#pod +#pod =back +#pod +#pod =cut my %methods_for_op = ( '==' => [ qw(exact_version) ], @@ -215,6 +456,15 @@ sub add_string_requirement { } } +#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) = @_; @@ -436,7 +686,7 @@ __END__ =pod -=encoding utf-8 +=encoding UTF-8 =head1 NAME @@ -444,7 +694,7 @@ CPAN::Meta::Requirements - a set of version requirements for a CPAN dist =head1 VERSION -version 2.125 +version 2.126 =head1 SYNOPSIS @@ -463,7 +713,8 @@ version 2.125 =head1 DESCRIPTION A CPAN::Meta::Requirements object models a set of version constraints like -those specified in the F or F files in CPAN distributions. +those specified in the F or F files in CPAN distributions, +and as defined by L; It can be built up by adding more and more constraints, and it will reduce them to the simplest representation. @@ -477,16 +728,13 @@ exceptions. 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 * - -- 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 -- 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 @@ -554,7 +802,7 @@ This method returns the requirements object. =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, @@ -619,7 +867,7 @@ also finalized. =head2 as_string_hash This returns a reference to a hash describing the requirements using the -strings in the F specification. +strings in the L specification. For example after the following program: @@ -720,6 +968,20 @@ Ricardo Signes =back +=head1 CONTRIBUTORS + +=over 4 + +=item * + +Karen Etheridge + +=item * + +robario + +=back + =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2010 by David Golden and Ricardo Signes. diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta.pm b/cpan/CPAN-Meta/lib/CPAN/Meta.pm index 1b6723f..0c9048a 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 SYNOPSIS #pod @@ -641,7 +641,7 @@ CPAN::Meta - the distribution metadata for a CPAN dist =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm index 0b2d83c..83b6c59 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Converter; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 SYNOPSIS #pod @@ -741,12 +741,15 @@ sub _provides { } 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); @@ -1384,13 +1387,14 @@ sub convert { 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); @@ -1405,8 +1409,8 @@ sub convert { 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); @@ -1422,8 +1426,8 @@ sub convert { 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); @@ -1453,7 +1457,7 @@ sub upgrade_fragment { 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}; @@ -1475,7 +1479,7 @@ CPAN::Meta::Converter - Convert CPAN distribution metadata structures =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm index 52e3e93..db4f1ce 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Feature; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION use CPAN::Meta::Prereqs; @@ -78,7 +78,7 @@ CPAN::Meta::Feature - an optional feature provided by a CPAN distribution =head1 VERSION -version 2.141520 +version 2.142060 =head1 DESCRIPTION diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm index c28273a..9d6c660 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/History.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::History; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION 1; @@ -21,7 +21,7 @@ CPAN::Meta::History - history of CPAN Meta Spec changes =head1 VERSION -version 2.141520 +version 2.142060 =head1 DESCRIPTION diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm new file mode 100644 index 0000000..5648d77 --- /dev/null +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm @@ -0,0 +1,248 @@ +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, declaring the version of the meta-spec that must be +used for the merge. It can optionally take an C 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 + +=item * + +Ricardo Signes + +=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 diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm index 0535f74..60248b9 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Prereqs; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 DESCRIPTION #pod @@ -286,7 +286,7 @@ CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type =head1 VERSION -version 2.141520 +version 2.142060 =head1 DESCRIPTION diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm index ce5eafb..873580d 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm @@ -7,7 +7,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Spec; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION 1; @@ -28,7 +28,7 @@ CPAN::Meta::Spec - specification for CPAN distribution metadata =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm b/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm index 21cf295..7f08de7 100644 --- a/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm +++ b/cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm @@ -2,7 +2,7 @@ use 5.006; use strict; use warnings; package CPAN::Meta::Validator; -our $VERSION = '2.141520'; # VERSION +our $VERSION = '2.142060'; # VERSION #pod =head1 SYNOPSIS #pod @@ -997,7 +997,7 @@ CPAN::Meta::Validator - validate CPAN distribution metadata structures =head1 VERSION -version 2.141520 +version 2.142060 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta/t/merge.t b/cpan/CPAN-Meta/t/merge.t new file mode 100644 index 0000000..77ae09f --- /dev/null +++ b/cpan/CPAN-Meta/t/merge.t @@ -0,0 +1,118 @@ +#! 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(); diff --git a/cpan/Config-Perl-V/V.pm b/cpan/Config-Perl-V/V.pm index 066acac..4cbf6fe 100644 --- a/cpan/Config-Perl-V/V.pm +++ b/cpan/Config-Perl-V/V.pm @@ -8,7 +8,7 @@ use warnings; 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 = ( @@ -29,21 +29,21 @@ $VERSION = "0.20"; 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 @@ -78,12 +78,13 @@ my %BTD = map { $_ => 0 } qw( 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 @@ -102,6 +103,7 @@ my %BTD = map { $_ => 0 } qw( USE_LARGE_FILES USE_LOCALE_COLLATE USE_LOCALE_NUMERIC + USE_LOCALE_TIME USE_LONG_DOUBLE USE_PERLIO USE_REENTRANT_API @@ -229,39 +231,60 @@ sub _make_derived 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 => {}, @@ -322,20 +345,9 @@ sub myconfig } 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; diff --git a/cpan/Config-Perl-V/t/00_pod.t b/cpan/Config-Perl-V/t/00_pod.t deleted file mode 100644 index 67d0815..0000000 --- a/cpan/Config-Perl-V/t/00_pod.t +++ /dev/null @@ -1,7 +0,0 @@ -#!/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 (); diff --git a/cpan/Config-Perl-V/t/01_pod.t b/cpan/Config-Perl-V/t/01_pod.t deleted file mode 100644 index f2c148d..0000000 --- a/cpan/Config-Perl-V/t/01_pod.t +++ /dev/null @@ -1,7 +0,0 @@ -#!/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"); diff --git a/cpan/Config-Perl-V/t/10_base.t b/cpan/Config-Perl-V/t/10_base.t index b840ef5..a0a220c 100644 --- a/cpan/Config-Perl-V/t/10_base.t +++ b/cpan/Config-Perl-V/t/10_base.t @@ -18,9 +18,7 @@ BEGIN { } 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: { diff --git a/cpan/Config-Perl-V/t/20_plv56.t b/cpan/Config-Perl-V/t/20_plv56.t new file mode 100644 index 0000000..5b37572 --- /dev/null +++ b/cpan/Config-Perl-V/t/20_plv56.t @@ -0,0 +1,79 @@ +#!/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 (), "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 + . diff --git a/cpan/Config-Perl-V/t/21_plv58.t b/cpan/Config-Perl-V/t/21_plv58.t new file mode 100644 index 0000000..300cc31 --- /dev/null +++ b/cpan/Config-Perl-V/t/21_plv58.t @@ -0,0 +1,86 @@ +#!/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 (), "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 + . diff --git a/cpan/Config-Perl-V/t/20_plv510.t b/cpan/Config-Perl-V/t/22_plv510.t similarity index 92% rename from cpan/Config-Perl-V/t/20_plv510.t rename to cpan/Config-Perl-V/t/22_plv510.t index 4b1e267..a61d041 100644 --- a/cpan/Config-Perl-V/t/20_plv510.t +++ b/cpan/Config-Perl-V/t/22_plv510.t @@ -5,7 +5,7 @@ use warnings; BEGIN { use Test::More; - my $tests = 8; + my $tests = 91; unless ($ENV{PERL_CORE}) { require Test::NoWarnings; Test::NoWarnings->import (); @@ -24,6 +24,11 @@ is ($conf->{build}{osname}, $conf->{config}{osname}, "osname"); 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: diff --git a/cpan/Config-Perl-V/t/23_plv512.t b/cpan/Config-Perl-V/t/23_plv512.t new file mode 100644 index 0000000..9a219f1 --- /dev/null +++ b/cpan/Config-Perl-V/t/23_plv512.t @@ -0,0 +1,86 @@ +#!/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 (), "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 + . diff --git a/cpan/Config-Perl-V/t/24_plv514.t b/cpan/Config-Perl-V/t/24_plv514.t new file mode 100644 index 0000000..ddc7902 --- /dev/null +++ b/cpan/Config-Perl-V/t/24_plv514.t @@ -0,0 +1,88 @@ +#!/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 (), "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 + . diff --git a/cpan/Config-Perl-V/t/25_plv516.t b/cpan/Config-Perl-V/t/25_plv516.t new file mode 100644 index 0000000..2e48c98 --- /dev/null +++ b/cpan/Config-Perl-V/t/25_plv516.t @@ -0,0 +1,89 @@ +#!/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 (), "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 + . diff --git a/cpan/Config-Perl-V/t/25_plv5162.t b/cpan/Config-Perl-V/t/25_plv5162.t new file mode 100644 index 0000000..5b3694b --- /dev/null +++ b/cpan/Config-Perl-V/t/25_plv5162.t @@ -0,0 +1,181 @@ +#!/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 (), "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/ 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/ 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 + . + diff --git a/cpan/Config-Perl-V/t/21_plv518.t b/cpan/Config-Perl-V/t/26_plv518.t similarity index 84% rename from cpan/Config-Perl-V/t/21_plv518.t rename to cpan/Config-Perl-V/t/26_plv518.t index ed0a2a6..f9dbc9a 100644 --- a/cpan/Config-Perl-V/t/21_plv518.t +++ b/cpan/Config-Perl-V/t/26_plv518.t @@ -5,7 +5,7 @@ use warnings; BEGIN { use Test::More; - my $tests = 35; + my $tests = 111; unless ($ENV{PERL_CORE}) { require Test::NoWarnings; Test::NoWarnings->import (); @@ -21,13 +21,26 @@ ok (my $conf = Config::Perl::V::plv2hash (), "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}, 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, diff --git a/cpan/Config-Perl-V/t/26_plv5182.t b/cpan/Config-Perl-V/t/26_plv5182.t new file mode 100644 index 0000000..f093d99 --- /dev/null +++ b/cpan/Config-Perl-V/t/26_plv5182.t @@ -0,0 +1,115 @@ +#!/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 (), "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 + . diff --git a/cpan/Config-Perl-V/t/27_plv5200.t b/cpan/Config-Perl-V/t/27_plv5200.t new file mode 100644 index 0000000..2b3fa5d --- /dev/null +++ b/cpan/Config-Perl-V/t/27_plv5200.t @@ -0,0 +1,120 @@ +#!/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 (), "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 + . diff --git a/dist/ExtUtils-Command/lib/ExtUtils/Command.pm b/cpan/ExtUtils-Command/lib/ExtUtils/Command.pm similarity index 100% rename from dist/ExtUtils-Command/lib/ExtUtils/Command.pm rename to cpan/ExtUtils-Command/lib/ExtUtils/Command.pm diff --git a/dist/ExtUtils-Command/t/cp.t b/cpan/ExtUtils-Command/t/cp.t similarity index 100% rename from dist/ExtUtils-Command/t/cp.t rename to cpan/ExtUtils-Command/t/cp.t diff --git a/dist/ExtUtils-Command/t/eu_command.t b/cpan/ExtUtils-Command/t/eu_command.t similarity index 100% rename from dist/ExtUtils-Command/t/eu_command.t rename to cpan/ExtUtils-Command/t/eu_command.t diff --git a/dist/ExtUtils-Install/t/lib/TieOut.pm b/cpan/ExtUtils-Command/t/lib/TieOut.pm similarity index 100% rename from dist/ExtUtils-Install/t/lib/TieOut.pm rename to cpan/ExtUtils-Command/t/lib/TieOut.pm diff --git a/dist/ExtUtils-Install/Changes b/cpan/ExtUtils-Install/Changes similarity index 100% rename from dist/ExtUtils-Install/Changes rename to cpan/ExtUtils-Install/Changes diff --git a/dist/ExtUtils-Install/lib/ExtUtils/Install.pm b/cpan/ExtUtils-Install/lib/ExtUtils/Install.pm similarity index 100% rename from dist/ExtUtils-Install/lib/ExtUtils/Install.pm rename to cpan/ExtUtils-Install/lib/ExtUtils/Install.pm diff --git a/dist/ExtUtils-Install/lib/ExtUtils/Installed.pm b/cpan/ExtUtils-Install/lib/ExtUtils/Installed.pm similarity index 100% rename from dist/ExtUtils-Install/lib/ExtUtils/Installed.pm rename to cpan/ExtUtils-Install/lib/ExtUtils/Installed.pm diff --git a/dist/ExtUtils-Install/lib/ExtUtils/Packlist.pm b/cpan/ExtUtils-Install/lib/ExtUtils/Packlist.pm similarity index 100% rename from dist/ExtUtils-Install/lib/ExtUtils/Packlist.pm rename to cpan/ExtUtils-Install/lib/ExtUtils/Packlist.pm diff --git a/dist/ExtUtils-Install/t/Install.t b/cpan/ExtUtils-Install/t/Install.t similarity index 100% rename from dist/ExtUtils-Install/t/Install.t rename to cpan/ExtUtils-Install/t/Install.t diff --git a/dist/ExtUtils-Install/t/InstallWithMM.t b/cpan/ExtUtils-Install/t/InstallWithMM.t similarity index 100% rename from dist/ExtUtils-Install/t/InstallWithMM.t rename to cpan/ExtUtils-Install/t/InstallWithMM.t diff --git a/dist/ExtUtils-Install/t/Installapi2.t b/cpan/ExtUtils-Install/t/Installapi2.t similarity index 100% rename from dist/ExtUtils-Install/t/Installapi2.t rename to cpan/ExtUtils-Install/t/Installapi2.t diff --git a/dist/ExtUtils-Install/t/Installed.t b/cpan/ExtUtils-Install/t/Installed.t similarity index 100% rename from dist/ExtUtils-Install/t/Installed.t rename to cpan/ExtUtils-Install/t/Installed.t diff --git a/dist/ExtUtils-Install/t/Packlist.t b/cpan/ExtUtils-Install/t/Packlist.t similarity index 100% rename from dist/ExtUtils-Install/t/Packlist.t rename to cpan/ExtUtils-Install/t/Packlist.t diff --git a/dist/ExtUtils-Install/t/can_write_dir.t b/cpan/ExtUtils-Install/t/can_write_dir.t similarity index 100% rename from dist/ExtUtils-Install/t/can_write_dir.t rename to cpan/ExtUtils-Install/t/can_write_dir.t diff --git a/dist/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm b/cpan/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm similarity index 100% rename from dist/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm rename to cpan/ExtUtils-Install/t/lib/MakeMaker/Test/Setup/BFD.pm diff --git a/dist/ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm b/cpan/ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm similarity index 100% rename from dist/ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm rename to cpan/ExtUtils-Install/t/lib/MakeMaker/Test/Utils.pm diff --git a/dist/ExtUtils-Command/t/lib/TieOut.pm b/cpan/ExtUtils-Install/t/lib/TieOut.pm similarity index 100% rename from dist/ExtUtils-Command/t/lib/TieOut.pm rename to cpan/ExtUtils-Install/t/lib/TieOut.pm diff --git a/dist/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP b/cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP similarity index 100% rename from dist/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP rename to cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP diff --git a/dist/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm b/cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm similarity index 99% rename from dist/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm rename to cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm index 165a15c..1761589 100644 --- a/dist/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm +++ b/cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm @@ -10,9 +10,8 @@ use Carp; 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 @@ -122,6 +121,7 @@ sub mkmanifest { $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); @@ -481,6 +481,7 @@ sub _check_mskip_directives { warn "Problem opening $mfile: $!"; return; } + binmode M, ':raw'; print M $_ for (@lines); close M; return; @@ -694,6 +695,7 @@ sub maniadd { open(MANIFEST, ">>$MANIFEST") or die "maniadd() could not open $MANIFEST: $!"; + binmode MANIFEST, ':raw'; foreach my $file (_sort @needed) { my $comment = $additions->{$file} || ''; @@ -735,6 +737,7 @@ sub _fix_manifest { 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"; } diff --git a/dist/ExtUtils-Manifest/t/Manifest.t b/cpan/ExtUtils-Manifest/t/Manifest.t similarity index 98% rename from dist/ExtUtils-Manifest/t/Manifest.t rename to cpan/ExtUtils-Manifest/t/Manifest.t index a6a89a2..48e31b9 100644 --- a/dist/ExtUtils-Manifest/t/Manifest.t +++ b/cpan/ExtUtils-Manifest/t/Manifest.t @@ -13,7 +13,7 @@ chdir 't'; use strict; -use Test::More tests => 96; +use Test::More tests => 97; use Cwd; use File::Spec; @@ -47,6 +47,7 @@ sub add_file { $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 ? @@ -232,6 +233,14 @@ is( $files->{wibble}, '', 'maniadd() with undef comment' ); 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() diff --git a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm index e348753..06c0961 100644 --- a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm +++ b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm @@ -3,60 +3,63 @@ package HTTP::Tiny; 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 -# A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C ends in a space character, the default user-agent string is appended. -# * C -# An instance of L or equivalent class that supports the C and C methods -# * C -# A hashref of default headers to apply to requests -# * C -# The local IP address to bind to -# * C -# Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) -# * C -# Maximum number of redirects allowed (defaults to 5) -# * C -# Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. -# * C -# URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set) -# * C -# URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set) -# * C -# URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set) -# * C -# 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 -# Request timeout in seconds (default is 60) -# * C -# A boolean that indicates whether to validate the SSL certificate of an C -# connection (default is false) -# * C -# A hashref of C options to pass through to L -# -# Exceptions from C, C 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 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 for more on the C and C 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 — +#pod A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C — ends in a space character, the default user-agent string is appended. +#pod * C — +#pod An instance of L — or equivalent class that supports the C and C methods +#pod * C — +#pod A hashref of default headers to apply to requests +#pod * C — +#pod The local IP address to bind to +#pod * C — +#pod Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) +#pod * C — +#pod Maximum number of redirects allowed (defaults to 5) +#pod * C — +#pod Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. +#pod * C — +#pod URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set) +#pod * C — +#pod URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set) +#pod * C — +#pod URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set) +#pod * C — +#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 — +#pod Request timeout in seconds (default is 60) +#pod * C — +#pod A boolean that indicates whether to validate the SSL certificate of an C — +#pod connection (default is false) +#pod * C — +#pod A hashref of C — options to pass through to L +#pod +#pod Passing an explicit C for C, C or C will +#pod prevent getting the corresponding proxies from the environment. +#pod +#pod Exceptions from C, C 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 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 for more on the C and C attributes. +#pod +#pod =cut my @attributes; BEGIN { @@ -120,36 +123,45 @@ sub new { 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 @@ -161,19 +173,19 @@ sub _set_proxies { 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 for the given method. The -# URL must have unsafe characters escaped and international domain names encoded. -# See C for valid options and a description of the response. -# -# The C 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 for the given method. The +#pod URL must have unsafe characters escaped and international domain names encoded. +#pod See C for valid options and a description of the response. +#pod +#pod The C 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; @@ -188,25 +200,25 @@ for my $sub_name ( qw/get head put post delete/ ) { HERE } -# =method post_form -# -# $response = $http->post_form($url, $form_data); -# $response = $http->post_form($url, $form_data, \%options); -# -# This method executes a C request and sends the key/value pairs from a -# form data hash or array reference to the given URL with a C of -# C. 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 method for details on the encoding. -# -# The URL must have unsafe characters escaped and international domain names -# encoded. See C for valid options and a description of the response. -# Any C header or content in the options hashref will be ignored. -# -# The C 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 request and sends the key/value pairs from a +#pod form data hash or array reference to the given URL with a C of +#pod C. 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 method for details on the encoding. +#pod +#pod The URL must have unsafe characters escaped and international domain names +#pod encoded. See C for valid options and a description of the response. +#pod Any C header or content in the options hashref will be ignored. +#pod +#pod The C field of the response will be true if the status code is 2XX. +#pod +#pod =cut sub post_form { my ($self, $url, $data, $args) = @_; @@ -230,28 +242,28 @@ sub post_form { ); } -# =method mirror -# -# $response = $http->mirror($url, $file, \%options) -# if ( $response->{success} ) { -# print "$file is up to date\n"; -# } -# -# Executes a C 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 header with the modification timestamp of the file. You -# may specify a different C header yourself in the C<< -# $options->{headers} >> hash. -# -# The C 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 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 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 header with the modification timestamp of the file. You +#pod may specify a different C header yourself in the C<< +#pod $options->{headers} >> hash. +#pod +#pod The C 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 header, the file modification time will +#pod be updated accordingly. +#pod +#pod =cut sub mirror { my ($self, $url, $file, $args) = @_; @@ -284,86 +296,90 @@ sub mirror { 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 -# 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 -# 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 -# A code reference that will be called if it exists to provide a hashref -# of trailing headers (only used with chunked transfer-encoding) -# * C -# A code reference that will be called for each chunks of the response -# body received. -# -# If the C 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 option is the empty string, no C or -# C headers will be generated. -# -# If the C 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 or C -# received prior to the content body.) -# -# The C method returns a hashref containing the response. The hashref -# will have the following keys: -# -# =for :list -# * C -# Boolean indicating whether the operation returned a 2XX status code -# * C -# 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 -# The HTTP status code of the response -# * C -# The response phrase returned by the server -# * C -# 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 -# 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 field will -# contain 599, and the C 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 — +#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 — +#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 — +#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 — +#pod A code reference that will be called for each chunks of the response +#pod body received. +#pod +#pod The C header is generated from the URL in accordance with RFC 2616. It +#pod is a fatal error to specify C in the C option. Other headers +#pod may be ignored or overwritten if necessary for transport compliance. +#pod +#pod If the C 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 option is the empty string, no C or +#pod C headers will be generated. +#pod +#pod If the C 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 or C +#pod received prior to the content body.) +#pod +#pod The C method returns a hashref containing the response. The hashref +#pod will have the following keys: +#pod +#pod =for :list +#pod * C — +#pod Boolean indicating whether the operation returned a 2XX status code +#pod * C — +#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 — +#pod The HTTP status code of the response +#pod * C — +#pod The response phrase returned by the server +#pod * C — +#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 — +#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 field will +#pod contain 599, and the C field will contain the text of the exception. +#pod +#pod =cut my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/; @@ -404,19 +420,19 @@ sub request { 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 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 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) = @_; @@ -641,6 +657,11 @@ sub _prepare_headers_and_cb { $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" @@ -757,31 +778,27 @@ sub _split_url { 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 @@ -1132,8 +1149,7 @@ sub write_header_lines { $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"; } } @@ -1428,7 +1444,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client =head1 VERSION -version 0.043 +version 0.047 =head1 SYNOPSIS @@ -1473,91 +1489,65 @@ This constructor returns a new HTTP::Tiny object. Valid attributes include: =item * -C - -A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C ends in a space character, the default user-agent string is appended. +C — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C — ends in a space character, the default user-agent string is appended. =item * -C - -An instance of L or equivalent class that supports the C and C methods +C — An instance of L — or equivalent class that supports the C and C methods =item * -C - -A hashref of default headers to apply to requests +C — A hashref of default headers to apply to requests =item * -C - -The local IP address to bind to +C — The local IP address to bind to =item * -C - -Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) +C — Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1) =item * -C - -Maximum number of redirects allowed (defaults to 5) +C — Maximum number of redirects allowed (defaults to 5) =item * -C - -Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. +C — Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception. =item * -C - -URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set) +C — URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set) =item * -C - -URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set) +C — URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set) =item * -C - -URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set) +C — URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set) =item * -C - -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 — 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 - -Request timeout in seconds (default is 60) +C — Request timeout in seconds (default is 60) =item * -C - -A boolean that indicates whether to validate the SSL certificate of an C -connection (default is false) +C — A boolean that indicates whether to validate the SSL certificate of an C — connection (default is false) =item * -C - -A hashref of C options to pass through to L +C — A hashref of C — options to pass through to L =back +Passing an explicit C for C, C or C will +prevent getting the corresponding proxies from the environment. + Exceptions from C, C 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. @@ -1649,35 +1639,26 @@ Valid options are: =item * -C - -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 — 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 - -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 — 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 - -A code reference that will be called if it exists to provide a hashref -of trailing headers (only used with chunked transfer-encoding) +C — 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 - -A code reference that will be called for each chunks of the response -body received. +C — A code reference that will be called for each chunks of the response body received. =back +The C header is generated from the URL in accordance with RFC 2616. It +is a fatal error to specify C in the C option. Other headers +may be ignored or overwritten if necessary for transport compliance. + If the C 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. @@ -1699,45 +1680,27 @@ will have the following keys: =item * -C - -Boolean indicating whether the operation returned a 2XX status code +C — Boolean indicating whether the operation returned a 2XX status code =item * -C - -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 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 - -The HTTP status code of the response +C — The HTTP status code of the response =item * -C - -The response phrase returned by the server +C — The response phrase returned by the server =item * -C - -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 — 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 - -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 — 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 @@ -1775,7 +1738,7 @@ verify_SSL Direct C connections are supported only if L 1.56 or greater and L 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 connection may be made via an C proxy that supports the CONNECT command (i.e. RFC 2817). You may not proxy C via a proxy that itself requires C to communicate. @@ -1895,9 +1858,40 @@ environment variables. =head1 LIMITATIONS HTTP::Tiny is I with the -L. +L: + +=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: @@ -2035,7 +2029,7 @@ Chris Nehren =item * -Chris Weyl +Chris Weyl =item * @@ -2059,6 +2053,10 @@ Edward Zborowski =item * +James Raspass + +=item * + Jess Robinson =item * @@ -2091,6 +2089,10 @@ Syohei YOSHIDA =item * +Sören Kornetzki + +=item * + Tony Cook =back diff --git a/cpan/HTTP-Tiny/t/002_croakage.t b/cpan/HTTP-Tiny/t/002_croakage.t index a243ebc..9e51b5d 100644 --- a/cpan/HTTP-Tiny/t/002_croakage.t +++ b/cpan/HTTP-Tiny/t/002_croakage.t @@ -4,8 +4,12 @@ use strict; 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])/, @@ -26,7 +30,11 @@ my @cases = ( ['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; @@ -35,5 +43,9 @@ for my $c ( @cases ) { 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; diff --git a/cpan/HTTP-Tiny/t/020_headers.t b/cpan/HTTP-Tiny/t/020_headers.t index 970faa6..c10e075 100644 --- a/cpan/HTTP-Tiny/t/020_headers.t +++ b/cpan/HTTP-Tiny/t/020_headers.t @@ -49,3 +49,12 @@ use HTTP::Tiny; 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"); +} + diff --git a/cpan/HTTP-Tiny/t/140_proxy.t b/cpan/HTTP-Tiny/t/140_proxy.t index 401f8ae..6ecc6a5 100644 --- a/cpan/HTTP-Tiny/t/140_proxy.t +++ b/cpan/HTTP-Tiny/t/140_proxy.t @@ -31,5 +31,19 @@ for my $proxy ("http://localhost:8080/", "http://localhost:8080"){ like($@, qr{http_proxy URL must be in format http\[s\]://\[auth\@\]:/}); } +# 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(); diff --git a/cpan/Socket/Socket.pm b/cpan/Socket/Socket.pm index b1c78cc..a63e16d 100644 --- a/cpan/Socket/Socket.pm +++ b/cpan/Socket/Socket.pm @@ -3,7 +3,7 @@ package Socket; use strict; { use 5.006001; } -our $VERSION = '2.014'; +our $VERSION = '2.015'; =head1 NAME @@ -935,7 +935,7 @@ if( defined &getaddrinfo ) { # 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 diff --git a/cpan/Socket/t/getaddrinfo.t b/cpan/Socket/t/getaddrinfo.t index 24f154c..6f8a324 100644 --- a/cpan/Socket/t/getaddrinfo.t +++ b/cpan/Socket/t/getaddrinfo.t @@ -101,10 +101,24 @@ SKIP: { } # 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 diff --git a/cpan/Socket/t/getnameinfo.t b/cpan/Socket/t/getnameinfo.t index 035b345..5ee5575 100644 --- a/cpan/Socket/t/getnameinfo.t +++ b/cpan/Socket/t/getnameinfo.t @@ -1,6 +1,6 @@ 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); @@ -21,26 +21,14 @@ is( $service, "80", '$service is 80 for NS, NIx_NOHOST' ); 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' ); diff --git a/cpan/Socket/t/socketpair.t b/cpan/Socket/t/socketpair.t index 817707a..823306e 100644 --- a/cpan/Socket/t/socketpair.t +++ b/cpan/Socket/t/socketpair.t @@ -35,6 +35,11 @@ BEGIN { } 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; } } diff --git a/cpan/Time-HiRes/t/itimer.t b/cpan/Time-HiRes/t/itimer.t index a9ef80d..24374cd 100644 --- a/cpan/Time-HiRes/t/itimer.t +++ b/cpan/Time-HiRes/t/itimer.t @@ -43,7 +43,8 @@ note "setitimer: ", join(" ", # 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)); @@ -57,7 +58,8 @@ note "getitimer: ", join(" ", 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'; diff --git a/cpan/perlfaq/lib/perlfaq.pm b/cpan/perlfaq/lib/perlfaq.pm index 6d6a05a..9a64d66 100644 --- a/cpan/perlfaq/lib/perlfaq.pm +++ b/cpan/perlfaq/lib/perlfaq.pm @@ -1,6 +1,3 @@ package perlfaq; -{ - $perlfaq::VERSION = '5.0150044'; -} - +$perlfaq::VERSION = '5.0150045'; 0; # not is it supposed to be loaded diff --git a/cpan/perlfaq/lib/perlfaq1.pod b/cpan/perlfaq/lib/perlfaq1.pod index 19eb1ed..ad39051 100644 --- a/cpan/perlfaq/lib/perlfaq1.pod +++ b/cpan/perlfaq/lib/perlfaq1.pod @@ -116,7 +116,7 @@ and an experimental version. The maintenance versions are stable, and 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 diff --git a/cpan/perlfaq/lib/perlfaq5.pod b/cpan/perlfaq/lib/perlfaq5.pod index a2baf16..a8d4478 100644 --- a/cpan/perlfaq/lib/perlfaq5.pod +++ b/cpan/perlfaq/lib/perlfaq5.pod @@ -431,8 +431,10 @@ temporary files in one process, use a counter: 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; diff --git a/cpan/perlfaq/lib/perlfaq7.pod b/cpan/perlfaq/lib/perlfaq7.pod index bd6c102..3c5ab84 100644 --- a/cpan/perlfaq/lib/perlfaq7.pod +++ b/cpan/perlfaq/lib/perlfaq7.pod @@ -201,7 +201,7 @@ transfer the module to you. 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 diff --git a/deb.c b/deb.c index d1c3fe9..b93f120 100644 --- a/deb.c +++ b/deb.c @@ -59,7 +59,6 @@ void Perl_vdeb(pTHX_ const char *pat, va_list *args) { #ifdef DEBUGGING - dVAR; const char* const file = PL_curcop ? OutCopFILE(PL_curcop) : ""; const char* const display_file = file ? file : ""; const long line = PL_curcop ? (long)CopLINE(PL_curcop) : 0; @@ -83,7 +82,6 @@ I32 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), @@ -115,7 +113,6 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, I32 mark_min, I32 mark_max) { #ifdef DEBUGGING - dVAR; I32 i = stack_max - 30; const I32 *markscan = PL_markstack + mark_min; @@ -205,7 +202,6 @@ void Perl_deb_stack_all(pTHX) { #ifdef DEBUGGING - dVAR; I32 si_ix; const PERL_SI *si; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm index d9b4fa3..98a68a0 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm @@ -6,7 +6,7 @@ use File::Basename (); 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. diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm index a22abc8..4392b7f 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm @@ -10,7 +10,7 @@ use IPC::Cmd qw(can_run); 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 diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm index 1a89c7d..d948bbf 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm @@ -4,7 +4,7 @@ use strict; use ExtUtils::CBuilder::Base; use vars qw($VERSION @ISA); -$VERSION = '0.280216'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Base); sub link_executable { diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm index 534ee5e..d296bab 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm @@ -4,7 +4,7 @@ use strict; 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); diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm index 8a251f9..f9e4070 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm @@ -10,7 +10,7 @@ use ExtUtils::CBuilder::Base; use IO::File; use vars qw($VERSION @ISA); -$VERSION = '0.280216'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Base); =begin comment diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm index 6f00fa3..aab1437 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm @@ -1,7 +1,7 @@ package ExtUtils::CBuilder::Platform::Windows::BCC; use vars qw($VERSION); -$VERSION = '0.280216'; +$VERSION = '0.280217'; sub format_compiler_cmd { my ($self, %spec) = @_; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm index 88f863c..b8a32a8 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm @@ -1,7 +1,7 @@ package ExtUtils::CBuilder::Platform::Windows::GCC; use vars qw($VERSION); -$VERSION = '0.280216'; +$VERSION = '0.280217'; sub format_compiler_cmd { my ($self, %spec) = @_; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm index 8320242..3d4b5ab 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm @@ -1,7 +1,7 @@ package ExtUtils::CBuilder::Platform::Windows::MSVC; use vars qw($VERSION); -$VERSION = '0.280216'; +$VERSION = '0.280217'; sub arg_exec_file { my ($self, $file) = @_; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm index 25b3074..ecc14f8 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm @@ -5,7 +5,7 @@ use ExtUtils::CBuilder::Platform::Unix; use File::Spec; use vars qw($VERSION @ISA); -$VERSION = '0.280216'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub need_prelink { 1 } diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm index facc501..e2be516 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm @@ -1,11 +1,12 @@ 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 @@ -18,6 +19,7 @@ sub link { $self->split_like_shell($args{extra_linker_flags}), '-L' . $self->perl_inc(), '-lperl', + $self->split_like_shell($Config{perllibs}), ]; } diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm index 94ce283..43e6a47 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm @@ -5,7 +5,7 @@ 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); # TODO: If a specific exe_file name is requested, if the exe created diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm index 1f85d3f..bc4f188 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm @@ -4,7 +4,7 @@ use strict; use ExtUtils::CBuilder::Platform::Unix; use vars qw($VERSION @ISA); -$VERSION = '0.280216'; +$VERSION = '0.280217'; @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub compile { diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm index f5cf92d..f16fc01 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm @@ -6,7 +6,7 @@ use File::Spec; use vars qw($VERSION @ISA); @ISA = qw(ExtUtils::CBuilder::Platform::Unix); -$VERSION = '0.280216'; +$VERSION = '0.280217'; sub link_executable { my $self = shift; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm index 4e94304..3d4867c 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm @@ -4,7 +4,7 @@ use strict; 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 } diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index fcd153e..b95dca2 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,3 +1,6 @@ +5.021003 + - Prepared for v5.21.3 + 5.021002 - Prepared for v5.21.2 diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index 7ed0ea2..4fec3e9 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -4,7 +4,7 @@ use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated %delta/; use Module::CoreList::TieHashDelta; use version; -$VERSION = '5.021002'; +$VERSION = '5.021003'; my $dumpinc = 0; sub import { @@ -252,6 +252,7 @@ sub changes_between { 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 ) { @@ -10082,6 +10083,53 @@ 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 @@ -10504,6 +10552,13 @@ for my $version (sort { $a <=> $b } keys %delta) { removed => { } }, + 5.021003 => { + delta_from => 5.021002, + changed => { + }, + removed => { + } + }, ); for my $version (sort { $a <=> $b } keys %deprecated) { @@ -10554,6 +10609,7 @@ 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', @@ -10603,12 +10659,15 @@ for my $version (sort { $a <=> $b } keys %deprecated) { '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', @@ -10631,8 +10690,10 @@ for my $version (sort { $a <=> $b } keys %deprecated) { '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', @@ -10935,6 +10996,7 @@ for my $version (sort { $a <=> $b } keys %deprecated) { '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', @@ -10984,12 +11046,15 @@ for my $version (sort { $a <=> $b } keys %deprecated) { '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', @@ -11012,8 +11077,10 @@ for my $version (sort { $a <=> $b } keys %deprecated) { '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, diff --git a/dist/Module-CoreList/lib/Module/CoreList.pod b/dist/Module-CoreList/lib/Module/CoreList.pod index be37e4d..2f3573c 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pod +++ b/dist/Module-CoreList/lib/Module/CoreList.pod @@ -230,7 +230,7 @@ Module::CoreList currently covers the 5.000, 5.001, 5.002, 5.003_07, 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 diff --git a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm index a9fd403..470f42d 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm @@ -3,7 +3,7 @@ package Module::CoreList::TieHashDelta; use strict; use vars qw($VERSION); -$VERSION = '5.021002'; +$VERSION = '5.021003'; sub TIEHASH { my ($class, $changed, $removed, $parent) = @_; diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index 218c37a..483f481 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -6,7 +6,7 @@ use vars qw[$VERSION %utilities]; use Module::CoreList; use Module::CoreList::TieHashDelta; -$VERSION = '5.021002'; +$VERSION = '5.021003'; sub utilities { my $perl = shift; @@ -943,6 +943,13 @@ my %delta = ( removed => { } }, + 5.021003 => { + delta_from => 5.021002, + changed => { + }, + removed => { + } + }, ); for my $version (sort { $a <=> $b } keys %delta) { diff --git a/dist/Safe/Changes b/dist/Safe/Changes index 8cde1db..a48058a 100644 --- a/dist/Safe/Changes +++ b/dist/Safe/Changes @@ -1,3 +1,12 @@ +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 @@ -7,7 +16,7 @@ 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 diff --git a/dist/Safe/MANIFEST b/dist/Safe/MANIFEST index cb08dd3..0c533a5 100644 --- a/dist/Safe/MANIFEST +++ b/dist/Safe/MANIFEST @@ -1,6 +1,8 @@ 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 @@ -10,9 +12,8 @@ t/safeload.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) diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm index 4db116d..2c0d56a 100644 --- a/dist/Safe/Safe.pm +++ b/dist/Safe/Safe.pm @@ -3,7 +3,7 @@ package Safe; 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 *** # diff --git a/dist/Safe/t/safesecurity.t b/dist/Safe/t/safesecurity.t new file mode 100644 index 0000000..7cb9712 --- /dev/null +++ b/dist/Safe/t/safesecurity.t @@ -0,0 +1,32 @@ +#!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"); diff --git a/dist/autouse/t/autouse.t b/dist/autouse/t/autouse.t index 0a51ee0..74cad59 100644 --- a/dist/autouse/t/autouse.t +++ b/dist/autouse/t/autouse.t @@ -8,23 +8,27 @@ BEGIN { } } -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"); diff --git a/doio.c b/doio.c index 46d0796..a631eeb 100644 --- a/doio.c +++ b/doio.c @@ -391,7 +391,7 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, num_svs = 0; } else if (isDIGIT(*type)) { - wanted_fd = atoi(type); + wanted_fd = grok_atou(type, NULL); } else { const IO* thatio; diff --git a/embed.fnc b/embed.fnc index 241a769..0bde316 100644 --- a/embed.fnc +++ b/embed.fnc @@ -807,6 +807,7 @@ Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep 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 @@ -1111,6 +1112,7 @@ Ap |void |set_numeric_local 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 @@ -1933,6 +1935,8 @@ s |OP* |ref_array_or_hash|NULLOK OP* cond 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 diff --git a/embed.h b/embed.h index efa1735..7b8d471 100644 --- a/embed.h +++ b/embed.h @@ -170,6 +170,7 @@ #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) @@ -678,6 +679,7 @@ #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) @@ -1484,6 +1486,7 @@ #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) diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 29d9b91..dea981a 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -104,7 +104,7 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */ } #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 diff --git a/ext/GDBM_File/t/fatal.t b/ext/GDBM_File/t/fatal.t index e15e5e2..b7045ba 100644 --- a/ext/GDBM_File/t/fatal.t +++ b/ext/GDBM_File/t/fatal.t @@ -8,6 +8,10 @@ BEGIN { 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'); } diff --git a/ext/IPC-Open3/lib/IPC/Open3.pm b/ext/IPC-Open3/lib/IPC/Open3.pm index 99f120b..7c7e9b5 100644 --- a/ext/IPC-Open3/lib/IPC/Open3.pm +++ b/ext/IPC-Open3/lib/IPC/Open3.pm @@ -9,7 +9,7 @@ require Exporter; use Carp; use Symbol qw(gensym qualify); -$VERSION = '1.17'; +$VERSION = '1.18'; @ISA = qw(Exporter); @EXPORT = qw(open3); @@ -362,7 +362,7 @@ sub 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}); @@ -373,10 +373,12 @@ sub spawn_with_handles { 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; @@ -388,6 +390,7 @@ sub spawn_with_handles { } } + my $pid; unless (@errs) { if (FORCE_DEBUG_SPAWN) { pipe my $r, my $w or die "Pipe failed: $!"; diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index a48b01d..3da8d94 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -6,7 +6,7 @@ use strict; our($VERSION, @ISA, @EXPORT_OK); -$VERSION = "1.27"; +$VERSION = "1.28"; use Carp; use Exporter (); diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 386dddf..594f5b2 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -310,7 +310,7 @@ PPCODE: 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); @@ -320,6 +320,10 @@ PPCODE: SPAGAIN; /* for the PUTBACK added by xsubpp */ LEAVE; + /* Invalidate again */ + ++PL_sub_generation; + hv_clear(PL_stashcache); + int verify_opset(opset, fatal = 0) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 2a77df0..e3dac9b 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -537,7 +537,6 @@ static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */ static XSPROTO(is_common) { dXSARGS; - static PTR_TBL_t * is_common_ptr_table; if (items != 1) croak_xs_usage(cv, "charstring"); @@ -558,14 +557,12 @@ static XSPROTO(is_common) * 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); } } diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index 57845a7..3daa2f3 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.41'; +our $VERSION = '1.42'; require XSLoader; diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod index 61b0f71..677a599 100644 --- a/ext/POSIX/lib/POSIX.pod +++ b/ext/POSIX/lib/POSIX.pod @@ -146,7 +146,7 @@ coordinate and the I coordinate. See also L. =item C -C is C-specific: use C instead, see L. +C is C-specific: use C instead, see L. =item C diff --git a/ext/POSIX/t/is.t b/ext/POSIX/t/is.t index 0ab328e..6eb64fd 100644 --- a/ext/POSIX/t/is.t +++ b/ext/POSIX/t/is.t @@ -71,7 +71,7 @@ foreach my $s (keys %classes) { # Expected number of tests is one each for every combination of a # known is 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 tests on each string defined above. # Only the character classes listed for that string should return 1. We @@ -119,3 +119,20 @@ foreach my $s (sort keys %classes) { # 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"); +} diff --git a/ext/POSIX/t/iscrash b/ext/POSIX/t/iscrash new file mode 100644 index 0000000..94d04cb --- /dev/null +++ b/ext/POSIX/t/iscrash @@ -0,0 +1,20 @@ +# 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"; diff --git a/ext/Sys-Hostname/Hostname.pm b/ext/Sys-Hostname/Hostname.pm index 1d2e472..76c7602 100644 --- a/ext/Sys-Hostname/Hostname.pm +++ b/ext/Sys-Hostname/Hostname.pm @@ -14,7 +14,7 @@ our $VERSION; our $host; BEGIN { - $VERSION = '1.18'; + $VERSION = '1.19'; { local $SIG{__DIE__}; eval { diff --git a/ext/Sys-Hostname/Hostname.xs b/ext/Sys-Hostname/Hostname.xs index 6e974dd..c1e9c60 100644 --- a/ext/Sys-Hostname/Hostname.xs +++ b/ext/Sys-Hostname/Hostname.xs @@ -13,13 +13,6 @@ # 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 -# endif -#endif - #ifdef I_SYSUTSNAME # include #endif diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 4fa92e9..7fed553 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.62'; +our $VERSION = '0.63'; require XSLoader; diff --git a/ext/XS-APItest/numeric.xs b/ext/XS-APItest/numeric.xs index ab48dba..6d1ef82 100644 --- a/ext/XS-APItest/numeric.xs +++ b/ext/XS-APItest/numeric.xs @@ -30,3 +30,30 @@ grok_number_flags(number, flags) 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))); + } + } diff --git a/ext/XS-APItest/t/grok.t b/ext/XS-APItest/t/grok.t index 2e035ee..b41cb09 100644 --- a/ext/XS-APItest/t/grok.t +++ b/ext/XS-APItest/t/grok.t @@ -109,4 +109,148 @@ for my $grok (@groks) { 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(); diff --git a/gv.c b/gv.c index 64bdbf1..8b43d91 100644 --- a/gv.c +++ b/gv.c @@ -1843,7 +1843,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, if (!isDIGIT(*end)) return addmg; } - paren = strtoul(name, NULL, 10); + paren = grok_atou(name, NULL); goto storeparen; } } diff --git a/hints/catamount.sh b/hints/catamount.sh index 0d8f813..db87e1a 100644 --- a/hints/catamount.sh +++ b/hints/catamount.sh @@ -31,11 +31,11 @@ # 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 diff --git a/hints/dos_djgpp.sh b/hints/dos_djgpp.sh index 2b032cd..8f5fa33 100644 --- a/hints/dos_djgpp.sh +++ b/hints/dos_djgpp.sh @@ -41,10 +41,10 @@ startperl='#!perl' 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' ;; diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index a20dd39..57f4d14 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -90,9 +90,11 @@ END ` case "$cc" in -'') if test -f /opt/SUNWspro/bin/cc; then - cc=/opt/SUNWspro/bin/cc - cat <&4 +'') for i in `ls -r /opt/solstudio*/bin/cc` /opt/SUNWspro/bin/cc + do + if test -f "$i"; then + cc=$i + cat <&4 You specified no cc but you seem to have the Workshop compiler ($cc) installed, using that. @@ -100,7 +102,9 @@ If you want something else, specify that in the command line, e.g. Configure -Dcc=gcc EOF - fi + break + fi + done ;; esac @@ -336,7 +340,7 @@ EOM 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'`" @@ -355,6 +359,19 @@ EOM 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 @@ -686,7 +703,7 @@ EOCBU # 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 diff --git a/hv_func.h b/hv_func.h index 1923f3e..b3eea00 100644 --- a/hv_func.h +++ b/hv_func.h @@ -21,6 +21,8 @@ || 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 @@ -57,6 +59,14 @@ # 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 @@ -554,6 +564,134 @@ S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned c 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) diff --git a/intrpvar.h b/intrpvar.h index 77926df..9dd4e16 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -171,7 +171,7 @@ PERLVAR(I, statgv, GV *) 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 @@ -733,7 +733,7 @@ PERLVAR(I, debug_pad, struct perl_debug_pad) /* always needed because of the re /* 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. */ diff --git a/lib/UNIVERSAL.pm b/lib/UNIVERSAL.pm index 1adf09c..2f16cb5 100644 --- a/lib/UNIVERSAL.pm +++ b/lib/UNIVERSAL.pm @@ -1,27 +1,18 @@ 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; @@ -190,13 +181,9 @@ available to your program (and you should not do so). =head1 EXPORTS -None by default. +None. -You may request the import of three functions (C, C, and C), -B. Please don't do this in -new code. - -For example, previous versions of this documentation suggested using C as +Previous versions of this documentation suggested using C as a function to determine the type of a reference: use UNIVERSAL 'isa'; @@ -204,7 +191,7 @@ a function to determine the type of a reference: $yes = isa $h, "HASH"; $yes = isa "Foo", "Bar"; -The problem is that this code will I call an overridden C method in +The problem is that this code would I call an overridden C method in any class. Instead, use C from L for the first case: use Scalar::Util 'reftype'; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index e3f63b3..e8d7751 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -528,7 +528,7 @@ BEGIN { # 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"; @@ -1957,7 +1957,7 @@ sub _DB__handle_y_command { 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 = $@) { diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index cfdf884..3cd8e83 100644 --- a/lib/utf8_heavy.pl +++ b/lib/utf8_heavy.pl @@ -95,9 +95,9 @@ sub _loose_name ($) { # 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 diff --git a/locale.c b/locale.c index 85c438c..8f77885 100644 --- a/locale.c +++ b/locale.c @@ -159,7 +159,7 @@ Perl_new_numeric(pTHX_ const char *newnum) * 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 @@ -527,7 +527,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn) 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 @@ -1132,9 +1133,7 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category) * 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) @@ -1559,6 +1558,41 @@ Perl_my_strerror(pTHX_ const int errnum) { } /* + +=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 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 diff --git a/malloc.c b/malloc.c index a99663e..73a0480 100644 --- a/malloc.c +++ b/malloc.c @@ -1824,7 +1824,7 @@ Perl_mfree(Malloc_t where) 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; @@ -1922,7 +1922,7 @@ Perl_realloc(void *mp, size_t nbytes) 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; diff --git a/mg.c b/mg.c index 28ed156..e1fc578 100644 --- a/mg.c +++ b/mg.c @@ -2891,6 +2891,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) { const char *p = SvPV_const(sv, len); Groups_t *gary = NULL; + const char* endptr; #ifdef _SC_NGROUPS_MAX int maxgrp = sysconf(_SC_NGROUPS_MAX); @@ -2902,19 +2903,20 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) 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)); diff --git a/myconfig.SH b/myconfig.SH index 1808392..6233188 100755 --- a/myconfig.SH +++ b/myconfig.SH @@ -45,7 +45,7 @@ Summary of my $package (revision $revision $version_patchlevel_string) configura 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: diff --git a/numeric.c b/numeric.c index 4876ece..a203bf5 100644 --- a/numeric.c +++ b/numeric.c @@ -586,13 +586,14 @@ Perl_grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) 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; @@ -660,9 +661,9 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags) 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'; @@ -786,6 +787,91 @@ Perl_grok_number_flags(pTHX_ const char *pv, STRLEN len, UV *valuep, U32 flags) 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) { diff --git a/op.c b/op.c index e9de3a2..f785c55 100644 --- a/op.c +++ b/op.c @@ -1118,7 +1118,6 @@ For example: 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; @@ -7670,7 +7669,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV); has_name = FALSE; } - if (!ec) move_proto_attr(&proto, &attrs, gv); @@ -7930,8 +7928,12 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, } } - 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: @@ -7946,6 +7948,27 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, } 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) @@ -9358,7 +9381,6 @@ Perl_ck_defined(pTHX_ OP *o) /* 19990527 MJD */ 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; @@ -10486,7 +10508,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) } else { OP *prev, *cvop, *first, *parent; - U32 flags; + U32 flags = 0; parent = entersubop; if (!OP_HAS_SIBLING(aop)) { @@ -10501,7 +10523,12 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) 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); diff --git a/op.h b/op.h index 9f94caf..c76f37d 100644 --- a/op.h +++ b/op.h @@ -114,7 +114,6 @@ Deprecated. Use C instead. /* 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 diff --git a/pad.c b/pad.c index 18b6e5c..00a76f2 100644 --- a/pad.c +++ b/pad.c @@ -1402,7 +1402,6 @@ Use macro PAD_SV instead of calling this function directly. SV * Perl_pad_sv(pTHX_ PADOFFSET po) { - dVAR; ASSERT_CURPAD_ACTIVE("pad_sv"); if (!po) @@ -1426,8 +1425,6 @@ Use the macro PAD_SETSV() rather than calling this function directly. void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv) { - dVAR; - PERL_ARGS_ASSERT_PAD_SETSV; ASSERT_CURPAD_ACTIVE("pad_setsv"); @@ -1918,7 +1915,6 @@ dump the contents of a CV STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title) { - dVAR; const CV * const outside = CvOUTSIDE(cv); PADLIST* const padlist = CvPADLIST(cv); diff --git a/patchlevel.h b/patchlevel.h index 30673d1..6bf40ed 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -15,7 +15,7 @@ #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 @@ -36,7 +36,7 @@ */ #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 diff --git a/perl.c b/perl.c index 6e09931..e84f1d5 100644 --- a/perl.c +++ b/perl.c @@ -546,7 +546,12 @@ perl_destruct(pTHXx) { 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 @@ -1451,7 +1456,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) { 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); @@ -2285,8 +2290,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #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 @@ -3042,7 +3047,10 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) } } 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) { @@ -3650,9 +3658,9 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript) 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. diff --git a/perl.h b/perl.h index 54f6dca..ece022d 100644 --- a/perl.h +++ b/perl.h @@ -1677,7 +1677,8 @@ typedef UVTYPE UV; # 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)) @@ -1847,6 +1848,12 @@ typedef NVTYPE NV; # 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 @@ -1902,6 +1909,13 @@ EXTERN_C long double modfl(long double, long double *); # 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) @@ -1923,6 +1937,12 @@ EXTERN_C long double modfl(long double, long double *); # 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 @@ -1952,6 +1972,7 @@ EXTERN_C long double modfl(long double, long double *); # 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() */ @@ -4642,6 +4663,9 @@ EXTCONST char PL_bincompat_options[] = # 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 @@ -4793,6 +4817,7 @@ typedef enum { XATTRBLOCK, XATTRTERM, XTERMBLOCK, + XBLOCKTERM, XPOSTDEREF, XTERMORDORDOR /* evil hack */ /* update exp_name[] in toke.c if adding to this enum */ diff --git a/plan9/config.plan9 b/plan9/config.plan9 index 7437e4b..0ca8f85 100644 --- a/plan9/config.plan9 +++ b/plan9/config.plan9 @@ -3373,8 +3373,8 @@ * 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 @@ -3501,9 +3501,9 @@ * 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. diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index 9608ceb..bbe15af 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -32,12 +32,12 @@ alignbytes='4' 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='' @@ -300,6 +300,7 @@ d_isnanl='undef' d_killpg='undef' d_lchown='undef' d_ldbl_dig='define' +d_ldexpl='undef' d_libm_lib_version='0' d_link='define' d_localtime64='undef' @@ -729,17 +730,17 @@ inc_version_list=' ' 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='' @@ -777,6 +778,7 @@ lns='/bin/ln -s' localtime_r_proto='0' locincpth='' loclibpth='' +longdblkind='0' longdblsize='8' longlongsize='8' longsize='4' @@ -859,8 +861,8 @@ pmake='' 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' @@ -925,13 +927,13 @@ sig_num='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 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' @@ -964,7 +966,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/sys/include/ape/string.h' submit='' -subversion='2' +subversion='3' sysman='/sys/man/1pub' tail='' tar='' @@ -1045,8 +1047,8 @@ vendorlib_stem='' 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='' @@ -1060,9 +1062,9 @@ config_args='' 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 diff --git a/pod/.gitignore b/pod/.gitignore index 5e940fb..63b25c4 100644 --- a/pod/.gitignore +++ b/pod/.gitignore @@ -53,7 +53,7 @@ /roffitall # generated -/perl5212delta.pod +/perl5213delta.pod /perlapi.pod /perlintern.pod *.html diff --git a/pod/perl.pod b/pod/perl.pod index 0e9fd05..5599bc2 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -179,6 +179,7 @@ aux a2p c2ph h2ph h2xs perlbug pl2pm pod2html pod2man s2p splain xsubpp 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 diff --git a/pod/perl5212delta.pod b/pod/perl5212delta.pod new file mode 100644 index 0000000..f31a782 --- /dev/null +++ b/pod/perl5212delta.pod @@ -0,0 +1,377 @@ +=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, 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 has been upgraded from version 0.07 to 0.08. + +=item * + +L has been upgraded from version 1.49 to 1.50. + +=item * + +L has been upgraded from version 1.17 to 1.18. + +=item * + +L has been upgraded from version 0.007 to 0.008. + +=item * + +L has been upgraded from version 1.63 to 1.64. + +=item * + +L has been upgraded from version 2.29 to 2.30. + +=item * + +The PathTools module collection (L and friends) has been +upgraded from version 3.48 to 3.49. + +=item * + +L has been upgraded from version 0.91 to 0.92. + +=item * + +L has been upgraded from version 0.17 to 0.18. + +=item * + +L has been upgraded from version 1.32 to 1.33. + +=item * + +L has been upgraded from version 0.29 to 0.31. + +A better fix for subclassing C. +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 has been upgraded from version 1.16 to 1.17. + +=item * + +L 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 has been upgraded from version 5.021001_01 to 5.021002. + +=item * + +L has been upgraded from version 1.63 to 1.64. + +=item * + +L has been upgraded from version 1.40 to 1.41. + +=item * + +L has been upgraded from version 1.94 to 1.95. + +=item * + +L 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 + +(W numeric) The indicated string was fed as an argument to the C<++> operator +which expects either a number or a string matching C. +See L for details. + +=item * + +L + +(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. + +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. Added an +explicit dependency to C. +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, C, C, C, +C, C, C, C, +C, C, C, C. + +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 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 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, +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 file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perlclib.pod b/pod/perlclib.pod index 23cca04..7f86f1b 100644 --- a/pod/perlclib.pod +++ b/pod/perlclib.pod @@ -200,14 +200,19 @@ C, as described in L.) 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, C, and C functions in F for converting strings representing numbers in the respective -bases into Cs. +bases into Cs. 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 and C may not be defined if the machine perl is built on doesn't actually have strtol and strtoul. But as those 2 @@ -219,7 +224,7 @@ everywhere by now. 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) diff --git a/pod/perldata.pod b/pod/perldata.pod index d8edfe9..52921ca 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -393,15 +393,16 @@ X X 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: @@ -425,6 +426,14 @@ Hexadecimal, octal, or binary, representations in string literals representation. The hex() and oct() functions make these conversions for you. See L and L 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

, 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 diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 974a62c..8ed52b7 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,242 +2,279 @@ =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, 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, 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 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 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. -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 module could allow outside packages to be replaced -=head1 Deprecations +Critical bugfix: outside packages could be replaced. L 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> is now a fatal error -=head1 Performance Enhancements +Importing functions from C has been deprecated since v5.12, and +is now a fatal error. S> 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 has been upgraded from version 1.19 to 1.21. =item * -Pathtools don't try to load XS on miniperl. +L has been upgraded from version 0.20 to 0.22. =item * -A typo fix reduces the size of the C<< OP >> structure. +L has been upgraded from version 2.141520 to 2.142060. =item * -Hash lookups where the key is a constant is faster. +L has been upgraded from version 2.125 to 2.126. -=back +=item * -=head1 Modules and Pragmata +L was moved from F to F. -=head2 Updated Modules and Pragmata +=item * -=over 4 +L has been upgraded from version 0.280216 to 0.280217. =item * -L has been upgraded from version 0.07 to 0.08. +L was moved from F to F. =item * -L has been upgraded from version 1.49 to 1.50. +L has been upgraded from version 1.64 to 1.65. +It was also moved from F to F. =item * -L has been upgraded from version 1.17 to 1.18. +L has been upgraded from version 0.043 to 0.047. =item * -L has been upgraded from version 0.007 to 0.008. +L has been upgraded from version 1.17 to 1.18. =item * -L has been upgraded from version 1.63 to 1.64. +L has been upgraded from version 5.021002 to 5.021003. =item * -L has been upgraded from version 2.29 to 2.30. +L has been upgraded from version 1.27 to 1.28. =item * -The PathTools module collection (L and friends) has been -upgraded from version 3.48 to 3.49. +L has been upgraded from version 1.45 to 1.46. =item * -L has been upgraded from version 0.91 to 0.92. +L has been upgraded from version 5.0150044 to 5.0150045. =item * -L has been upgraded from version 0.17 to 0.18. +L has been upgraded from version 1.41 to 1.42. =item * -L has been upgraded from version 1.32 to 1.33. +L has been upgraded from version 2.37 to 2.38. =item * -L has been upgraded from version 0.29 to 0.31. - -A better fix for subclassing C. -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 has been upgraded from version 2.014 to 2.015. =item * -L has been upgraded from version 1.16 to 1.17. +L has been upgraded from version 1.18 to 1.19 =item * -L has been upgraded from version 1.9995 to 1.9996. +L 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 has been upgraded from version 5.021001_01 to 5.021002. +=head2 Changes to Existing Documentation -=item * +=head3 L -L has been upgraded from version 1.63 to 1.64. +=over 4 =item * -L has been upgraded from version 1.40 to 1.41. +Added reference to L. -=item * +=back -L has been upgraded from version 1.94 to 1.95. +=head3 L + +=over 4 =item * -L has been upgraded from version 1.24 to 1.26. +Details on C level symbols and libperl.t added. =back -=head1 Documentation +=head3 L -=head2 Changes to Existing Documentation +=over 4 + +=item * + +Recommended replacements for tmpfile, atoi, strtol, and strtoul added. -=head3 L<< perlpolicy >> +=back + +=head3 L =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 =over 4 =item * -Improve documentation of C<< our >>. +Comments added on algorithmic complexity and tied hashes. =back -=head3 L<< perlsyn >> +=head3 L =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. + =head2 New Diagnostics +=head3 New Errors + +=over 4 + +=item * + +L + +(F) Something went horribly bad in hexadecimal float handling. + +=item * + +L + +(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 +L + +(W overflow) The hexadecimal floating point has larger exponent +than the floating point supports. + +=item * + +L -(W numeric) The indicated string was fed as an argument to the C<++> operator -which expects either a number or a string matching C. -See L for details. +(W overflow) The hexadecimal floating point has smaller exponent +than the floating point supports. =item * -L +L -(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. +(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 + +(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 with no argument or undef used to warn about a Null filename; now +it dies with C. =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 @@ -247,12 +284,25 @@ more compatible with C<< Test::More >>. =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. Added an -explicit dependency to C. -L<[perl #120120]|https://rt.perl.org/Ticket/Display.html?id=120120> +C options have been cleaned up, hints look for C +as well as C, and support for native C has been added. + +=item VMS + +C, C, and C detection has been added to +C, 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 @@ -262,28 +312,15 @@ L<[perl #120120]|https://rt.perl.org/Ticket/Display.html?id=120120> =item * -The following private API functions had their context parameter removed, -C, C, C, C, -C, C, C, C, -C, C, C, C. - -Users of the public API prefix-less calls remain unaffected. +Added L. +Changing the program's locale should be avoided by XS code. Nevertheless, +certain non-Perl libraries called from XS, such as C 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 as a safer replacement for atoi and strtol. =back @@ -293,41 +330,49 @@ C<< -DPERL_OP_PARENT >> has been set, they return the parent of the current op. =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 in an eval could leave a spurious +C subroutine definition, which would produce a "Subroutine +BEGIN redefined" warning on the next use of C, or other C +block. [perl #122107] + +=item * + +C 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 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 diff --git a/pod/perldiag.pod b/pod/perldiag.pod index be29485..ddcc0b9 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -193,22 +193,6 @@ operator which expects either a number or a string matching C. See L 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, but -they could be defined by a translator installed into C<$^H{charnames}>. -See L. - -=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, but they -could be defined by a translator installed into C<$^H{charnames}>. -See L. - =item assertion botched: %s (X) The malloc package that comes with Perl had an internal failure. @@ -228,6 +212,11 @@ the special variable C<$[>, which is deprecated, is now a fixed zero value. 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 >> when you should have written +C. + =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 @@ -536,16 +525,6 @@ encountered an invalid data type. 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() @@ -1195,14 +1174,16 @@ other than "=" after the module name. =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 @@ -1425,6 +1406,32 @@ uses the character values modulus 256 instead, as if you had provided: 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, but they +could be defined by a translator installed into C<$^H{charnames}>. See +L. + +=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, but they +could be defined by a translator installed into C<$^H{charnames}>. +See L. + +=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> construct is intended to be a way to specify @@ -1471,8 +1478,8 @@ but not higher. Code points above 0xFFFF_FFFF require larger than a =item %s: Command not found (A) You've accidentally run your script through B 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 @@ -2172,6 +2179,39 @@ created on an emergency basis to prevent a core dump. (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 @@ -2398,14 +2438,6 @@ expression that contains a call to a user-defined character property function, i.e. C<\p{IsFoo}> or C<\p{InFoo}>. See L and L. -=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 @@ -2480,6 +2512,14 @@ followed by parentheses turns into a function, with all the list operators arguments found inside the parentheses. See L. +=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 @@ -3012,13 +3052,6 @@ arguments than were supplied, but might be used in the future for other cases where we can statically determine that arguments to functions are missing, e.g. for the L 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. - =item Missing argument to -%c (F) The argument to the indicated command line switch must follow @@ -3074,6 +3107,12 @@ can vary from one line to the next. (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. + =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{...}>. @@ -3227,10 +3266,10 @@ names. If you had a good reason for having a unique name, then just mention it again somehow to suppress the message. The C 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 @@ -3617,11 +3656,6 @@ to UTC. If it's not, define the logical name F 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. - =item NULL OP IN RUN (S debugging) Some internal routine called run() with a null opcode @@ -4173,6 +4207,14 @@ and there is a bug in Perl in which the built-in regular expression folding rules are not accurate. This may lead to incorrect results. Please report this as a bug using the L 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, @@ -4255,14 +4297,6 @@ are as follows. 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 @@ -4633,6 +4667,13 @@ loading PerlIO::scalar explicitly first. 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. + =item refcnt_dec: fd %d%s =item refcnt: fd %d%s @@ -5035,11 +5076,6 @@ take the risk of using this feature, simply disable this warning: 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 >> when you should have written -C. - =item /%s/ should probably be written as "%s" (W syntax) You have used a pattern where Perl expected to find a string, @@ -5679,11 +5715,11 @@ Check the #! line, or manually feed your script into Perl yourself. 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} @@ -5755,16 +5791,16 @@ with the characters in the Lao and Thai scripts. =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. - -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. + +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 diff --git a/pod/perlexperiment.pod b/pod/perlexperiment.pod index 50b1a2a..66bd960 100644 --- a/pod/perlexperiment.pod +++ b/pod/perlexperiment.pod @@ -271,6 +271,10 @@ Removed in: 5.11.3 =back +=head1 SEE ALSO + +For a complete list of features check L. + =head1 AUTHORS brian d foy C<< >> diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 173615b..40e4965 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -1683,6 +1683,9 @@ returned by C, so the following code works properly: 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: @@ -3155,7 +3158,9 @@ rely on C, C and C to repeatedly return the same order as each other. See L 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). In particular, calling keys() in void context resets @@ -7109,6 +7114,8 @@ In addition, Perl permits the following widely-supported conversions: %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: @@ -7123,7 +7130,9 @@ Note that the number of exponent digits in the scientific notation produced 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. @@ -8747,7 +8756,9 @@ rely on C, C and C to repeatedly return the same order as each other. See L 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. (In particular, calling values() in void context diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 4fe0798..bcd2672 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -2237,11 +2237,18 @@ please see F for usage details. You may also need to use C 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: +To see whether you have non-const data you can use a BSD (or GNU) +compatible C: nm libperl.a | grep -v ' [TURtr] ' -If this displays any C or C symbols, you have non-const data. +If this displays any C or C symbols (or possibly C or C), +you have non-const data. The symbols the C removed are as follows: +C are I, or code, the C are I (const) data, +and the C is , external symbols referred to. + +The test F does this kind of symbol sanity +checking on C. For backward compatibility reasons defining just PERL_GLOBAL_STRUCT doesn't actually hide all symbols inside a big global struct: some diff --git a/pod/perlhacktips.pod b/pod/perlhacktips.pod index 5cd04e4..3d477da 100644 --- a/pod/perlhacktips.pod +++ b/pod/perlhacktips.pod @@ -581,6 +581,7 @@ snprintf() - the return type is unportable. Use my_snprintf() instead. =head2 Security problems Last but not least, here are various tips for safer coding. +See also L for libc/stdio replacements one should use. =over 4 @@ -592,6 +593,12 @@ Or we will publicly ridicule you. Seriously. =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 @@ -616,6 +623,22 @@ of the program is UTF-8. What happens is that the C<%s> and its operand are simply skipped without any notice. L. +=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 diff --git a/pod/perlhist.pod b/pod/perlhist.pod index de4737c..230db66 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -534,6 +534,7 @@ the strings?). 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 diff --git a/pod/perlop.pod b/pod/perlop.pod index 7928370..f00c134 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1434,10 +1434,12 @@ table: \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 is 127, and +its uppercase. C<\c?> is DELETE on ASCII platforms because +S> is 127, and C<\c@> is NULL because the ord of "@" is 64, so xor'ing 64 itself produces 0. Also, C<\c\I> yields C< chr(28) . "I"> for any I, but cannot come at the @@ -1446,14 +1448,15 @@ quote. 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 for the complete list of what these -sequences mean on both ASCII and EBCDIC platforms. +L 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{...}>. @@ -1483,12 +1486,6 @@ the left with zeros to make three digits. For larger ordinals, either use 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 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 @@ -1751,7 +1748,7 @@ test and never recompile by adding a C (which stands for "once") 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 are either: +interests of speed. But now, the only reasons to use C are one of: =over diff --git a/pod/perlre.pod b/pod/perlre.pod index bf439ae..891eb34 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -646,9 +646,9 @@ also work: \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. @@ -1233,7 +1233,8 @@ A zero-width positive look-behind assertion. For example, C 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 diff --git a/pod/perlsec.pod b/pod/perlsec.pod index 703bd46..b6474e6 100644 --- a/pod/perlsec.pod +++ b/pod/perlsec.pod @@ -534,6 +534,9 @@ or the CPAN module C), or for generating permutations (use e.g. the CPAN modules C or C), 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 diff --git a/pod/perlvms.pod b/pod/perlvms.pod index 1cfb231..0362c3b 100644 --- a/pod/perlvms.pod +++ b/pod/perlvms.pod @@ -938,12 +938,12 @@ F as follows: =item CRTL_ENV -This string tells Perl to consult the CRTL's internal C -array of key-value pairs, using I as the key. In most cases, -this contains only a few keys, but if Perl was invoked via the C -C function, as is the case for CGI processing by some -HTTP servers, then the C array may have been populated by -the calling program. +This string tells Perl to consult the CRTL's internal C array +of key-value pairs, using I as the key. In most cases, this +contains only a few keys, but if Perl was invoked via the C +C function, as is the case for some embedded Perl +applications or when running under a shell such as GNV bash, the +C array may have been populated by the calling program. =item CLISYM_[LOCAL] @@ -968,7 +968,9 @@ F is translated once when Perl starts up; any changes you make while Perl is running do not affect the behavior of C<%ENV>. If F is not defined, then Perl defaults to consulting first the logical name tables specified by F, and then -the CRTL C array. +the CRTL C array. This default order is reversed when the +logical name F 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 @@ -1005,23 +1007,16 @@ string, the logical name's translation is defined as a single C (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 values; they are set to the empty string.) -An element of the CRTL C array can be set only if your -copy of Perl knows about the CRTL's C 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, -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 -array is set to the empty string; this can only be done if your -copy of Perl knows about the CRTL C function.) Using -C 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, 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 array is set to the empty +string.) Using C 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 diff --git a/pp.c b/pp.c index bc7c0df..5218f7b 100644 --- a/pp.c +++ b/pp.c @@ -4128,15 +4128,18 @@ PP(pp_quotemeta) } } 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; diff --git a/pp_ctl.c b/pp_ctl.c index 7d098b7..5e671ee 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -3680,6 +3680,7 @@ PP(pp_require) 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)) @@ -3737,9 +3738,12 @@ PP(pp_require) 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), diff --git a/pp_sys.c b/pp_sys.c index 54c12b3..e01cf48 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -3295,7 +3295,7 @@ PP(pp_fttty) 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) { @@ -3671,13 +3671,17 @@ PP(pp_readlink) 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 diff --git a/proto.h b/proto.h index 49a44d2..19ec194 100644 --- a/proto.h +++ b/proto.h @@ -1289,6 +1289,11 @@ PERL_CALLCONV int Perl_getcwd_sv(pTHX_ SV* sv) 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) @@ -4685,6 +4690,7 @@ PERL_CALLCONV SV* Perl_swash_init(pTHX_ const char* pkg, const char* name, SV* l #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); @@ -6108,6 +6114,13 @@ STATIC void S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flag #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 \ diff --git a/regcomp.c b/regcomp.c index 3d4d348..991d2f8 100644 --- a/regcomp.c +++ b/regcomp.c @@ -5043,7 +5043,8 @@ PerlIO_printf(Perl_debug_log, "LHS=%"UVuf" RHS=%"UVuf"\n", 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 && @@ -5131,8 +5132,11 @@ PerlIO_printf(Perl_debug_log, "LHS=%"UVuf" RHS=%"UVuf"\n", */ 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; } } } @@ -5204,6 +5208,7 @@ PerlIO_printf(Perl_debug_log, "LHS=%"UVuf" RHS=%"UVuf"\n", 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)) @@ -9605,6 +9610,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) 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"); @@ -9814,12 +9820,21 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) 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"); @@ -9959,6 +9974,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) 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] == '<' /* (?()...) */ || RExC_parse[0] == '\'' ) /* (?('NAME')...) */ @@ -9996,9 +10013,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) 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++; @@ -10015,10 +10032,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) /* (?(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: @@ -10083,10 +10099,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp,U32 depth) 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, @@ -10492,15 +10506,16 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 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) @@ -11147,18 +11162,17 @@ S_alloc_maybe_populate_EXACT(pTHX_ RExC_state_t *pRExC_state, } -/* 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; } @@ -15347,7 +15361,6 @@ STATIC U8 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 @@ -15510,7 +15523,6 @@ void Perl_regdump(pTHX_ const regexp *r) { #ifdef DEBUGGING - dVAR; SV * const sv = sv_newmortal(); SV *dsv= sv_newmortal(); RXi_GET_DECL(r,ri); @@ -15609,7 +15621,6 @@ void 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 */ @@ -16672,12 +16683,12 @@ S_put_latin1_charclass_innards(pTHX_ SV *sv, char *bitmap) 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; } @@ -16710,7 +16721,6 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, 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; diff --git a/regexec.c b/regexec.c index 58b3f60..33fb5da 100644 --- a/regexec.c +++ b/regexec.c @@ -536,12 +536,10 @@ S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character) 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 */ } /* @@ -3636,8 +3634,8 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, 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; @@ -4039,12 +4037,15 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) 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') @@ -4095,7 +4096,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) REPORT_CODE_OFF+depth*2, "", PL_colors[4], PL_colors[5]) ); sayNO_SILENT; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } /* FALLTHROUGH */ case TRIE: /* (ab|cd) */ @@ -4282,7 +4284,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) ); goto trie_first_try; /* jump into the fail handler */ }} - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); case TRIE_next_fail: /* we failed - try next alternative */ { @@ -4396,7 +4399,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) 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({ @@ -4420,7 +4424,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) locinput = (char*)uc; continue; /* execute rest of RE */ - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } #undef ST @@ -5229,7 +5234,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) /* 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) { @@ -5510,7 +5516,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) 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 */ @@ -5619,7 +5626,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } } goto fake_end; - /*NOTREACHED*/ + /* NOTREACHED */ case GROUPP: /* (?(1)) */ n = ARG(scan); /* which paren pair */ @@ -5769,19 +5776,22 @@ NULL 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 @@ -5819,7 +5829,8 @@ NULL 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. */ @@ -5931,7 +5942,8 @@ NULL 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. */ @@ -5942,24 +5954,28 @@ NULL 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 */ @@ -5969,7 +5985,8 @@ NULL 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); @@ -5995,7 +6012,8 @@ NULL 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; @@ -6029,7 +6047,8 @@ NULL 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 @@ -6054,13 +6073,15 @@ NULL } 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; @@ -6068,11 +6089,13 @@ NULL 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) { @@ -6094,7 +6117,8 @@ NULL 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; @@ -6138,7 +6162,8 @@ NULL 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++; @@ -6274,7 +6299,8 @@ NULL } 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); @@ -6452,8 +6478,8 @@ NULL 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 */ @@ -6528,8 +6554,8 @@ NULL } 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 */ @@ -6561,8 +6587,8 @@ NULL } } sayNO; - assert(0); /* NOTREACHED */ - + /* NOTREACHED */ + assert(0); curly_try_B_max: /* a successful greedy match: now try to match B */ @@ -6592,7 +6618,8 @@ NULL 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 */ @@ -6711,7 +6738,8 @@ NULL /* 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 */ @@ -6751,7 +6779,8 @@ NULL 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; @@ -6759,7 +6788,8 @@ NULL case OPFAIL: /* (*FAIL) */ sayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); #define ST st->u.mark case MARKPOINT: /* (*MARK:foo) */ @@ -6769,12 +6799,14 @@ NULL 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)) @@ -6795,7 +6827,8 @@ NULL 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) { @@ -6840,7 +6873,8 @@ NULL } no_final = 1; sayNO; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); #undef ST case LNBREAK: /* \R */ @@ -6874,7 +6908,8 @@ NULL /* 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 */ @@ -6917,7 +6952,8 @@ NULL locinput = pushinput; st = newst; continue; - assert(0); /* NOTREACHED */ + /* NOTREACHED */ + assert(0); } } @@ -6926,7 +6962,7 @@ NULL * the terminating point. */ Perl_croak(aTHX_ "corrupted regexp pointers"); - /*NOTREACHED*/ + /* NOTREACHED */ sayNO; yes: @@ -7553,7 +7589,8 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, 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); } diff --git a/sv.c b/sv.c index b02ef28..44f816b 100644 --- a/sv.c +++ b/sv.c @@ -385,8 +385,6 @@ S_new_SV(pTHX_ const char *file, int line, const char *func) STATIC void S_del_sv(pTHX_ SV *p) { - dVAR; - PERL_ARGS_ASSERT_DEL_SV; if (DEBUG_D_TEST) { @@ -1855,7 +1853,6 @@ S_sv_display(pTHX_ SV *const sv, char *tmpbuf, STRLEN tmpbuf_size) { STATIC void S_not_a_number(pTHX_ SV *const sv) { - dVAR; char tmpbuf[64]; const char *pv; @@ -1876,7 +1873,6 @@ S_not_a_number(pTHX_ SV *const sv) STATIC void S_not_incrementable(pTHX_ SV *const sv) { - dVAR; char tmpbuf[64]; const char *pv; @@ -10567,6 +10563,254 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen, 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, @@ -10589,6 +10833,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p /* 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; @@ -11380,6 +11625,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p case 'e': case 'E': case 'f': case 'g': case 'G': + case 'a': case 'A': if (vectorize) goto unknown; @@ -11432,14 +11678,42 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p /* 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 */ @@ -11537,7 +11811,166 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p 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; @@ -11581,14 +12014,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p * 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; diff --git a/sv.h b/sv.h index 68e5db1..753b5bb 100644 --- a/sv.h +++ b/sv.h @@ -545,9 +545,14 @@ struct xpvlv { 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 diff --git a/symbian/config.sh b/symbian/config.sh index d86c71e..27f5a5b 100644 --- a/symbian/config.sh +++ b/symbian/config.sh @@ -246,6 +246,7 @@ d_isnanl='undef' d_killpg='undef' d_lchown='undef' d_ldbl_dig='undef' +d_ldexpl='undef' d_libm_lib_version='undef' d_link='undef' d_localtime64='undef' @@ -672,6 +673,7 @@ libc='stdlib' libm_lib_version='0' libperl='libperl.a' localtime_r_proto='0' +longdblkind=0 longdblsize=8 longlongsize=8 longsize='4' diff --git a/t/TEST b/t/TEST index 0f11390..5d25af6 100755 --- a/t/TEST +++ b/t/TEST @@ -38,8 +38,11 @@ my %abs = ( '../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, @@ -51,9 +54,6 @@ my %abs = ( '../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, ); diff --git a/t/comp/parser.t b/t/comp/parser.t index 7caa116..c5cff29 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -8,7 +8,7 @@ BEGIN { chdir 't'; } -print "1..169\n"; +print "1..170\n"; sub failed { my ($got, $expected, $name) = @_; @@ -499,6 +499,10 @@ eval 'for my a1b $i (1) {}'; # 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} diff --git a/t/io/fs.t b/t/io/fs.t index 5e82b45..0d3f435 100644 --- a/t/io/fs.t +++ b/t/io/fs.t @@ -16,9 +16,6 @@ if (($^O eq 'MSWin32') || ($^O eq 'NetWare')) { 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 diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 364d7e0..33ee585 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -1081,8 +1081,6 @@ Can't use 'defined(@array)' (Maybe you should just omit the defined()?) at - lin # 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); diff --git a/t/op/coresubs.t b/t/op/coresubs.t index 2e93c71..58f7d5f 100644 --- a/t/op/coresubs.t +++ b/t/op/coresubs.t @@ -53,7 +53,7 @@ while(<$kh>) { ok !defined &{"CORE::$word"}, "no CORE::$word"; } else { - $tests += 4; + $tests += 2; ok defined &{"CORE::$word"}, "defined &{'CORE::$word'}"; @@ -65,23 +65,8 @@ while(<$kh>) { 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; @@ -130,6 +115,24 @@ while(<$kh>) { } } +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 } @@ -153,6 +156,21 @@ $tests++; ok eval { *CORE::exit = \42 }, '[rt.cpan.org #74289] *CORE::foo is not accidentally made read-only'; +for my $word (qw) { + # 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; + @UNIVERSAL::ISA = CORE; is "just another "->ucfirst . "perl hacker,\n"->ucfirst, "Just another Perl hacker,\n", 'coresubs do not return TARG'; diff --git a/t/op/hexfp.t b/t/op/hexfp.t new file mode 100644 index 0000000..9a1d045 --- /dev/null +++ b/t/op/hexfp.t @@ -0,0 +1,180 @@ +#!./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. diff --git a/t/op/require_override.t b/t/op/require_override.t new file mode 100644 index 0000000..7f9ee65 --- /dev/null +++ b/t/op/require_override.t @@ -0,0 +1,59 @@ +#!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"); + + + diff --git a/t/op/sprintf.t b/t/op/sprintf.t index 4c41b16..74bf130 100644 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -179,7 +179,7 @@ __END__ >%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< @@ -213,7 +213,7 @@ __END__ >%#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< diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index 6fd0bde..0969d58 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -12,7 +12,240 @@ BEGIN { 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; @@ -336,3 +569,10 @@ is $o::count, '1', 'sprinf %1s overload count'; $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'"); +} diff --git a/t/op/stat.t b/t/op/stat.t index 2f34f6e..2c28e1e 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -472,10 +472,13 @@ like $@, qr/^The stat preceding lstat\(\) wasn't an lstat at /, '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: { diff --git a/t/op/sub.t b/t/op/sub.t index 7df8f49..1861623 100644 --- a/t/op/sub.t +++ b/t/op/sub.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan( tests => 33 ); +plan( tests => 34 ); sub empty_sub {} @@ -222,3 +222,10 @@ ok !exists $INC{"re.pm"}, 're.pm not loaded yet'; 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"); diff --git a/t/op/taint.t b/t/op/taint.t index 149a83c..607402c 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -182,7 +182,9 @@ my $TEST = 'TEST'; 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: { diff --git a/t/op/universal.t b/t/op/universal.t index 50d1782..494bc99 100644 --- a/t/op/universal.t +++ b/t/op/universal.t @@ -10,7 +10,7 @@ BEGIN { require "./test.pl"; } -plan tests => 144; +plan tests => 143; $a = {}; bless $a, "Bob"; @@ -137,12 +137,10 @@ ok ! (eval { aversion->VERSION(2.719) }); 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"); @@ -178,16 +176,6 @@ ok ! $a->can("export_tags"); # a method in Exporter 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"); @@ -274,11 +262,15 @@ use warnings "deprecated"; 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"); } diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 47d977b..a8ee6ec 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -16,5 +16,5 @@ autodie cpan/autodie/t/utf8_open.t 5295851351c49f939008c5aca6a798742b1e503d 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 diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 7908d30..5388389 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -285,7 +285,7 @@ pod/perltru64.pod ? Should you be using F<...> or maybe L<...> instead of 1 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 diff --git a/t/porting/libperl.t b/t/porting/libperl.t index 8f1dc05..f62b80d 100644 --- a/t/porting/libperl.t +++ b/t/porting/libperl.t @@ -206,7 +206,7 @@ sub nm_parse_gnu { # 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 @@ -412,55 +412,125 @@ if ($GSP) { 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)"); } } diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index 82f0917..986eb87 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -2346,6 +2346,12 @@ EOP 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 # diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index 1ad18a6..2c54cc3 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -96,6 +96,8 @@ my @death = '/(?(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/(?{#}/', diff --git a/t/re/reg_posixcc.t b/t/re/reg_posixcc.t index 7473eea..0d66f5b 100644 --- a/t/re/reg_posixcc.t +++ b/t/re/reg_posixcc.t @@ -85,7 +85,7 @@ while (@pats) { 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') { diff --git a/t/re/subst.t b/t/re/subst.t index 85fe5d6..b85ff3b 100644 --- a/t/re/subst.t +++ b/t/re/subst.t @@ -1036,7 +1036,9 @@ SKIP: { 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; diff --git a/t/run/locale.t b/t/run/locale.t index 47bd1a3..1aaeb0f 100644 --- a/t/run/locale.t +++ b/t/run/locale.t @@ -52,7 +52,9 @@ fresh_perl_is("for (qw(@locales)) {\n" . <<'EOF', 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 diff --git a/t/run/switchC.t b/t/run/switchC.t index b1a243c..f6aa868 100644 --- a/t/run/switchC.t +++ b/t/run/switchC.t @@ -18,7 +18,7 @@ my $r; 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)', diff --git a/t/uni/universal.t b/t/uni/universal.t index 626c30f..c999dd8 100644 --- a/t/uni/universal.t +++ b/t/uni/universal.t @@ -13,7 +13,7 @@ BEGIN { use utf8; use open qw( :utf8 :std ); -plan tests => 93; +plan tests => 90; $a = {}; bless $a, "Bòb"; @@ -117,16 +117,6 @@ cmp_ok UNIVERSAL::can(Àlìcè => "can"), '==', \&UNIVERSAL::can; 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 } diff --git a/taint.c b/taint.c index a5194f4..60a9a54 100644 --- a/taint.c +++ b/taint.c @@ -27,8 +27,6 @@ void Perl_taint_proper(pTHX_ const char *f, const char *const s) { #if defined(HAS_SETEUID) && defined(DEBUGGING) - dVAR; - PERL_ARGS_ASSERT_TAINT_PROPER; { diff --git a/toke.c b/toke.c index 2842115..0f0641f 100644 --- a/toke.c +++ b/toke.c @@ -378,8 +378,6 @@ static struct debug_tokens { STATIC int S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp) { - dVAR; - PERL_ARGS_ASSERT_TOKEREPORT; if (DEBUG_T_TEST) { @@ -1686,7 +1684,7 @@ S_incline(pTHX_ const char *s) 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; @@ -4156,7 +4154,8 @@ S_tokenize_use(pTHX_ int is_use, char *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 @@ -5451,6 +5450,11 @@ Perl_yylex(pTHX) 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) @@ -6636,7 +6640,9 @@ Perl_yylex(pTHX) 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. */ @@ -9374,8 +9380,6 @@ intro_sym: 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; } @@ -9800,6 +9804,27 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) 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; @@ -9924,6 +9949,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (!overflowed) { x = u << shift; /* make room for the digit */ + total_bits += shift; + if ((x >> shift) != u && !(PL_hints & HINT_NEW_BINARY)) { overflowed = TRUE; @@ -9946,6 +9973,20 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) * 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; } } @@ -9960,6 +10001,96 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) 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), @@ -9993,10 +10124,17 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) 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 */ @@ -10036,7 +10174,9 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* 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); @@ -10062,12 +10202,23 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } /* 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 == '_') { @@ -10131,9 +10282,22 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) 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 diff --git a/uconfig.h b/uconfig.h index b5648d4..a1aa34f 100644 --- a/uconfig.h +++ b/uconfig.h @@ -1900,9 +1900,30 @@ * 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: @@ -3561,6 +3582,13 @@ */ /*#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. @@ -4742,6 +4770,6 @@ #endif /* Generated from: - * 727eb338c23fdd320f556ca32fd7eb5473f68b6ce74db8cec7d83399a2621346 config_h.SH - * 4b709c0b049c660c04c0932eaa8481f9ca6fdc697ec4ffaa86b7bef21ee886a8 uconfig.sh + * 5f68e17a9d9e989b824daf55d2adcad3b7af2becfa8f627c6cb1d0e376f7e1a5 config_h.SH + * 98397a7d818a024628d6b34e5903a8f408da96601a2a19471c480511f3c8d914 uconfig.sh * ex: set ro: */ diff --git a/uconfig.sh b/uconfig.sh index e8df3c2..15fd327 100644 --- a/uconfig.sh +++ b/uconfig.sh @@ -239,6 +239,7 @@ d_isnanl='undef' d_killpg='undef' d_lchown='undef' d_ldbl_dig='undef' +d_ldexpl='undef' d_libm_lib_version='undef' d_link='undef' d_localtime64='undef' @@ -648,6 +649,7 @@ ivtype='long' ld_can_script='define' lib_ext='.a' localtime_r_proto='0' +longdblkind=0 longdblsize=8 longlongsize=8 longsize='4' diff --git a/uconfig64.sh b/uconfig64.sh index a4adccb..06537c3 100644 --- a/uconfig64.sh +++ b/uconfig64.sh @@ -240,6 +240,7 @@ d_isnanl='undef' d_killpg='undef' d_lchown='undef' d_ldbl_dig='undef' +d_ldexpl='undef' d_libm_lib_version='undef' d_link='undef' d_localtime64='undef' @@ -648,6 +649,7 @@ ivsize='8' ivtype='long' lib_ext='.a' localtime_r_proto='0' +longdblkind=0 longdblsize=8 longlongsize=8 longsize='8' diff --git a/utf8.c b/utf8.c index 279d96f..bfde692 100644 --- a/utf8.c +++ b/utf8.c @@ -1495,8 +1495,10 @@ S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp) *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; } } @@ -3481,22 +3483,24 @@ Perl__swash_to_invlist(pTHX_ SV* const swash) 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--; @@ -3505,8 +3509,9 @@ Perl__swash_to_invlist(pTHX_ SV* const swash) 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; } } } diff --git a/util.c b/util.c index 4b48e62..98b121f 100644 --- a/util.c +++ b/util.c @@ -1380,7 +1380,7 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume) 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); } } @@ -2072,7 +2072,11 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) 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); @@ -4381,9 +4385,9 @@ Perl_parse_unicode_opts(pTHX_ const char **popt) 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 @@ -4698,7 +4702,7 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp) * 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 @@ -4766,7 +4770,8 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, * 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; @@ -5695,12 +5700,12 @@ static void atos_update(atos_context* ctx, /* 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 @@ -5710,11 +5715,14 @@ static const char* atos_parse(const char* p, * 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)) @@ -5735,7 +5743,9 @@ static const char* atos_parse(const char* 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; } diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 6ec85c0..5149458 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -307,7 +307,7 @@ utils : $(utils1) $(utils2) $(utils3) $(utils4) $(utils5) 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) diff --git a/vms/vms.c b/vms/vms.c index 4e37b6c..75e4cce 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -1033,9 +1033,14 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, } } 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); @@ -1077,7 +1082,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys) 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; @@ -1127,7 +1132,6 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys) if (sys) { /* Impose security constraints only if tainting */ secure = PL_curinterp ? TAINTING_get : will_taint; - saverr = errno; savvmserr = vaxc$errno; } else { secure = 0; @@ -1159,10 +1163,6 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys) 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; } @@ -1179,7 +1179,7 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) 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; @@ -1226,7 +1226,6 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) if (sys) { /* Impose security constraints only if tainting */ secure = PL_curinterp ? TAINTING_get : will_taint; - saverr = errno; savvmserr = vaxc$errno; } else { secure = 0; @@ -1264,10 +1263,6 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) } } - /* 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; } @@ -13930,7 +13925,7 @@ set_feature_default(const char *name, int value) */ 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; @@ -13983,7 +13978,7 @@ vmsperl_set_features(void) /* 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; @@ -13994,7 +13989,7 @@ vmsperl_set_features(void) /* 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; @@ -14014,7 +14009,7 @@ vmsperl_set_features(void) /* 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; @@ -14026,7 +14021,7 @@ vmsperl_set_features(void) /* 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; @@ -14036,9 +14031,8 @@ vmsperl_set_features(void) /* 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; @@ -14050,7 +14044,7 @@ vmsperl_set_features(void) /* 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); @@ -14058,6 +14052,9 @@ vmsperl_set_features(void) 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); @@ -14070,7 +14067,7 @@ vmsperl_set_features(void) /* 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; @@ -14151,7 +14148,7 @@ vmsperl_set_features(void) #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; @@ -14160,7 +14157,7 @@ vmsperl_set_features(void) #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; @@ -14169,14 +14166,14 @@ vmsperl_set_features(void) #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; @@ -14184,14 +14181,14 @@ vmsperl_set_features(void) } } 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; @@ -14217,9 +14214,8 @@ vmsperl_set_features(void) /* 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; diff --git a/vutil.c b/vutil.c index b687103..20fb522 100644 --- a/vutil.c +++ b/vutil.c @@ -591,6 +591,37 @@ VER_NV: 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) { @@ -604,6 +635,7 @@ VER_NV: } 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); diff --git a/win32/Makefile b/win32/Makefile index 3b0c701..27d0d05 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -37,7 +37,7 @@ INST_TOP = $(INST_DRV)\perl # 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 @@ -1155,7 +1155,7 @@ utils: $(PERLEXE) ..\utils\Makefile 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 .. @@ -1250,7 +1250,7 @@ distclean: realclean -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 \ diff --git a/win32/config.ce b/win32/config.ce index 0601162..78254ee 100644 --- a/win32/config.ce +++ b/win32/config.ce @@ -287,6 +287,7 @@ d_isnanl='undef' d_killpg='undef' d_lchown='undef' d_ldbl_dig='define' +d_ldexpl='undef' d_libm_lib_version='undef' d_link='define' d_localtime64='undef' @@ -761,6 +762,7 @@ lns='copy' 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' diff --git a/win32/config.gc b/win32/config.gc index 11b490e..94e3596 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -287,6 +287,7 @@ d_isnanl='undef' d_killpg='define' d_lchown='undef' d_ldbl_dig='define' +d_ldexpl='undef' d_libm_lib_version='undef' d_link='define' d_localtime64='undef' @@ -788,6 +789,7 @@ lns='copy' 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' diff --git a/win32/config.vc b/win32/config.vc index d4b0b83..a4ef314 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -287,6 +287,7 @@ d_isnanl='undef' d_killpg='define' d_lchown='undef' d_ldbl_dig='define' +d_ldexpl='undef' d_libm_lib_version='undef' d_link='define' d_localtime64='undef' @@ -787,6 +788,7 @@ lns='copy' 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' diff --git a/win32/config_sh.PL b/win32/config_sh.PL index 7553b59..985c99a 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -121,7 +121,7 @@ if ($opt{cc} =~ /\b(?:cl|icl)/) { } elsif ($opt{cc} =~ /\bgcc\b/) { $int64 = 'long long'; - $int64f = 'll'; + $int64f = 'I64'; } # set large files options diff --git a/win32/makefile.mk b/win32/makefile.mk index d376a8c..2f3ad01 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -43,7 +43,7 @@ INST_TOP *= $(INST_DRV)\perl # 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 @@ -1349,7 +1349,7 @@ utils: $(PERLEXE) ..\utils\Makefile 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 .. @@ -1443,7 +1443,7 @@ distclean: realclean -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 \ diff --git a/win32/pod.mak b/win32/pod.mak index ed33b2e..810a5f7 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -39,6 +39,7 @@ POD = perl.pod \ perl5210delta.pod \ perl5211delta.pod \ perl5212delta.pod \ + perl5213delta.pod \ perl561delta.pod \ perl56delta.pod \ perl581delta.pod \ @@ -171,6 +172,7 @@ MAN = perl.man \ perl5210delta.man \ perl5211delta.man \ perl5212delta.man \ + perl5213delta.man \ perl561delta.man \ perl56delta.man \ perl581delta.man \ @@ -303,6 +305,7 @@ HTML = perl.html \ perl5210delta.html \ perl5211delta.html \ perl5212delta.html \ + perl5213delta.html \ perl561delta.html \ perl56delta.html \ perl581delta.html \ @@ -435,6 +438,7 @@ TEX = perl.tex \ perl5210delta.tex \ perl5211delta.tex \ perl5212delta.tex \ + perl5213delta.tex \ perl561delta.tex \ perl56delta.tex \ perl581delta.tex \ diff --git a/write_buildcustomize.pl b/write_buildcustomize.pl index cf429a9..ccef6ea 100644 --- a/write_buildcustomize.pl +++ b/write_buildcustomize.pl @@ -28,10 +28,10 @@ if ( @ARGV ) { 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 -- 2.7.4