diff options
author | Steve Peters <steve@fisharerojo.org> | 2010-08-27 07:40:51 -0500 |
---|---|---|
committer | Steve Peters <steve@fisharerojo.org> | 2010-08-27 07:40:51 -0500 |
commit | ccfef76d964c8b719db5c7fd06ce897a3eb64c01 (patch) | |
tree | 55c0c46907bad5d731ccedf8c23fd0fc9b469f9b | |
parent | 96d4712d196873edf70f7db79a4665f04f8116c2 (diff) | |
parent | 749b93721350107cd0209779c73646203f730aa0 (diff) | |
download | perl-ccfef76d964c8b719db5c7fd06ce897a3eb64c01.tar.gz |
Merge branch 'blead' of ssh://stevep@perl5.git.perl.org/perl into blead
92 files changed, 2716 insertions, 453 deletions
diff --git a/.gitignore b/.gitignore index 1d23594ed1..7646702ee5 100644 --- a/.gitignore +++ b/.gitignore @@ -126,5 +126,7 @@ veryclean.sh U MANIFEST.new -# ignore vim swap files +# ignore editor droppings *.swp +*~ +.#* @@ -38,6 +38,7 @@ Alan Ferrency <alan@pair.com> Albert Chin-A-Young <china@thewrittenword.com> Albert Dvornik <bert@alum.mit.edu> Alessandro Forghieri <alf@orion.it> +Alexander Alekseev <alex@alemate.ru> Alexei Alexandrov <alexei.alexandrov@gmail.com> Alex Davies <adavies@ptc.com> Alex Gough <alex@rcon.org> @@ -990,6 +990,7 @@ cpan/ExtUtils-MakeMaker/t/MM_VMS.t See if ExtUtils::MM_VMS works cpan/ExtUtils-MakeMaker/t/MM_Win32.t See if ExtUtils::MM_Win32 works cpan/ExtUtils-MakeMaker/TODO Things TODO in MakeMaker cpan/ExtUtils-MakeMaker/t/oneliner.t See if MM can generate perl one-liners +cpan/ExtUtils-MakeMaker/t/parse_abstract.t See if parse_abstract works cpan/ExtUtils-MakeMaker/t/parse_version.t See if parse_version works cpan/ExtUtils-MakeMaker/t/PL_FILES.t Test PL_FILES in MakeMaker cpan/ExtUtils-MakeMaker/t/pm.t See if MakeMaker can handle PM @@ -2479,15 +2480,21 @@ cpan/Time-Piece/t/07arith.t Test for Time::Piece cpan/Unicode-Collate/Changes Unicode::Collate cpan/Unicode-Collate/Collate/allkeys.txt Unicode::Collate cpan/Unicode-Collate/Collate/keys.txt Unicode::Collate +cpan/Unicode-Collate/Collate/Locale/ca.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/cs.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/eo.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/es.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/es_trad.pl Unicode::Collate +cpan/Unicode-Collate/Collate/Locale/et.pl Unicode::Collate +cpan/Unicode-Collate/Collate/Locale/fi.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/fr.pl Unicode::Collate +cpan/Unicode-Collate/Collate/Locale/lv.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/nn.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/pl.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale.pm Unicode::Collate cpan/Unicode-Collate/Collate/Locale/ro.pl Unicode::Collate +cpan/Unicode-Collate/Collate/Locale/sk.pl Unicode::Collate +cpan/Unicode-Collate/Collate/Locale/sl.pl Unicode::Collate cpan/Unicode-Collate/Collate/Locale/sv.pl Unicode::Collate cpan/Unicode-Collate/Collate.pm Unicode::Collate cpan/Unicode-Collate/README Unicode::Collate @@ -2501,15 +2508,21 @@ cpan/Unicode-Collate/t/ignor.t Unicode::Collate cpan/Unicode-Collate/t/illegalp.t Unicode::Collate cpan/Unicode-Collate/t/illegal.t Unicode::Collate cpan/Unicode-Collate/t/index.t Unicode::Collate +cpan/Unicode-Collate/t/loc_ca.t Unicode::Collate cpan/Unicode-Collate/t/loc_cs.t Unicode::Collate cpan/Unicode-Collate/t/loc_eo.t Unicode::Collate cpan/Unicode-Collate/t/loc_es.t Unicode::Collate cpan/Unicode-Collate/t/loc_estr.t Unicode::Collate +cpan/Unicode-Collate/t/loc_et.t Unicode::Collate +cpan/Unicode-Collate/t/loc_fi.t Unicode::Collate cpan/Unicode-Collate/t/loc_fr.t Unicode::Collate +cpan/Unicode-Collate/t/loc_lv.t Unicode::Collate cpan/Unicode-Collate/t/loc_nb.t Unicode::Collate cpan/Unicode-Collate/t/loc_nn.t Unicode::Collate cpan/Unicode-Collate/t/loc_pl.t Unicode::Collate cpan/Unicode-Collate/t/loc_ro.t Unicode::Collate +cpan/Unicode-Collate/t/loc_sk.t Unicode::Collate +cpan/Unicode-Collate/t/loc_sl.t Unicode::Collate cpan/Unicode-Collate/t/loc_sv.t Unicode::Collate cpan/Unicode-Collate/t/loc_test.t Unicode::Collate cpan/Unicode-Collate/t/normal.t Unicode::Collate @@ -3590,6 +3603,7 @@ lib/perl5db/t/proxy-constants Tests for the Perl debugger lib/perl5db/t/rt-61222 Tests for the Perl debugger lib/perl5db/t/rt-66110 Tests for the Perl debugger lib/perl5db/t/symbol-table-bug Tests for the Perl debugger +lib/perl5db/t/taint Tests for the Perl debugger lib/PerlIO.pm PerlIO support module lib/Pod/Functions.pm used by pod/splitpod lib/Pod/Html.pm Convert POD data to HTML diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 1b4456f10b..145fe804f8 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -581,7 +581,7 @@ use File::Glob qw(:case); 'ExtUtils::MakeMaker' => { 'MAINTAINER' => 'mschwern', - 'DISTRIBUTION' => 'MSCHWERN/ExtUtils-MakeMaker-6.56.tar.gz', + 'DISTRIBUTION' => 'MSCHWERN/ExtUtils-MakeMaker-6.57_01.tar.gz', 'FILES' => q[cpan/ExtUtils-MakeMaker], 'EXCLUDED' => [ qr{^t/lib/Test/}, qr{^inc/ExtUtils/}, @@ -1506,7 +1506,7 @@ use File::Glob qw(:case); 'Unicode::Collate' => { 'MAINTAINER' => 'sadahiro', - 'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-0.56-withoutworldwriteables.tar.gz', + 'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-0.57-withoutworldwriteables.tar.gz', 'FILES' => q[cpan/Unicode-Collate], # ignore experimental XS version 'EXCLUDED' => [ qr{X$}, diff --git a/Porting/checkcfgvar.pl b/Porting/checkcfgvar.pl index a757d6bfd8..0ee7ddbf76 100755 --- a/Porting/checkcfgvar.pl +++ b/Porting/checkcfgvar.pl @@ -30,6 +30,8 @@ my @CFG = ( "vos/config.ga.def", "win32/config.bc", "win32/config.gc", + "win32/config.gc64", + "win32/config.gc64nox", "win32/config.vc", "win32/config.vc64", "win32/config.ce", diff --git a/README.aix b/README.aix index 5223625f5d..dfcf0c6778 100644 --- a/README.aix +++ b/README.aix @@ -4,7 +4,7 @@ designed to be readable as is. =head1 NAME -README.aix - Perl version 5.13.4 on IBM AIX (UNIX) systems +README.aix - Perl version 5 on IBM AIX (UNIX) systems =head1 DESCRIPTION diff --git a/autodoc.pl b/autodoc.pl index 91963ca5ac..c271bf434d 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -183,14 +183,25 @@ _EOH_ if (@$missing) { print $fh "\n=head1 Undocumented functions\n\n"; - print $fh "These functions are currently undocumented:\n\n=over\n\n"; - for my $missing (sort @$missing) { - print $fh "=item $missing\nX<$missing>\n\n"; - } - print $fh "=back\n\n"; + print $fh <<'_EOB_'; +The following functions have been flagged as part of the public API, +but are currently undocumented. Use them at your own risk, as the +interfaces are subject to change. + +If you use one of them, you may wish to consider creating and submitting +documentation for it. If your patch is accepted, this will indicate that +the interface is stable (unless it is explicitly marked otherwise). + +=over + +_EOB_ + for my $missing (sort @$missing) { + print $fh "=item $missing\nX<$missing>\n\n"; } + print $fh "=back\n\n"; +} - print $fh $footer, <<'_EOF_'; +print $fh $footer, <<'_EOF_'; =cut ex: set ro: @@ -276,10 +287,12 @@ X<Perl API> X<API> X<api> This file contains the documentation of the perl public API generated by embed.pl, specifically a listing of functions, macros, flags, and variables -that may be used by extension writers. The interfaces of any functions that -are not listed here are subject to change without notice. For this reason, -blindly using functions listed in proto.h is to be avoided when writing -extensions. +that may be used by extension writers. L<At the end|/Undocumented functions> +is a list of functions which have yet to be documented. The interfaces of +those are subject to change without notice. Any functions not listed here are +not part of the public API, and should not be used by extension writers at +all. For these reasons, blindly using functions listed in proto.h is to be +avoided when writing extensions. Note that all Perl API global variables must be referenced with the C<PL_> prefix. Some macros are provided for compatibility with the older, @@ -215,11 +215,11 @@ sub import { return; } -die "Perl lib version (%s) doesn't match executable version ($])" +die "Perl lib version (%s) doesn't match executable '$0' version ($])" unless $^V; $^V eq %s - or die "Perl lib version (%s) doesn't match executable version (" . + or die "Perl lib version (%s) doesn't match executable '$0' version (" . sprintf("v%%vd",$^V) . ")"; ENDOFBEG diff --git a/cpan/ExtUtils-MakeMaker/Changes b/cpan/ExtUtils-MakeMaker/Changes index a517482bc8..fff588d4f6 100644 --- a/cpan/ExtUtils-MakeMaker/Changes +++ b/cpan/ExtUtils-MakeMaker/Changes @@ -1,3 +1,21 @@ +6.57_01 Tue Aug 24 01:36:20 PDT 2010 + Improvements + * parse_abstract() is more robust supporting "Package.pm" and multiple + dashes and spaces. [rt.perl.org 74438] + + Bug Fixes + * Recognize .so files in AIX. [rt.cpan.org 41360] (Jens Rehsack) + * Remove manual image-base generation on Win32/gcc [rt.cpan.org 47138] + (Yasuhiro Matsumoto) + * Use the bundled versions of our dependencies if they're not installed. + * Eliminate use of foreach qw() which will be deprecated in 5.14. + [rt.cpan.org 57124] (Zefram) + + Test Fixes + * Guard against old versions of YAML::Tiny that worked differently. + [rt.cpan.org 55500] + + 6.56 Thu Dec 17 14:02:14 PST 2009 * Stable release of 6.55_03 diff --git a/cpan/ExtUtils-MakeMaker/MANIFEST b/cpan/ExtUtils-MakeMaker/MANIFEST index b242cc55f6..93e77bcd8f 100644 --- a/cpan/ExtUtils-MakeMaker/MANIFEST +++ b/cpan/ExtUtils-MakeMaker/MANIFEST @@ -7,6 +7,7 @@ inc/ExtUtils/Installed.pm inc/ExtUtils/Manifest.pm inc/ExtUtils/MANIFEST.SKIP inc/ExtUtils/Packlist.pm +INSTALL lib/ExtUtils/Command/MM.pm lib/ExtUtils/Liblist.pm lib/ExtUtils/Liblist/Kid.pm @@ -91,6 +92,7 @@ t/MM_Unix.t t/MM_VMS.t t/MM_Win32.t t/oneliner.t +t/parse_abstract.t t/parse_version.t t/PL_FILES.t t/pm.t @@ -115,3 +117,4 @@ t/writemakefile_args.t t/xs.t TODO META.yml Module meta-data (added by MakeMaker) +SIGNATURE Public-key signature (added by MakeMaker) diff --git a/cpan/ExtUtils-MakeMaker/README b/cpan/ExtUtils-MakeMaker/README index 9586c0ba17..8629a53cbe 100644 --- a/cpan/ExtUtils-MakeMaker/README +++ b/cpan/ExtUtils-MakeMaker/README @@ -1,57 +1,11 @@ This is a CPAN distribution of the venerable MakeMaker module. It has been -backported to work with Perl 5.005_03 and up. +backported to work with Perl 5.6.0 and up. -If you do not have a make program, several can be found... - -Most Unixen: The make utility which comes with your operating system -should work fine. If you don't have one, GNU make is recommended, -most others (Sun, BSD, etc...) will work fine as well. -http://www.gnu.org/software/make/make.html GNU make - -Windows: nmake or dmake will work. GNU make will *not*. -ftp://ftp.microsoft.com/Softlib/MSLFILES/nmake15.exe nmake -http://search.cpan.org/dist/dmake/ dmake - -VMS: MMS or the free MadGoat MaKe utility (MMK) will work. -http://www.madgoat.com/mmk.html MMK - -If all else fails there is a pure Perl version of make available on -CPAN which should work on most Unixen. -http://search.cpan.org/author/NI-S/Make-1.00/ pmake - - -PLEASE NOTE: This distribution does not include the xsubpp or typemap -programs. They are extremely specific to your version or Perl, so -MakeMaker will simply use the one which came with your copy of Perl. -Do not delete your old ExtUtils/ directory. An upgraded version of xsubpp -can be found in the ExtUtils::ParseXS module. - -Known Good Systems: - -Every stable MakeMaker release is tested at least on: - -MacOS X -Linux/x86 -ActivePerl on Windows -Cygwin -OpenVMS - -Covering the major portability flavors MakeMaker has to cover. -(I'm always on the lookout for DJGPP, Solaris, *BSD and OS/2 users) - - -Known Problems: - -(See http://rt.cpan.org for a full list of open problems.) - -Windows will likely be broken if Perl is installed in C:\Program Files or -other prefix with a space in the name. - -Using the MMS utility on VMS causes lots of extra newlines. Unknown -why this is so, might be a bug in MMS. Problem not seen with MMK. - -GNU make does not work with MakeMaker on Windows. +See INSTALL for installation instrucitons. Run "perldoc +ExtUtils::MakeMaker" (while in this source directory before +installation) for more documentation. +See http://rt.cpan.org for a full list of open problems. Please report any bugs via http://rt.cpan.org. Send questions and discussion to makemaker@perl.org diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm index f9b474de16..0d23c24edc 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm @@ -10,7 +10,7 @@ our @ISA = qw(Exporter); our @EXPORT = qw(test_harness pod2man perllocal_install uninstall warn_if_old_packlist); -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm index ea4dac4ae7..b21fc01a59 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm @@ -2,7 +2,7 @@ package ExtUtils::Liblist; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; use File::Spec; require ExtUtils::Liblist::Kid; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm index b807e97cc8..a434a0f1d0 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm @@ -9,7 +9,7 @@ use 5.006; # Broken out of MakeMaker from version 4.11 use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_01; use Config; use Cwd 'cwd'; @@ -39,6 +39,7 @@ sub _unix_os2_ext { my($so) = $Config{so}; my($libs) = defined $Config{perllibs} ? $Config{perllibs} : $Config{libs}; my $Config_libext = $Config{lib_ext} || ".a"; + my $Config_dlext = $Config{dlext}; # compute $extralibs, $bsloadlibs and $ldloadlibs from @@ -130,8 +131,10 @@ sub _unix_os2_ext { && ($Config{'archname'} !~ /RM\d\d\d-svr4/) && ($thislib .= "_s") ){ # we must explicitly use _s version } elsif (-f ($fullname="$thispth/lib$thislib$Config_libext")){ + } elsif (defined($Config_dlext) + && -f ($fullname="$thispth/lib$thislib.$Config_dlext")){ } elsif (-f ($fullname="$thispth/$thislib$Config_libext")){ - } elsif (-f ($fullname="$thispth/lib$thislib.dll$Config_libext")){ + } elsif (-f ($fullname="$thispth/lib$thislib.dll$Config_libext")){ } elsif (-f ($fullname="$thispth/Slib$thislib$Config_libext")){ } elsif ($^O eq 'dgux' && -l ($fullname="$thispth/lib$thislib$Config_libext") diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm index eac5f48349..d39118cd59 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm @@ -3,7 +3,7 @@ package ExtUtils::MM; use strict; use ExtUtils::MakeMaker::Config; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::Liblist; require ExtUtils::MakeMaker; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm index 5179be4bc2..8490f2fcf2 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_AIX; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm index 4905aebc64..a94ab43717 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_Any; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; use Carp; use File::Spec; @@ -984,7 +984,7 @@ sub _dump_hash { ); if (exists $customs->{$key}) { my %k_custom = %{$customs->{$key}}; - foreach my $k qw(key_sort max_key_length customs) { + foreach my $k (qw(key_sort max_key_length customs)) { $k_options{$k} = $k_custom{$k} if exists $k_custom{$k}; } } diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm index 0b7c8db922..1c1eb4f2ba 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm @@ -26,7 +26,7 @@ require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; =item os_flavor diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm index 394fbc68a7..7bee0b938d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm @@ -9,7 +9,7 @@ require ExtUtils::MM_Unix; require ExtUtils::MM_Win32; our @ISA = qw( ExtUtils::MM_Unix ); -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; =head1 NAME diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm index fc0a794723..0c50626098 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_DOS; use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_01; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm index 1cb87c7881..d74cbe353d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm @@ -7,7 +7,7 @@ BEGIN { our @ISA = qw( ExtUtils::MM_Unix ); } -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; =head1 NAME diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm index cfc82051e1..b19d037561 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_MacOS; use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_01; sub new { die <<'UNSUPPORTED'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm index 0c8f6c0aff..5f06e201f7 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm @@ -22,7 +22,7 @@ use strict; use ExtUtils::MakeMaker::Config; use File::Basename; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm index 680502baf2..dc0390caa0 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm @@ -5,7 +5,7 @@ use strict; use ExtUtils::MakeMaker qw(neatvalue); use File::Spec; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm index f78d5e8a9e..0650b3c6fb 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_QNX; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm index 5adc46ea8d..62bc1e0f97 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_UWIN; use strict; -our $VERSION = 6.56; +our $VERSION = 6.57_01; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm index 3d059be11f..0719988ee7 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm @@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); -$VERSION = '6.5601'; +$VERSION = '6.57_01'; require ExtUtils::MM_Any; our @ISA = qw(ExtUtils::MM_Any); @@ -2593,7 +2593,7 @@ sub parse_abstract { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if !$inpod; chop; - next unless /^($package(?:\.pm)?\s+\-+\s+)(.*)/; + next unless /^($package(?:\.pm)? \s+ -+ \s+)(.*)/x; $result = $2; last; } @@ -2634,7 +2634,7 @@ sub parse_version { $inpod = /^=(?!cut)/ ? 1 : /^=cut/ ? 0 : $inpod; next if $inpod || /^\s*#/; chop; - next if /^\s*(if|unless)/; + next if /^\s*(if|unless|elsif)/; if ( m{^ \s* package \s+ \w[\w\:\']* \s+ (v?[0-9._]+) \s* ; }x ) { local $^W = 0; $result = $1; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm index 2066d03597..34b74d2ad3 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm @@ -15,7 +15,7 @@ BEGIN { use File::Basename; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm index 1814a1dae4..ad86cc8a88 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm @@ -1,7 +1,7 @@ package ExtUtils::MM_VOS; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::MM_Unix; our @ISA = qw(ExtUtils::MM_Unix); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm index 19e462de59..c41075adbb 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm @@ -27,7 +27,7 @@ use ExtUtils::MakeMaker qw( neatvalue ); require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; $ENV{EMXSHELL} = 'sh'; # to run `commands` @@ -289,17 +289,6 @@ sub dynamic_lib { my($ldfrom) = '$(LDFROM)'; my(@m); -# one thing for GCC/Mingw32: -# we try to overcome non-relocateable-DLL problems by generating -# a (hopefully unique) image-base from the dll's name -# -- BKS, 10-19-1999 - if ($GCC) { - my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT}; - $dllname =~ /(....)(.{0,4})/; - my $baseaddr = unpack("n", $1 ^ $2); - $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr); - } - push(@m,' # This section creates the dynamically loadable $(INST_DYNAMIC) # from $(OBJECT) and possibly $(MYEXTLIB). diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm index c47147695e..1cc0f12ec4 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_Win95; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require ExtUtils::MM_Win32; our @ISA = qw(ExtUtils::MM_Win32); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm index bed177d210..4a0b61fbb6 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm @@ -3,7 +3,7 @@ package ExtUtils::MY; use strict; require ExtUtils::MM; -our $VERSION = 6.56; +our $VERSION = 6.57_01; our @ISA = qw(ExtUtils::MM); { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm index 95a075219a..7ab26e0b04 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm @@ -18,7 +18,7 @@ our @Overridable; my @Prepend_parent; my %Recognized_Att_Keys; -our $VERSION = '6.5601'; +our $VERSION = '6.57_01'; # Emulate something resembling CVS $Revision$ (our $Revision = $VERSION) =~ s{_}{}; @@ -1000,10 +1000,12 @@ sub flush { or die "Unable to open MakeMaker.tmp: $!"; for my $chunk (@{$self->{RESULT}}) { - print $fh "$chunk\n"; + print $fh "$chunk\n" + or die "Can't write to MakeMaker.tmp: $!"; } - close $fh; + close $fh + or die "Can't write to MakeMaker.tmp: $!"; _rename("MakeMaker.tmp", $finalname) or warn "rename MakeMaker.tmp => $finalname: $!"; chmod 0644, $finalname unless $Is_VMS; @@ -1468,7 +1470,8 @@ the first line in the "=head1 NAME" section. $2 becomes the abstract. =item AUTHOR String containing name (and email address) of package author(s). Is used -in PPD (Perl Package Description) files for PPM (Perl Package Manager). +in META.yml and PPD (Perl Package Description) files for PPM (Perl +Package Manager). =item BINARY_LOCATION @@ -1942,7 +1945,7 @@ may hold a name for that binary. Defaults to perl A hashrefs of items to add to the F<META.yml>. They differ in how they behave if they have the same key as the -default metadata. META_ADD will override the default value with it's +default metadata. META_ADD will override the default value with its own. META_MERGE will merge its value with the default. Unless you want to override the defaults, prefer META_MERGE so as to @@ -2227,18 +2230,17 @@ will C<die> instead of simply informing the user of the missing dependencies. It is I<extremely> rare to have to use C<PREREQ_FATAL>. Its use by module authors is I<strongly discouraged> and should never be used lightly. + Module installation tools have ways of resolving umet dependencies but to do that they need a F<Makefile>. Using C<PREREQ_FATAL> breaks this. That's bad. -The only situation where it is appropriate is when you have -dependencies that are indispensible to actually I<write> a -F<Makefile>. For example, MakeMaker's F<Makefile.PL> needs L<File::Spec>. -If its not available it cannot write the F<Makefile>. +Assuming you have good test coverage, your tests should fail with +missing dependencies informing the user more strongly that something +is wrong. You can write a F<t/00compile.t> test which will simply +check that your code compiles and stop "make test" prematurely if it +doesn't. See L<Test::More/BAIL_OUT> for more details. -Note: see L<Test::Harness> for a shortcut for stopping tests early -if you are missing dependencies and are afraid that users might -use your module with an incomplete environment. =item PREREQ_PM @@ -2798,6 +2800,8 @@ generated Makefile along with your report. For more up-to-date information, see L<http://www.makemaker.org>. +Repository available at L<http://github.com/schwern/extutils-makemaker>. + =head1 LICENSE This program is free software; you can redistribute it and/or diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm index 38b60affdd..0b83432545 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm @@ -2,7 +2,7 @@ package ExtUtils::MakeMaker::Config; use strict; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; use Config (); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod index d33f82e53b..f3354231d1 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::FAQ; -our $VERSION = '1.12'; +our $VERSION = '6.57_01'; 1; __END__ @@ -241,7 +241,7 @@ do that. Use at your own risk. Have fun blowing holes in your foot. use File::Spec; use File::Find; use ExtUtils::Manifest qw(maniread); - + my %manifest = map {( $_ => 1 )} grep { File::Spec->canonpath($_) } keys %{ maniread() }; @@ -250,14 +250,14 @@ do that. Use at your own risk. Have fun blowing holes in your foot. print "No files found in MANIFEST. Stopping.\n"; exit; } - + find({ wanted => sub { my $path = File::Spec->canonpath($_); - + return unless -f $path; return if exists $manifest{ $path }; - + print "unlink $path\n"; unlink $path; }, @@ -267,6 +267,10 @@ do that. Use at your own risk. Have fun blowing holes in your foot. ); +=item Which tar should I use on Windows? + +We recommend ptar from Archive::Tar not older that 1.66 with '-C' option. + =item Which zip should I use on Windows for '[nd]make zipdist'? We recommend InfoZIP: L<http://www.info-zip.org/Zip.html> diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod index 8ad72649b1..d5ff9086c3 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::Tutorial; -our $VERSION = 0.02; +our $VERSION = 6.57_01; =head1 NAME diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm index 707466a98d..aeb8b27d14 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm @@ -3,7 +3,7 @@ package ExtUtils::Mkbootstrap; # There's just too much Dynaloader incest here to turn on strict vars. use strict 'refs'; -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; require Exporter; our @ISA = ('Exporter'); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm index 962c67fd57..e7992936fa 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm @@ -10,7 +10,7 @@ use Config; our @ISA = qw(Exporter); our @EXPORT = qw(&Mksymlists); -our $VERSION = '6.56'; +our $VERSION = '6.57_01'; sub Mksymlists { my(%spec) = @_; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm index fe01beb0e1..628dda034f 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm @@ -3,7 +3,7 @@ package ExtUtils::testlib; use strict; use warnings; -our $VERSION = 6.56; +our $VERSION = 6.57_01; use Cwd; use File::Spec; diff --git a/cpan/ExtUtils-MakeMaker/t/metafile_file.t b/cpan/ExtUtils-MakeMaker/t/metafile_file.t index ca8a412eba..e4e98dc4a0 100644 --- a/cpan/ExtUtils-MakeMaker/t/metafile_file.t +++ b/cpan/ExtUtils-MakeMaker/t/metafile_file.t @@ -267,8 +267,9 @@ YAML SKIP: { + # Load() behaves diffrently in versions prior to 1.06 skip "Need YAML::Tiny to test if it can load META.yml", 2 - unless eval { require YAML::Tiny }; + unless eval { require YAML::Tiny } and $YAML::Tiny::VERSION >= 1.06; my @yaml_load = YAML::Tiny::Load($mm->metafile_file(@meta)); is @yaml_load, 1, "YAML::Tiny saw one document in META.yml"; diff --git a/cpan/ExtUtils-MakeMaker/t/parse_abstract.t b/cpan/ExtUtils-MakeMaker/t/parse_abstract.t new file mode 100644 index 0000000000..03e56c932e --- /dev/null +++ b/cpan/ExtUtils-MakeMaker/t/parse_abstract.t @@ -0,0 +1,77 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use ExtUtils::MakeMaker; + +use Test::More 'no_plan'; + +sub test_abstract { + my($code, $package, $want, $name) = @_; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $file = "t/abstract.tmp"; + { + open my $fh, ">", $file or die "Can't open $file"; + print $fh $code; + close $fh; + } + + # Hack up a minimal MakeMaker object. + my $mm = bless { DISTNAME => $package }, "MM"; + my $have = $mm->parse_abstract($file); + + my $ok = is( $have, $want, $name ); + + # Clean up the temp file, VMS style + 1 while unlink $file; + + return $ok; +} + + +test_abstract(<<END, "Foo", "Stuff and things", "Simple abstract"); +=head1 NAME + +Foo - Stuff and things +END + + +test_abstract(<<END, "NEXT", "Provide a pseudo-class NEXT (et al) that allows method redispatch", "Name.pm"); +=head1 NAME + +NEXT.pm - Provide a pseudo-class NEXT (et al) that allows method redispatch +END + + +test_abstract(<<END, "Compress::Raw::Zlib::FAQ", "Frequently Asked Questions about Compress::Raw::Zlib", "double dash"); +=pod + +Compress::Raw::Zlib::FAQ -- Frequently Asked Questions about Compress::Raw::Zlib +END + + +test_abstract(<<END, "Foo", "This is", "Only in POD"); +# =pod + +Foo - This is not in pod + +=cut + +Foo - This isn't in pod either + +=pod + +Foo - This is + +Foo - So is this. +END + + +test_abstract(<<END, "Foo", "the abstract", "more spaces"); +=pod + +Foo - the abstract +END diff --git a/cpan/ExtUtils-MakeMaker/t/parse_version.t b/cpan/ExtUtils-MakeMaker/t/parse_version.t index 858e294181..d7c14a884d 100644 --- a/cpan/ExtUtils-MakeMaker/t/parse_version.t +++ b/cpan/ExtUtils-MakeMaker/t/parse_version.t @@ -36,6 +36,7 @@ my %versions = (q[$VERSION = '1.00'] => '1.00', '$VERSION = sprintf("%d.%03d", q$Revision: 3.74 $ =~ /(\d+)\.(\d+)/);' => '3.074', '$VERSION = substr(q$Revision: 2.8 $, 10) + 2 . "";' => '4.8', + 'elsif ( $Something::VERSION >= 1.99 )' => 'undef', ); @@ -72,12 +73,15 @@ our $VERSION = 2.34; END } -plan tests => (2 * keys %versions) + 4; +plan tests => (3 * keys %versions) + 4; for my $code ( sort keys %versions ) { my $expect = $versions{$code}; (my $label = $code) =~ s/\n/\\n/g; + my $warnings = ""; + local $SIG{__WARN__} = sub { $warnings .= "@_\n"; }; is( parse_version_string($code), $expect, $label ); + is($warnings, '', "$label does not cause warnings"); } diff --git a/cpan/Unicode-Collate/Changes b/cpan/Unicode-Collate/Changes index 6028db66b3..62fa837977 100644 --- a/cpan/Unicode-Collate/Changes +++ b/cpan/Unicode-Collate/Changes @@ -1,5 +1,8 @@ Revision history for Perl module Unicode::Collate. +0.57 Sun Aug 22 22:39:58 2010 + - Unicode::Collate::Locale newly supports locales: ca, et, fi, lv, sk, sl. + 0.56 Sun Aug 8 20:24:03 2010 - Unicode::Collate::Locale newly supports locales: eo, nb, ro, sv. ! renamed t/locale_{xy}.t to t/loc_{xy}.t (for safer 8.3 names) diff --git a/cpan/Unicode-Collate/Collate.pm b/cpan/Unicode-Collate/Collate.pm index 80f1850194..a1da1c9568 100644 --- a/cpan/Unicode-Collate/Collate.pm +++ b/cpan/Unicode-Collate/Collate.pm @@ -14,7 +14,7 @@ use File::Spec; no warnings 'utf8'; -our $VERSION = '0.56'; +our $VERSION = '0.57'; our $PACKAGE = __PACKAGE__; my @Path = qw(Unicode Collate); diff --git a/cpan/Unicode-Collate/Collate/Locale.pm b/cpan/Unicode-Collate/Collate/Locale.pm index 955c81a6ac..204b8c3b17 100644 --- a/cpan/Unicode-Collate/Collate/Locale.pm +++ b/cpan/Unicode-Collate/Collate/Locale.pm @@ -4,7 +4,7 @@ use strict; use Carp; use base qw(Unicode::Collate); -our $VERSION = '0.56'; +our $VERSION = '0.57'; use File::Spec; @@ -12,7 +12,9 @@ use File::Spec; my $KeyPath = File::Spec->catfile('allkeys.txt'); my $PL_EXT = '.pl'; -my %LocaleFile = map { ($_, $_) } qw(cs eo es fr nn pl ro sv); +my %LocaleFile = map { ($_, $_) } qw( + ca cs eo es et fi fr lv nn pl ro sk sl sv +); $LocaleFile{'default'} = ''; $LocaleFile{'es__traditional'} = 'es_trad'; $LocaleFile{'nb'} = 'nn'; @@ -48,6 +50,10 @@ sub new { my $filepath = File::Spec->catfile($ModPath, $file.$PL_EXT); $href = do $filepath; } + + if (exists $hash{table}) { + croak "your table can't be used with Unicode::Collate::Locale"; + } $href->{table} = $KeyPath; while (my($k,$v) = each %$href) { @@ -98,11 +104,11 @@ C<es_ES_traditional> for Spanish in Spain (Traditional), If C<$localename> is not defined, fallback is selected in the following order: - 1. language_territory_variant - 2. language_territory - 3. language__variant - 4. language - 5. default + 1. language_territory_variant + 2. language_territory + 3. language__variant + 4. language + 5. default Tailoring tags provided by C<Unicode::Collate> are allowed as long as they are not used for C<'locale'> support. @@ -113,10 +119,10 @@ E.g. a collator for French, which ignores diacritics and case difference (i.e. level 1), with reversed case ordering and no normalization. Unicode::Collate::Locale->new( - level => 1, - locale => 'fr', - upper_before_lower => 1, - normalization => undef + level => 1, + locale => 'fr', + upper_before_lower => 1, + normalization => undef ) =head2 Methods @@ -139,17 +145,23 @@ this method returns a string C<'default'> meaning no special tailoring. =head2 A list of tailorable locales - locale name description - + locale name description + ---------------------------------------------------------- + ca Catalan cs Czech eo Esperanto es Spanish es__traditional Spanish ('ch' and 'll' as a grapheme) + et Estonian + fi Finnish fr French + lv Latvian nb Norwegian Bokmal nn Norwegian Nynorsk pl Polish ro Romanian + sk Slovak + sl Slovenian sv Swedish =head1 AUTHOR diff --git a/cpan/Unicode-Collate/Collate/Locale/ca.pl b/cpan/Unicode-Collate/Collate/Locale/ca.pl new file mode 100644 index 0000000000..692ec50ea6 --- /dev/null +++ b/cpan/Unicode-Collate/Collate/Locale/ca.pl @@ -0,0 +1,17 @@ ++{ + backwards => 2, + entry => <<'ENTRY', # for DUCET v5.2.0 +0063 0068 ; [.123E.0020.0002.0063] # <LATIN SMALL LETTER C, LATIN SMALL LETTER H> +0063 0048 ; [.123E.0020.0007.0063][.0.0.2.0] # <LATIN SMALL LETTER C, LATIN CAPITAL LETTER H> +0043 0068 ; [.123E.0020.0007.0043][.0.0.8.0] # <LATIN CAPITAL LETTER C, LATIN SMALL LETTER H> +0043 0048 ; [.123E.0020.0008.0043] # <LATIN CAPITAL LETTER C, LATIN CAPITAL LETTER H> +006C 006C ; [.1331.0020.0002.006C][.0.0.1.0] # <LATIN SMALL LETTER L, LATIN SMALL LETTER L> +006C 00B7 006C ; [.1331.0020.0002.006C][.0.0.7.0] # <LATIN SMALL LETTER L, MIDDLE DOT, LATIN SMALL LETTER L> +006C 004C ; [.1331.0020.0007.006C][.0.0.2.0][.0.0.1.0] # <LATIN SMALL LETTER L, LATIN CAPITAL LETTER L> +006C 00B7 004C ; [.1331.0020.0007.006C][.0.0.2.0][.0.0.7.0] # <LATIN SMALL LETTER L, MIDDLE DOT, LATIN CAPITAL LETTER L> +004C 006C ; [.1331.0020.0007.004C][.0.0.8.0][.0.0.1.0] # <LATIN CAPITAL LETTER L, LATIN SMALL LETTER L> +004C 00B7 006C ; [.1331.0020.0007.004C][.0.0.8.0][.0.0.7.0] # <LATIN CAPITAL LETTER L, MIDDLE DOT, LATIN SMALL LETTER L> +004C 004C ; [.1331.0020.0008.004C][.0.0.1.0] # <LATIN CAPITAL LETTER L, LATIN CAPITAL LETTER L> +004C 00B7 004C ; [.1331.0020.0008.004C][.0.0.7.0] # <LATIN CAPITAL LETTER L, MIDDLE DOT, LATIN CAPITAL LETTER L> +ENTRY +}; diff --git a/cpan/Unicode-Collate/Collate/Locale/et.pl b/cpan/Unicode-Collate/Collate/Locale/et.pl new file mode 100644 index 0000000000..15a24198d0 --- /dev/null +++ b/cpan/Unicode-Collate/Collate/Locale/et.pl @@ -0,0 +1,32 @@ ++{ + entry => <<'ENTRY', # for DUCET v5.2.0 +0161 ; [.1430.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0073 030C ; [.1430.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0160 ; [.1430.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +0053 030C ; [.1430.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +007A ; [.1431.0020.0002.007A] # LATIN SMALL LETTER Z +005A ; [.1431.0020.0008.005A] # LATIN CAPITAL LETTER Z +017E ; [.1432.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +007A 030C ; [.1432.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +017D ; [.1432.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +005A 030C ; [.1432.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +0077 ; [.147B.0021.0002.0077] # LATIN SMALL LETTER W +0057 ; [.147B.0021.0008.0057] # LATIN CAPITAL LETTER W +00F5 ; [.1493.0020.0002.00F5] # LATIN SMALL LETTER O WITH TILDE +006F 0303 ; [.1493.0020.0002.00F5] # LATIN SMALL LETTER O WITH TILDE +00D5 ; [.1493.0020.0008.00D5] # LATIN CAPITAL LETTER O WITH TILDE +004F 0303 ; [.1493.0020.0008.00D5] # LATIN CAPITAL LETTER O WITH TILDE +00E4 ; [.1494.0020.0002.00E4] # LATIN SMALL LETTER A WITH DIAERESIS +0061 0308 ; [.1494.0020.0002.00E4] # LATIN SMALL LETTER A WITH DIAERESIS +00C4 ; [.1494.0020.0008.00C4] # LATIN CAPITAL LETTER A WITH DIAERESIS +0041 0308 ; [.1494.0020.0008.00C4] # LATIN CAPITAL LETTER A WITH DIAERESIS +00F6 ; [.1495.0020.0002.00F6] # LATIN SMALL LETTER O WITH DIAERESIS +006F 0308 ; [.1495.0020.0002.00F6] # LATIN SMALL LETTER O WITH DIAERESIS +00D6 ; [.1495.0020.0008.00D6] # LATIN CAPITAL LETTER O WITH DIAERESIS +004F 0308 ; [.1495.0020.0008.00D6] # LATIN CAPITAL LETTER O WITH DIAERESIS +00FC ; [.1496.0020.0002.00FC] # LATIN SMALL LETTER U WITH DIAERESIS +0075 0308 ; [.1496.0020.0002.00FC] # LATIN SMALL LETTER U WITH DIAERESIS +00DC ; [.1496.0020.0008.00DC] # LATIN CAPITAL LETTER U WITH DIAERESIS +0055 0308 ; [.1496.0020.0008.00DC] # LATIN CAPITAL LETTER U WITH DIAERESIS +ENTRY +}; diff --git a/cpan/Unicode-Collate/Collate/Locale/fi.pl b/cpan/Unicode-Collate/Collate/Locale/fi.pl new file mode 100644 index 0000000000..96e3491db1 --- /dev/null +++ b/cpan/Unicode-Collate/Collate/Locale/fi.pl @@ -0,0 +1,51 @@ ++{ +# in cldr test/fi.xml why x{110}x < xdx though xd < x{110} ? + entry => <<'ENTRY', # for DUCET v5.2.0 +0111 ; [.1250.0021.0002.0111][.0000.007D.0002.0335] # LATIN SMALL LETTER D WITH STROKE +0110 ; [.1250.0021.0008.0110][.0000.007D.0002.0335] # LATIN CAPITAL LETTER D WITH STROKE +01E5 ; [.12B0.0021.0002.01E5][.0000.007D.0002.0335] # LATIN SMALL LETTER G WITH STROKE +01E4 ; [.12B0.0021.0008.01E4][.0000.007D.0002.0335] # LATIN CAPITAL LETTER G WITH STROKE +014B ; [.136D.0021.0002.014B][.0000.007D.0002.0335] # LATIN SMALL LETTER ENG +014A ; [.136D.0021.0008.014A][.0000.007D.0002.0335] # LATIN CAPITAL LETTER ENG +0167 ; [.1433.0021.0002.0167][.0000.007D.0002.0335] # LATIN SMALL LETTER T WITH STROKE +0166 ; [.1433.0021.0008.0166][.0000.007D.0002.0335] # LATIN CAPITAL LETTER T WITH STROKE +0077 ; [.147B.0021.0002.0077] # LATIN SMALL LETTER W +0057 ; [.147B.0021.0008.0057] # LATIN CAPITAL LETTER W +00FC ; [.149C.0021.0002.00FC] # LATIN SMALL LETTER U WITH DIAERESIS +0075 0308 ; [.149C.0021.0002.00FC] # LATIN SMALL LETTER U WITH DIAERESIS +00DC ; [.149C.0021.0008.00DC] # LATIN CAPITAL LETTER U WITH DIAERESIS +0055 0308 ; [.149C.0021.0008.00DC] # LATIN CAPITAL LETTER U WITH DIAERESIS +0292 ; [.14AD.0021.0002.0292][.0000.007D.0002.0335] # LATIN SMALL LETTER EZH +01B7 ; [.14AD.0021.0008.01B7][.0000.007D.0002.0335] # LATIN CAPITAL LETTER EZH +01EF ; [.14AD.0021.0002.0292][.0000.007D.0002.0335][.0000.0041.0002.030C] # LATIN SMALL LETTER EZH WITH CARON +01EE ; [.14AD.0021.0008.01B7][.0000.007D.0002.0335][.0000.0041.0002.030C] # LATIN CAPITAL LETTER EZH WITH CARON +00E5 ; [.14AE.0020.0002.00E5] # LATIN SMALL LETTER A WITH RING ABOVE +0061 030A ; [.14AE.0020.0002.00E5] # LATIN SMALL LETTER A WITH RING ABOVE +00C5 ; [.14AE.0020.0008.00C5] # LATIN CAPITAL LETTER A WITH RING ABOVE +0041 030A ; [.14AE.0020.0008.00C5] # LATIN CAPITAL LETTER A WITH RING ABOVE +212B ; [.14AE.0020.0008.00C5] # ANGSTROM SIGN +01FB ; [.14AE.0020.0002.00E5][.0000.0032.0002.0301] # LATIN SMALL LETTER A WITH RING ABOVE AND ACUTE +01FA ; [.14AE.0020.0008.00C5][.0000.0032.0002.0301] # LATIN CAPITAL LETTER A WITH RING ABOVE AND ACUTE +00E4 ; [.14AF.0020.0002.00E4] # LATIN SMALL LETTER A WITH DIAERESIS +0061 0308 ; [.14AF.0020.0002.00E4] # LATIN SMALL LETTER A WITH DIAERESIS +00C4 ; [.14AF.0020.0008.00C4] # LATIN CAPITAL LETTER A WITH DIAERESIS +0041 0308 ; [.14AF.0020.0008.00C4] # LATIN CAPITAL LETTER A WITH DIAERESIS +00E6 ; [.14AF.0021.0002.00E6] # LATIN SMALL LETTER AE +00C6 ; [.14AF.0021.0008.00C6] # LATIN CAPITAL LETTER AE +1D2D ; [.14AF.0021.0014.1D2D] # MODIFIER LETTER CAPITAL AE +01FD ; [.14AF.0021.0002.00E6][.0000.0032.0002.0301] # LATIN SMALL LETTER AE WITH ACUTE +01FC ; [.14AF.0021.0008.00C6][.0000.0032.0002.0301] # LATIN CAPITAL LETTER AE WITH ACUTE +01E3 ; [.14AF.0021.0002.00E6][.0000.005B.0002.0304] # LATIN SMALL LETTER AE WITH MACRON +01E2 ; [.14AF.0021.0008.00C6][.0000.005B.0002.0304] # LATIN CAPITAL LETTER AE WITH MACRON +00F6 ; [.14B0.0020.0002.00F6] # LATIN SMALL LETTER O WITH DIAERESIS +006F 0308 ; [.14B0.0020.0002.00F6] # LATIN SMALL LETTER O WITH DIAERESIS +00D6 ; [.14B0.0020.0008.00D6] # LATIN CAPITAL LETTER O WITH DIAERESIS +004F 0308 ; [.14B0.0020.0008.00D6] # LATIN CAPITAL LETTER O WITH DIAERESIS +00F8 ; [.14B0.0021.0002.00F8] # LATIN SMALL LETTER O WITH STROKE +006F 0338 ; [.14B0.0021.0002.00F8] # LATIN SMALL LETTER O WITH STROKE +00D8 ; [.14B0.0021.0008.00D8] # LATIN CAPITAL LETTER O WITH STROKE +004F 0338 ; [.14B0.0021.0008.00D8] # LATIN CAPITAL LETTER O WITH STROKE +01FF ; [.14B0.0021.0002.00F8][.0000.0032.0002.0301] # LATIN SMALL LETTER O WITH STROKE AND ACUTE +01FE ; [.14B0.0021.0008.00D8][.0000.0032.0002.0301] # LATIN CAPITAL LETTER O WITH STROKE AND ACUTE +ENTRY +}; diff --git a/cpan/Unicode-Collate/Collate/Locale/lv.pl b/cpan/Unicode-Collate/Collate/Locale/lv.pl new file mode 100644 index 0000000000..15ab6e91b6 --- /dev/null +++ b/cpan/Unicode-Collate/Collate/Locale/lv.pl @@ -0,0 +1,37 @@ ++{ +# ignored: Y < J + entry => <<'ENTRY', # for DUCET v5.2.0 +010D ; [.124F.0020.0002.010D] # LATIN SMALL LETTER C WITH CARON +0063 030C ; [.124F.0020.0002.010D] # LATIN SMALL LETTER C WITH CARON +010C ; [.124F.0020.0008.010C] # LATIN CAPITAL LETTER C WITH CARON +0043 030C ; [.124F.0020.0008.010C] # LATIN CAPITAL LETTER C WITH CARON +0123 ; [.12D2.0020.0002.0123] # LATIN SMALL LETTER G WITH CEDILLA +0067 0327 ; [.12D2.0020.0002.0123] # LATIN SMALL LETTER G WITH CEDILLA +0122 ; [.12D2.0020.0008.0122] # LATIN CAPITAL LETTER G WITH CEDILLA +0047 0327 ; [.12D2.0020.0008.0122] # LATIN CAPITAL LETTER G WITH CEDILLA +0137 ; [.132F.0020.0002.0137] # LATIN SMALL LETTER K WITH CEDILLA +006B 0327 ; [.132F.0020.0002.0137] # LATIN SMALL LETTER K WITH CEDILLA +0136 ; [.132F.0020.0008.0136] # LATIN CAPITAL LETTER K WITH CEDILLA +004B 0327 ; [.132F.0020.0008.0136] # LATIN CAPITAL LETTER K WITH CEDILLA +013C ; [.135E.0020.0002.013C] # LATIN SMALL LETTER L WITH CEDILLA +006C 0327 ; [.135E.0020.0002.013C] # LATIN SMALL LETTER L WITH CEDILLA +013B ; [.135E.0020.0008.013B] # LATIN CAPITAL LETTER L WITH CEDILLA +004C 0327 ; [.135E.0020.0008.013B] # LATIN CAPITAL LETTER L WITH CEDILLA +0146 ; [.138D.0020.0002.0146] # LATIN SMALL LETTER N WITH CEDILLA +006E 0327 ; [.138D.0020.0002.0146] # LATIN SMALL LETTER N WITH CEDILLA +0145 ; [.138D.0020.0008.0145] # LATIN CAPITAL LETTER N WITH CEDILLA +004E 0327 ; [.138D.0020.0008.0145] # LATIN CAPITAL LETTER N WITH CEDILLA +0157 ; [.140F.0020.0002.0157] # LATIN SMALL LETTER R WITH CEDILLA +0072 0327 ; [.140F.0020.0002.0157] # LATIN SMALL LETTER R WITH CEDILLA +0156 ; [.140F.0020.0008.0156] # LATIN CAPITAL LETTER R WITH CEDILLA +0052 0327 ; [.140F.0020.0008.0156] # LATIN CAPITAL LETTER R WITH CEDILLA +0161 ; [.1432.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0073 030C ; [.1432.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0160 ; [.1432.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +0053 030C ; [.1432.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +017E ; [.14C9.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +007A 030C ; [.14C9.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +017D ; [.14C9.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +005A 030C ; [.14C9.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +ENTRY +}; diff --git a/cpan/Unicode-Collate/Collate/Locale/sk.pl b/cpan/Unicode-Collate/Collate/Locale/sk.pl new file mode 100644 index 0000000000..f248d1b20c --- /dev/null +++ b/cpan/Unicode-Collate/Collate/Locale/sk.pl @@ -0,0 +1,28 @@ ++{ + entry => <<'ENTRY', # for DUCET v5.2.0 +00E4 ; [.1210.0020.0002.00E4] # LATIN SMALL LETTER A WITH DIAERESIS +0061 0308 ; [.1210.0020.0002.00E4] # LATIN SMALL LETTER A WITH DIAERESIS +00C4 ; [.1210.0020.0008.00C4] # LATIN CAPITAL LETTER A WITH DIAERESIS +0041 0308 ; [.1210.0020.0008.00C4] # LATIN CAPITAL LETTER A WITH DIAERESIS +010D ; [.123E.0020.0002.010D] # LATIN SMALL LETTER C WITH CARON +0063 030C ; [.123E.0020.0002.010D] # LATIN SMALL LETTER C WITH CARON +010C ; [.123E.0020.0008.010C] # LATIN CAPITAL LETTER C WITH CARON +0043 030C ; [.123E.0020.0008.010C] # LATIN CAPITAL LETTER C WITH CARON +0063 0068 ; [.12D4.0020.0002.0063] # <LATIN SMALL LETTER C, LATIN SMALL LETTER H> +0063 0048 ; [.12D4.0020.0007.0063][.0.0.2.0] # <LATIN SMALL LETTER C, LATIN CAPITAL LETTER H> +0043 0068 ; [.12D4.0020.0007.0043][.0.0.8.0] # <LATIN CAPITAL LETTER C, LATIN SMALL LETTER H> +0043 0048 ; [.12D4.0020.0008.0043] # <LATIN CAPITAL LETTER C, LATIN CAPITAL LETTER H> +00F4 ; [.138F.0020.0002.00F4] # LATIN SMALL LETTER O WITH CIRCUMFLEX +006F 0302 ; [.138F.0020.0002.00F4] # LATIN SMALL LETTER O WITH CIRCUMFLEX +00D4 ; [.138F.0020.0008.00D4] # LATIN CAPITAL LETTER O WITH CIRCUMFLEX +004F 0302 ; [.138F.0020.0008.00D4] # LATIN CAPITAL LETTER O WITH CIRCUMFLEX +0161 ; [.1411.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0073 030C ; [.1411.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0160 ; [.1411.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +0053 030C ; [.1411.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +017E ; [.14AE.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +007A 030C ; [.14AE.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +017D ; [.14AE.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +005A 030C ; [.14AE.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +ENTRY +}; diff --git a/cpan/Unicode-Collate/Collate/Locale/sl.pl b/cpan/Unicode-Collate/Collate/Locale/sl.pl new file mode 100644 index 0000000000..37d891d4c9 --- /dev/null +++ b/cpan/Unicode-Collate/Collate/Locale/sl.pl @@ -0,0 +1,17 @@ ++{ +# c-acute not included + entry => <<'ENTRY', # for DUCET v5.2.0 +010D ; [.123E.0020.0002.010D] # LATIN SMALL LETTER C WITH CARON +0063 030C ; [.123E.0020.0002.010D] # LATIN SMALL LETTER C WITH CARON +010C ; [.123E.0020.0008.010C] # LATIN CAPITAL LETTER C WITH CARON +0043 030C ; [.123E.0020.0008.010C] # LATIN CAPITAL LETTER C WITH CARON +0161 ; [.1411.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0073 030C ; [.1411.0020.0002.0161] # LATIN SMALL LETTER S WITH CARON +0160 ; [.1411.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +0053 030C ; [.1411.0020.0008.0160] # LATIN CAPITAL LETTER S WITH CARON +017E ; [.14AE.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +007A 030C ; [.14AE.0020.0002.017E] # LATIN SMALL LETTER Z WITH CARON +017D ; [.14AE.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +005A 030C ; [.14AE.0020.0008.017D] # LATIN CAPITAL LETTER Z WITH CARON +ENTRY +}; diff --git a/cpan/Unicode-Collate/README b/cpan/Unicode-Collate/README index 06f6d003e7..4d8f05e359 100644 --- a/cpan/Unicode-Collate/README +++ b/cpan/Unicode-Collate/README @@ -1,4 +1,4 @@ -Unicode/Collate version 0.56 +Unicode/Collate version 0.57 =============================== NAME diff --git a/cpan/Unicode-Collate/t/loc_ca.t b/cpan/Unicode-Collate/t/loc_ca.t new file mode 100644 index 0000000000..2149194b34 --- /dev/null +++ b/cpan/Unicode-Collate/t/loc_ca.t @@ -0,0 +1,72 @@ +#!perl +use strict; +use warnings; +use Unicode::Collate::Locale; + +use Test; +plan tests => 38; + +my $dot = pack 'U', 0xB7; + +my $objCa = Unicode::Collate::Locale-> + new(locale => 'CA', normalization => undef); + +ok(1); +ok($objCa->getlocale, 'ca'); + +$objCa->change(level => 1); + +ok($objCa->lt("c", "ch")); +ok($objCa->lt("cz", "ch")); +ok($objCa->gt("d", "ch")); +ok($objCa->lt("l", "ll")); +ok($objCa->lt("lz", "ll")); +ok($objCa->gt("m", "ll")); + +# 8 + +ok($objCa->eq("a\x{300}a", "aa\x{300}")); + +$objCa->change(level => 2); + +ok($objCa->lt("a\x{300}a", "aa\x{300}")); +ok($objCa->gt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); +ok($objCa->gt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); + +# 12 + +ok($objCa->eq("ch", "cH")); +ok($objCa->eq("cH", "Ch")); +ok($objCa->eq("Ch", "CH")); + +ok($objCa->eq("ll", "lL")); +ok($objCa->eq("lL", "Ll")); +ok($objCa->eq("Ll", "LL")); +ok($objCa->eq("l${dot}l", "lL")); +ok($objCa->eq("l${dot}L", "Ll")); +ok($objCa->eq("L${dot}l", "LL")); +ok($objCa->eq("ll","l${dot}l")); +ok($objCa->eq("lL","l${dot}L")); +ok($objCa->eq("Ll","L${dot}l")); +ok($objCa->eq("LL","L${dot}L")); + +# 25 + +$objCa->change(level => 3); + +ok($objCa->lt("ch", "cH")); +ok($objCa->lt("cH", "Ch")); +ok($objCa->lt("Ch", "CH")); + +ok($objCa->lt("ll", "lL")); +ok($objCa->lt("lL", "Ll")); +ok($objCa->lt("Ll", "LL")); +ok($objCa->lt("l${dot}l", "lL")); +ok($objCa->lt("l${dot}L", "Ll")); +ok($objCa->lt("L${dot}l", "LL")); +ok($objCa->lt("ll","l${dot}l")); +ok($objCa->lt("lL","l${dot}L")); +ok($objCa->lt("Ll","L${dot}l")); +ok($objCa->lt("LL","L${dot}L")); + +# 38 diff --git a/cpan/Unicode-Collate/t/loc_es.t b/cpan/Unicode-Collate/t/loc_es.t index 228a58cbda..54ac671350 100644 --- a/cpan/Unicode-Collate/t/loc_es.t +++ b/cpan/Unicode-Collate/t/loc_es.t @@ -4,7 +4,7 @@ use warnings; use Unicode::Collate::Locale; use Test; -plan tests => 22; +plan tests => 26; my $objEs = Unicode::Collate::Locale-> new(locale => 'ES', normalization => undef); @@ -25,15 +25,23 @@ ok($objEs->gt("o", "n\x{303}")); # 10 +ok($objEs->eq("a\x{300}a", "aa\x{300}")); + $objEs->change(level => 2); +ok($objEs->gt("a\x{300}a", "aa\x{300}")); +ok($objEs->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); +ok($objEs->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); + +# 14 + ok($objEs->eq("ch", "Ch")); ok($objEs->eq("Ch", "CH")); ok($objEs->eq("ll", "Ll")); ok($objEs->eq("Ll", "LL")); ok($objEs->eq("n\x{303}", "N\x{303}")); -# 15 +# 19 $objEs->change(level => 3); @@ -45,4 +53,4 @@ ok($objEs->lt("n\x{303}", "N\x{303}")); ok($objEs->eq("n\x{303}", pack('U', 0xF1))); ok($objEs->eq("N\x{303}", pack('U', 0xD1))); -# 22 +# 26 diff --git a/cpan/Unicode-Collate/t/loc_estr.t b/cpan/Unicode-Collate/t/loc_estr.t index b938b49fe5..963c3569d5 100644 --- a/cpan/Unicode-Collate/t/loc_estr.t +++ b/cpan/Unicode-Collate/t/loc_estr.t @@ -4,7 +4,7 @@ use warnings; use Unicode::Collate::Locale; use Test; -plan tests => 22; +plan tests => 26; my $objEsTrad = Unicode::Collate::Locale-> new(locale => 'ES-trad', normalization => undef); @@ -25,15 +25,23 @@ ok($objEsTrad->gt("o", "n\x{303}")); # 10 +ok($objEsTrad->eq("a\x{300}a", "aa\x{300}")); + $objEsTrad->change(level => 2); +ok($objEsTrad->gt("a\x{300}a", "aa\x{300}")); +ok($objEsTrad->lt("Ca\x{300}ca\x{302}", "ca\x{302}ca\x{300}")); +ok($objEsTrad->lt("ca\x{300}ca\x{302}", "Ca\x{302}ca\x{300}")); + +# 14 + ok($objEsTrad->eq("ch", "Ch")); ok($objEsTrad->eq("Ch", "CH")); ok($objEsTrad->eq("ll", "Ll")); ok($objEsTrad->eq("Ll", "LL")); ok($objEsTrad->eq("n\x{303}", "N\x{303}")); -# 15 +# 19 $objEsTrad->change(level => 3); @@ -45,4 +53,4 @@ ok($objEsTrad->lt("n\x{303}", "N\x{303}")); ok($objEsTrad->eq("n\x{303}", pack('U', 0xF1))); ok($objEsTrad->eq("N\x{303}", pack('U', 0xD1))); -# 22 +# 26 diff --git a/cpan/Unicode-Collate/t/loc_et.t b/cpan/Unicode-Collate/t/loc_et.t new file mode 100644 index 0000000000..d1526bfb1c --- /dev/null +++ b/cpan/Unicode-Collate/t/loc_et.t @@ -0,0 +1,70 @@ +#!perl +use strict; +use warnings; +use Unicode::Collate::Locale; + +use Test; +plan tests => 41; + +my $objEt = Unicode::Collate::Locale-> + new(locale => 'ET', normalization => undef); + +ok(1); +ok($objEt->getlocale, 'et'); + +$objEt->change(level => 1); + +ok($objEt->lt("s", "s\x{30C}")); +ok($objEt->gt("z", "s\x{30C}")); +ok($objEt->lt("z", "z\x{30C}")); +ok($objEt->gt("t", "z\x{30C}")); +ok($objEt->eq("v", "w")); +ok($objEt->lt("w", "o\x{303}")); +ok($objEt->lt("o\x{303}", "a\x{308}")); +ok($objEt->lt("a\x{308}", "o\x{308}")); +ok($objEt->lt("o\x{308}", "u\x{308}")); +ok($objEt->lt("u\x{308}", "x")); + +# 12 + +$objEt->change(level => 2); + +ok($objEt->lt("v", "w")); +ok($objEt->eq("s\x{30C}", "S\x{30C}")); +ok($objEt->eq("z", "Z")); +ok($objEt->eq("z\x{30C}", "Z\x{30C}")); +ok($objEt->eq("w", "W")); +ok($objEt->eq("o\x{303}", "O\x{303}")); +ok($objEt->eq("a\x{308}", "A\x{308}")); +ok($objEt->eq("o\x{308}", "O\x{308}")); +ok($objEt->eq("u\x{308}", "U\x{308}")); + +# 21 + +$objEt->change(level => 3); + +ok($objEt->lt("s\x{30C}", "S\x{30C}")); +ok($objEt->lt("z", "Z")); +ok($objEt->lt("z\x{30C}", "Z\x{30C}")); +ok($objEt->lt("w", "W")); +ok($objEt->lt("o\x{303}", "O\x{303}")); +ok($objEt->lt("a\x{308}", "A\x{308}")); +ok($objEt->lt("o\x{308}", "O\x{308}")); +ok($objEt->lt("u\x{308}", "U\x{308}")); + +# 29 + +ok($objEt->eq("s\x{30C}", "\x{161}")); +ok($objEt->eq("S\x{30C}", "\x{160}")); +ok($objEt->eq("z\x{30C}", "\x{17E}")); +ok($objEt->eq("Z\x{30C}", "\x{17D}")); +ok($objEt->eq("o\x{303}", pack('U', 0xF5))); +ok($objEt->eq("O\x{303}", pack('U', 0xD5))); +ok($objEt->eq("a\x{308}", pack('U', 0xE4))); +ok($objEt->eq("A\x{308}", pack('U', 0xC4))); +ok($objEt->eq("o\x{308}", pack('U', 0xF6))); +ok($objEt->eq("O\x{308}", pack('U', 0xD6))); +ok($objEt->eq("u\x{308}", pack('U', 0xFC))); +ok($objEt->eq("U\x{308}", pack('U', 0xDC))); + +# 41 diff --git a/cpan/Unicode-Collate/t/loc_fi.t b/cpan/Unicode-Collate/t/loc_fi.t new file mode 100644 index 0000000000..bbddc08c02 --- /dev/null +++ b/cpan/Unicode-Collate/t/loc_fi.t @@ -0,0 +1,118 @@ +#!perl +use strict; +use warnings; +use Unicode::Collate::Locale; + +use Test; +plan tests => 70; + +my $uuml = pack 'U', 0xFC; +my $Uuml = pack 'U', 0xDC; +my $arng = pack 'U', 0xE5; +my $Arng = pack 'U', 0xC5; +my $auml = pack 'U', 0xE4; +my $Auml = pack 'U', 0xC4; +my $ae = pack 'U', 0xE6; +my $AE = pack 'U', 0xC6; +my $ouml = pack 'U', 0xF6; +my $Ouml = pack 'U', 0xD6; +my $ostk = pack 'U', 0xF8; +my $Ostk = pack 'U', 0xD8; + +my $objFi = Unicode::Collate::Locale-> + new(locale => 'FI', normalization => undef); + +ok(1); +ok($objFi->getlocale, 'fi'); + +$objFi->change(level => 1); + +ok($objFi->lt('z', $arng)); +ok($objFi->lt($arng, $auml)); +ok($objFi->lt($auml, $ouml)); + +# 5 + +ok($objFi->eq("d\x{335}", "\x{111}")); +ok($objFi->eq("g\x{335}", "\x{1E5}")); +ok($objFi->eq("n\x{335}", "\x{14B}")); +ok($objFi->eq("t\x{335}", "\x{167}")); +ok($objFi->eq("z\x{335}", "\x{292}")); +ok($objFi->eq('v', 'w')); +ok($objFi->eq('y', $uuml)); +ok($objFi->eq($auml, $ae)); +ok($objFi->eq($ouml, $ostk)); + +# 14 + +$objFi->change(level => 2); + +ok($objFi->lt("d\x{335}", "\x{111}")); +ok($objFi->lt("g\x{335}", "\x{1E5}")); +ok($objFi->lt("n\x{335}", "\x{14B}")); +ok($objFi->lt("t\x{335}", "\x{167}")); +ok($objFi->lt("z\x{335}", "\x{292}")); +ok($objFi->lt('v', 'w')); +ok($objFi->lt('y', $uuml)); +ok($objFi->lt($auml, $ae)); +ok($objFi->lt($ouml, $ostk)); + +# 23 + +ok($objFi->eq("\x{111}", "\x{110}")); +ok($objFi->eq("\x{1E5}", "\x{1E4}")); +ok($objFi->eq("\x{14B}", "\x{14A}")); +ok($objFi->eq("\x{167}", "\x{166}")); +ok($objFi->eq("\x{292}", "\x{1B7}")); +ok($objFi->eq('w', 'W')); +ok($objFi->eq($uuml, $Uuml)); +ok($objFi->eq($arng, $Arng)); +ok($objFi->eq($auml, $Auml)); +ok($objFi->eq($ae, $AE)); +ok($objFi->eq($AE, "\x{1D2D}")); +ok($objFi->eq($ouml, $Ouml)); +ok($objFi->eq($ostk, $Ostk)); + +# 36 + +$objFi->change(level => 3); + +ok($objFi->lt("\x{111}", "\x{110}")); +ok($objFi->lt("\x{1E5}", "\x{1E4}")); +ok($objFi->lt("\x{14B}", "\x{14A}")); +ok($objFi->lt("\x{167}", "\x{166}")); +ok($objFi->lt("\x{292}", "\x{1B7}")); +ok($objFi->lt('w', 'W')); +ok($objFi->lt($uuml, $Uuml)); +ok($objFi->lt($arng, $Arng)); +ok($objFi->lt($auml, $Auml)); +ok($objFi->lt($ae, $AE)); +ok($objFi->lt($AE, "\x{1D2D}")); +ok($objFi->lt($ouml, $Ouml)); +ok($objFi->lt($ostk, $Ostk)); + +# 49 + +ok($objFi->eq("u\x{308}", $uuml)); +ok($objFi->eq("U\x{308}", $Uuml)); +ok($objFi->eq("\x{1EF}", "\x{292}\x{30C}")); +ok($objFi->eq("\x{1EE}", "\x{1B7}\x{30C}")); +ok($objFi->eq("a\x{30A}", $arng)); +ok($objFi->eq("A\x{30A}", $Arng)); +ok($objFi->eq("A\x{30A}", "\x{212B}")); +ok($objFi->eq("a\x{30A}\x{301}", "\x{1FB}")); +ok($objFi->eq("A\x{30A}\x{301}", "\x{1FA}")); +ok($objFi->eq("a\x{308}", $auml)); +ok($objFi->eq("A\x{308}", $Auml)); +ok($objFi->eq("\x{1FD}", "$ae\x{301}")); +ok($objFi->eq("\x{1FC}", "$AE\x{301}")); +ok($objFi->eq("\x{1E3}", "$ae\x{304}")); +ok($objFi->eq("\x{1E2}", "$AE\x{304}")); +ok($objFi->eq("o\x{308}", $ouml)); +ok($objFi->eq("O\x{308}", $Ouml)); +ok($objFi->eq("o\x{338}", $ostk)); +ok($objFi->eq("O\x{338}", $Ostk)); +ok($objFi->eq("o\x{338}\x{301}", "\x{1FF}")); +ok($objFi->eq("O\x{338}\x{301}", "\x{1FE}")); + +# 70 diff --git a/cpan/Unicode-Collate/t/loc_lv.t b/cpan/Unicode-Collate/t/loc_lv.t new file mode 100644 index 0000000000..6f411663fb --- /dev/null +++ b/cpan/Unicode-Collate/t/loc_lv.t @@ -0,0 +1,79 @@ +#!perl +use strict; +use warnings; +use Unicode::Collate::Locale; + +use Test; +plan tests => 50; + +my $objLv = Unicode::Collate::Locale-> + new(locale => 'LV', normalization => undef); + +ok(1); +ok($objLv->getlocale, 'lv'); + +$objLv->change(level => 1); + +ok($objLv->lt("c", "c\x{30C}")); +ok($objLv->gt("d", "c\x{30C}")); +ok($objLv->lt("g", "g\x{327}")); +ok($objLv->gt("h", "g\x{327}")); +ok($objLv->lt("k", "k\x{327}")); +ok($objLv->gt("l", "k\x{327}")); +ok($objLv->lt("l", "l\x{327}")); +ok($objLv->gt("m", "l\x{327}")); +ok($objLv->lt("n", "n\x{327}")); +ok($objLv->gt("o", "n\x{327}")); +ok($objLv->lt("r", "r\x{327}")); +ok($objLv->gt("s", "r\x{327}")); +ok($objLv->lt("s", "s\x{30C}")); +ok($objLv->gt("t", "s\x{30C}")); +ok($objLv->lt("z", "z\x{30C}")); +ok($objLv->lt("z\x{30C}", "\x{292}")); + +# 18 + +$objLv->change(level => 2); + +ok($objLv->eq("c\x{30C}", "C\x{30C}")); +ok($objLv->eq("g\x{327}", "G\x{327}")); +ok($objLv->eq("k\x{327}", "K\x{327}")); +ok($objLv->eq("l\x{327}", "L\x{327}")); +ok($objLv->eq("n\x{327}", "N\x{327}")); +ok($objLv->eq("r\x{327}", "R\x{327}")); +ok($objLv->eq("s\x{30C}", "S\x{30C}")); +ok($objLv->eq("z\x{30C}", "Z\x{30C}")); + +# 26 + +$objLv->change(level => 3); + +ok($objLv->lt("c\x{30C}", "C\x{30C}")); +ok($objLv->lt("g\x{327}", "G\x{327}")); +ok($objLv->lt("k\x{327}", "K\x{327}")); +ok($objLv->lt("l\x{327}", "L\x{327}")); +ok($objLv->lt("n\x{327}", "N\x{327}")); +ok($objLv->lt("r\x{327}", "R\x{327}")); +ok($objLv->lt("s\x{30C}", "S\x{30C}")); +ok($objLv->lt("z\x{30C}", "Z\x{30C}")); + +# 34 + +ok($objLv->eq("c\x{30C}", "\x{10D}")); +ok($objLv->eq("C\x{30C}", "\x{10C}")); +ok($objLv->eq("g\x{327}", "\x{123}")); +ok($objLv->eq("G\x{327}", "\x{122}")); +ok($objLv->eq("k\x{327}", "\x{137}")); +ok($objLv->eq("K\x{327}", "\x{136}")); +ok($objLv->eq("l\x{327}", "\x{13C}")); +ok($objLv->eq("L\x{327}", "\x{13B}")); +ok($objLv->eq("n\x{327}", "\x{146}")); +ok($objLv->eq("N\x{327}", "\x{145}")); +ok($objLv->eq("r\x{327}", "\x{157}")); +ok($objLv->eq("R\x{327}", "\x{156}")); +ok($objLv->eq("s\x{30C}", "\x{161}")); +ok($objLv->eq("S\x{30C}", "\x{160}")); +ok($objLv->eq("z\x{30C}", "\x{17E}")); +ok($objLv->eq("Z\x{30C}", "\x{17D}")); + +# 50 diff --git a/cpan/Unicode-Collate/t/loc_sk.t b/cpan/Unicode-Collate/t/loc_sk.t new file mode 100644 index 0000000000..cf762f7bce --- /dev/null +++ b/cpan/Unicode-Collate/t/loc_sk.t @@ -0,0 +1,69 @@ +#!perl +use strict; +use warnings; +use Unicode::Collate::Locale; + +use Test; +plan tests => 40; + +my $objSk = Unicode::Collate::Locale-> + new(locale => 'SK', normalization => undef); + +ok(1); +ok($objSk->getlocale, 'sk'); + +$objSk->change(level => 1); + +ok($objSk->lt("a", "a\x{308}")); +ok($objSk->gt("b", "a\x{308}")); +ok($objSk->lt("c", "c\x{30C}")); +ok($objSk->gt("d", "c\x{30C}")); +ok($objSk->lt("h", "ch")); +ok($objSk->gt("i", "ch")); +ok($objSk->lt("o", "o\x{302}")); +ok($objSk->gt("p", "o\x{302}")); +ok($objSk->lt("s", "s\x{30C}")); +ok($objSk->gt("t", "s\x{30C}")); +ok($objSk->lt("z", "z\x{30C}")); +ok($objSk->lt("z\x{30C}", "\x{292}")); # U+0292 EZH + +# 14 + +$objSk->change(level => 2); + +ok($objSk->eq("a\x{308}", "A\x{308}")); +ok($objSk->eq("c\x{30C}", "C\x{30C}")); +ok($objSk->eq("o\x{302}", "O\x{302}")); +ok($objSk->eq("s\x{30C}", "S\x{30C}")); +ok($objSk->eq("z\x{30C}", "Z\x{30C}")); +ok($objSk->eq("ch", "cH")); +ok($objSk->eq("cH", "Ch")); +ok($objSk->eq("Ch", "CH")); + +# 22 + +$objSk->change(level => 3); + +ok($objSk->lt("a\x{308}", "A\x{308}")); +ok($objSk->lt("c\x{30C}", "C\x{30C}")); +ok($objSk->lt("o\x{302}", "O\x{302}")); +ok($objSk->lt("s\x{30C}", "S\x{30C}")); +ok($objSk->lt("z\x{30C}", "Z\x{30C}")); +ok($objSk->lt("ch", "cH")); +ok($objSk->lt("cH", "Ch")); +ok($objSk->lt("Ch", "CH")); + +# 30 + +ok($objSk->eq("a\x{308}", pack('U', 0xE4))); +ok($objSk->eq("A\x{308}", pack('U', 0xC4))); +ok($objSk->eq("c\x{30C}", "\x{10D}")); +ok($objSk->eq("C\x{30C}", "\x{10C}")); +ok($objSk->eq("o\x{302}", pack('U', 0xF4))); +ok($objSk->eq("O\x{302}", pack('U', 0xD4))); +ok($objSk->eq("s\x{30C}", "\x{161}")); +ok($objSk->eq("S\x{30C}", "\x{160}")); +ok($objSk->eq("z\x{30C}", "\x{17E}")); +ok($objSk->eq("Z\x{30C}", "\x{17D}")); + +# 40 diff --git a/cpan/Unicode-Collate/t/loc_sl.t b/cpan/Unicode-Collate/t/loc_sl.t new file mode 100644 index 0000000000..0c5ddbbec5 --- /dev/null +++ b/cpan/Unicode-Collate/t/loc_sl.t @@ -0,0 +1,49 @@ +#!perl +use strict; +use warnings; +use Unicode::Collate::Locale; + +use Test; +plan tests => 20; + +my $objSl = Unicode::Collate::Locale-> + new(locale => 'SL', normalization => undef); + +ok(1); +ok($objSl->getlocale, 'sl'); + +$objSl->change(level => 1); + +ok($objSl->lt("c", "c\x{30C}")); +ok($objSl->gt("d", "c\x{30C}")); +ok($objSl->lt("s", "s\x{30C}")); +ok($objSl->gt("t", "s\x{30C}")); +ok($objSl->lt("z", "z\x{30C}")); +ok($objSl->lt("z\x{30C}", "\x{292}")); # U+0292 EZH + +# 8 + +$objSl->change(level => 2); + +ok($objSl->eq("c\x{30C}", "C\x{30C}")); +ok($objSl->eq("s\x{30C}", "S\x{30C}")); +ok($objSl->eq("z\x{30C}", "Z\x{30C}")); + +# 11 + +$objSl->change(level => 3); + +ok($objSl->lt("c\x{30C}", "C\x{30C}")); +ok($objSl->lt("s\x{30C}", "S\x{30C}")); +ok($objSl->lt("z\x{30C}", "Z\x{30C}")); + +# 14 + +ok($objSl->eq("c\x{30C}", "\x{10D}")); +ok($objSl->eq("C\x{30C}", "\x{10C}")); +ok($objSl->eq("s\x{30C}", "\x{161}")); +ok($objSl->eq("S\x{30C}", "\x{160}")); +ok($objSl->eq("z\x{30C}", "\x{17E}")); +ok($objSl->eq("Z\x{30C}", "\x{17D}")); + +# 20 diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c index 21ec98cd6e..aa6938d279 100644 --- a/cygwin/cygwin.c +++ b/cygwin/cygwin.c @@ -51,12 +51,14 @@ do_aspawn (SV *really, void **mark, void **sp) { dTHX; int rc; - char **a,*tmps,**argv; - STRLEN n_a; + char const **a; + char *tmps,**argv; + STRLEN n_a; if (sp<=mark) return -1; - a=argv=(char**) alloca ((sp-mark+3)*sizeof (char*)); + argv=(char**) alloca ((sp-mark+3)*sizeof (char*)); + a=(char const **)argv; while (++mark <= sp) if (*mark) @@ -84,7 +86,8 @@ do_spawn (char *cmd) { dTHX; char const **a; - char *s,*metachars = "$&*(){}[]'\";\\?>|<~`\n"; + char *s; + char const *metachars = "$&*(){}[]'\";\\?>|<~`\n"; const char *command[4]; while (*cmd && isSPACE(*cmd)) @@ -355,7 +358,7 @@ void init_os_extras(void) { dTHX; - char *file = __FILE__; + char const *file = __FILE__; void *handle; newXS("Cwd::cwd", Cygwin_cwd, file); diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index c5c64da26a..f4af584614 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -2,7 +2,7 @@ package Module::CoreList; use strict; use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated/; -$VERSION = '2.37'; +$VERSION = '2.38'; =head1 NAME @@ -167,8 +167,8 @@ Module::CoreList currently covers the 5.000, 5.001, 5.002, 5.003_07, 5.004, 5.004_05, 5.005, 5.005_03, 5.005_04, 5.6.0, 5.6.1, 5.6.2, 5.7.3, 5.8.0, 5.8.1, 5.8.2, 5.8.3, 5.8.4, 5.8.5, 5.8.6, 5.8.7, 5.8.8, 5.8.9, 5.9.0, 5.9.1, 5.9.2, 5.9.3, 5.9.4, 5.9.5, 5.10.0, 5.10.1, 5.11.0, 5.11.1, -5.11.2, 5.11.3, 5.11.4, 5.11.5, 5.12.0, 5.12.1, 5.13.0, 5.13.1, 5.13.2, -5.13.3 and 5.13.4 releases of perl. +5.11.2, 5.11.3, 5.11.4, 5.11.5, 5.12.0, 5.12.1, 5.12.2, 5.13.0, 5.13.1, +5.13.2, 5.13.3 and 5.13.4 releases of perl. =head1 HISTORY @@ -335,6 +335,7 @@ sub removed_raw { 5.013002 => '2010-06-22', 5.013003 => '2010-07-20', 5.013004 => '2010-08-20', + 5.012002 => '2010-09-01', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -17949,6 +17950,630 @@ for my $version ( sort { $a <=> $b } keys %released ) { 'warnings' => '1.10', 'warnings::register' => '1.01', }, + 5.012002 => { + 'AnyDBM_File' => '1.00', + 'App::Cpan' => '1.5701', + 'App::Prove' => '3.17', + 'App::Prove::State' => '3.17', + 'App::Prove::State::Result'=> '3.17', + 'App::Prove::State::Result::Test'=> '3.17', + 'Archive::Extract' => '0.38', + 'Archive::Tar' => '1.54', + 'Archive::Tar::Constant'=> '0.02', + 'Archive::Tar::File' => '0.02', + 'Attribute::Handlers' => '0.87', + 'AutoLoader' => '5.70', + 'AutoSplit' => '1.06', + 'B' => '1.23', + 'B::Concise' => '0.78', + 'B::Debug' => '1.12', + 'B::Deparse' => '0.97', + 'B::Lint' => '1.11_01', + 'B::Lint::Debug' => '0.01', + 'B::Showlex' => '1.02', + 'B::Terse' => '1.05', + 'B::Xref' => '1.02', + 'Benchmark' => '1.11', + 'CGI' => '3.49', + 'CGI::Apache' => '1.01', + 'CGI::Carp' => '3.45', + 'CGI::Cookie' => '1.29', + 'CGI::Fast' => '1.08', + 'CGI::Pretty' => '3.46', + 'CGI::Push' => '1.04', + 'CGI::Switch' => '1.01', + 'CGI::Util' => '3.48', + 'CPAN' => '1.94_56', + 'CPAN::Author' => '5.5', + 'CPAN::Bundle' => '5.5', + 'CPAN::CacheMgr' => '5.5', + 'CPAN::Complete' => '5.5', + 'CPAN::Debug' => '5.5001', + 'CPAN::DeferredCode' => '5.50', + 'CPAN::Distribution' => '1.9456_01', + 'CPAN::Distroprefs' => '6', + 'CPAN::Distrostatus' => '5.5', + 'CPAN::Exception::RecursiveDependency'=> '5.5', + 'CPAN::Exception::blocked_urllist'=> '1.0', + 'CPAN::Exception::yaml_not_installed'=> '5.5', + 'CPAN::FTP' => '5.5004', + 'CPAN::FTP::netrc' => '1.00', + 'CPAN::FirstTime' => '5.5301', + 'CPAN::HandleConfig' => '5.5001', + 'CPAN::Index' => '1.94', + 'CPAN::InfoObj' => '5.5', + 'CPAN::Kwalify' => '5.50', + 'CPAN::LWP::UserAgent' => '1.94', + 'CPAN::Mirrors' => '1.77', + 'CPAN::Module' => '5.5', + 'CPAN::Nox' => '5.50', + 'CPAN::Prompt' => '5.5', + 'CPAN::Queue' => '5.5', + 'CPAN::Shell' => '5.5001', + 'CPAN::Tarzip' => '5.5011', + 'CPAN::URL' => '5.5', + 'CPAN::Version' => '5.5', + 'CPANPLUS' => '0.90', + 'CPANPLUS::Backend' => undef, + 'CPANPLUS::Backend::RV' => undef, + 'CPANPLUS::Config' => undef, + 'CPANPLUS::Configure' => undef, + 'CPANPLUS::Configure::Setup'=> undef, + 'CPANPLUS::Dist' => undef, + 'CPANPLUS::Dist::Autobundle'=> undef, + 'CPANPLUS::Dist::Base' => undef, + 'CPANPLUS::Dist::Build' => '0.46', + 'CPANPLUS::Dist::Build::Constants'=> '0.46', + 'CPANPLUS::Dist::MM' => undef, + 'CPANPLUS::Dist::Sample'=> undef, + 'CPANPLUS::Error' => undef, + 'CPANPLUS::Internals' => '0.90', + 'CPANPLUS::Internals::Constants'=> undef, + 'CPANPLUS::Internals::Constants::Report'=> undef, + 'CPANPLUS::Internals::Extract'=> undef, + 'CPANPLUS::Internals::Fetch'=> undef, + 'CPANPLUS::Internals::Report'=> undef, + 'CPANPLUS::Internals::Search'=> undef, + 'CPANPLUS::Internals::Source'=> undef, + 'CPANPLUS::Internals::Source::Memory'=> undef, + 'CPANPLUS::Internals::Source::SQLite'=> undef, + 'CPANPLUS::Internals::Source::SQLite::Tie'=> undef, + 'CPANPLUS::Internals::Utils'=> undef, + 'CPANPLUS::Internals::Utils::Autoflush'=> undef, + 'CPANPLUS::Module' => undef, + 'CPANPLUS::Module::Author'=> undef, + 'CPANPLUS::Module::Author::Fake'=> undef, + 'CPANPLUS::Module::Checksums'=> undef, + 'CPANPLUS::Module::Fake'=> undef, + 'CPANPLUS::Module::Signature'=> undef, + 'CPANPLUS::Selfupdate' => undef, + 'CPANPLUS::Shell' => undef, + 'CPANPLUS::Shell::Classic'=> '0.0562', + 'CPANPLUS::Shell::Default'=> '0.90', + 'CPANPLUS::Shell::Default::Plugins::CustomSource'=> undef, + 'CPANPLUS::Shell::Default::Plugins::Remote'=> undef, + 'CPANPLUS::Shell::Default::Plugins::Source'=> undef, + 'Carp' => '1.17', + 'Carp::Heavy' => '1.17', + 'Class::ISA' => '0.36', + 'Class::Struct' => '0.63', + 'Compress::Raw::Bzip2' => '2.024', + 'Compress::Raw::Zlib' => '2.024', + 'Compress::Zlib' => '2.024', + 'Config' => undef, + 'Config::Extensions' => '0.01', + 'Cwd' => '3.31', + 'DB' => '1.02', + 'DBM_Filter' => '0.03', + 'DBM_Filter::compress' => '0.02', + 'DBM_Filter::encode' => '0.02', + 'DBM_Filter::int32' => '0.02', + 'DBM_Filter::null' => '0.02', + 'DBM_Filter::utf8' => '0.02', + 'DB_File' => '1.820', + 'Data::Dumper' => '2.125', + 'Devel::DProf' => '20080331.00', + 'Devel::DProf::dprof::V'=> undef, + 'Devel::InnerPackage' => '0.3', + 'Devel::PPPort' => '3.19', + 'Devel::Peek' => '1.04', + 'Devel::SelfStubber' => '1.03', + 'Digest' => '1.16', + 'Digest::MD5' => '2.39', + 'Digest::SHA' => '5.47', + 'Digest::base' => '1.16', + 'Digest::file' => '1.16', + 'DirHandle' => '1.03', + 'Dumpvalue' => '1.13', + 'DynaLoader' => '1.10', + 'Encode' => '2.39', + 'Encode::Alias' => '2.12', + 'Encode::Byte' => '2.04', + 'Encode::CJKConstants' => '2.02', + 'Encode::CN' => '2.03', + 'Encode::CN::HZ' => '2.05', + 'Encode::Config' => '2.05', + 'Encode::EBCDIC' => '2.02', + 'Encode::Encoder' => '2.01', + 'Encode::Encoding' => '2.05', + 'Encode::GSM0338' => '2.01', + 'Encode::Guess' => '2.03', + 'Encode::JP' => '2.04', + 'Encode::JP::H2Z' => '2.02', + 'Encode::JP::JIS7' => '2.04', + 'Encode::KR' => '2.03', + 'Encode::KR::2022_KR' => '2.02', + 'Encode::MIME::Header' => '2.11', + 'Encode::MIME::Header::ISO_2022_JP'=> '1.03', + 'Encode::MIME::Name' => '1.01', + 'Encode::Symbol' => '2.02', + 'Encode::TW' => '2.03', + 'Encode::Unicode' => '2.07', + 'Encode::Unicode::UTF7' => '2.04', + 'English' => '1.04', + 'Env' => '1.01', + 'Errno' => '1.11', + 'Exporter' => '5.64_01', + 'Exporter::Heavy' => '5.64_01', + 'ExtUtils::CBuilder' => '0.27', + 'ExtUtils::CBuilder::Base'=> '0.27', + 'ExtUtils::CBuilder::Platform::Unix'=> '0.27', + 'ExtUtils::CBuilder::Platform::VMS'=> '0.27', + 'ExtUtils::CBuilder::Platform::Windows'=> '0.27', + 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.27', + 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.27', + 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.27', + 'ExtUtils::CBuilder::Platform::aix'=> '0.27', + 'ExtUtils::CBuilder::Platform::cygwin'=> '0.27', + 'ExtUtils::CBuilder::Platform::darwin'=> '0.27', + 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.27', + 'ExtUtils::CBuilder::Platform::os2'=> '0.27', + 'ExtUtils::Command' => '1.16', + 'ExtUtils::Command::MM' => '6.56', + 'ExtUtils::Constant' => '0.22', + 'ExtUtils::Constant::Base'=> '0.04', + 'ExtUtils::Constant::ProxySubs'=> '0.06', + 'ExtUtils::Constant::Utils'=> '0.02', + 'ExtUtils::Constant::XS'=> '0.03', + 'ExtUtils::Embed' => '1.28', + 'ExtUtils::Install' => '1.55', + 'ExtUtils::Installed' => '1.999_001', + 'ExtUtils::Liblist' => '6.56', + 'ExtUtils::Liblist::Kid'=> '6.56', + 'ExtUtils::MM' => '6.56', + 'ExtUtils::MM_AIX' => '6.56', + 'ExtUtils::MM_Any' => '6.56', + 'ExtUtils::MM_BeOS' => '6.56', + 'ExtUtils::MM_Cygwin' => '6.56', + 'ExtUtils::MM_DOS' => '6.56', + 'ExtUtils::MM_Darwin' => '6.56', + 'ExtUtils::MM_MacOS' => '6.56', + 'ExtUtils::MM_NW5' => '6.56', + 'ExtUtils::MM_OS2' => '6.56', + 'ExtUtils::MM_QNX' => '6.56', + 'ExtUtils::MM_UWIN' => '6.56', + 'ExtUtils::MM_Unix' => '6.56', + 'ExtUtils::MM_VMS' => '6.56', + 'ExtUtils::MM_VOS' => '6.56', + 'ExtUtils::MM_Win32' => '6.56', + 'ExtUtils::MM_Win95' => '6.56', + 'ExtUtils::MY' => '6.56', + 'ExtUtils::MakeMaker' => '6.56', + 'ExtUtils::MakeMaker::Config'=> '6.56', + 'ExtUtils::Manifest' => '1.57', + 'ExtUtils::Miniperl' => undef, + 'ExtUtils::Mkbootstrap' => '6.56', + 'ExtUtils::Mksymlists' => '6.56', + 'ExtUtils::Packlist' => '1.44', + 'ExtUtils::ParseXS' => '2.21', + 'ExtUtils::XSSymSet' => '1.1', + 'ExtUtils::testlib' => '6.56', + 'Fatal' => '2.06_01', + 'Fcntl' => '1.06', + 'File::Basename' => '2.78', + 'File::CheckTree' => '4.4', + 'File::Compare' => '1.1006', + 'File::Copy' => '2.18', + 'File::DosGlob' => '1.01', + 'File::Fetch' => '0.24', + 'File::Find' => '1.15', + 'File::Glob' => '1.07', + 'File::GlobMapper' => '1.000', + 'File::Path' => '2.08_01', + 'File::Spec' => '3.31_01', + 'File::Spec::Cygwin' => '3.30', + 'File::Spec::Epoc' => '3.30', + 'File::Spec::Functions' => '3.30', + 'File::Spec::Mac' => '3.30', + 'File::Spec::OS2' => '3.30', + 'File::Spec::Unix' => '3.30', + 'File::Spec::VMS' => '3.30', + 'File::Spec::Win32' => '3.30', + 'File::Temp' => '0.22', + 'File::stat' => '1.02', + 'FileCache' => '1.08', + 'FileHandle' => '2.02', + 'Filter::Simple' => '0.84', + 'Filter::Util::Call' => '1.08', + 'FindBin' => '1.50', + 'GDBM_File' => '1.10', + 'Getopt::Long' => '2.38', + 'Getopt::Std' => '1.06', + 'Hash::Util' => '0.07', + 'Hash::Util::FieldHash' => '1.04', + 'I18N::Collate' => '1.01', + 'I18N::LangTags' => '0.35', + 'I18N::LangTags::Detect'=> '1.04', + 'I18N::LangTags::List' => '0.35', + 'I18N::Langinfo' => '0.03', + 'IO' => '1.25_02', + 'IO::Compress::Adapter::Bzip2'=> '2.024', + 'IO::Compress::Adapter::Deflate'=> '2.024', + 'IO::Compress::Adapter::Identity'=> '2.024', + 'IO::Compress::Base' => '2.024', + 'IO::Compress::Base::Common'=> '2.024', + 'IO::Compress::Bzip2' => '2.024', + 'IO::Compress::Deflate' => '2.024', + 'IO::Compress::Gzip' => '2.024', + 'IO::Compress::Gzip::Constants'=> '2.024', + 'IO::Compress::RawDeflate'=> '2.024', + 'IO::Compress::Zip' => '2.024', + 'IO::Compress::Zip::Constants'=> '2.024', + 'IO::Compress::Zlib::Constants'=> '2.024', + 'IO::Compress::Zlib::Extra'=> '2.024', + 'IO::Dir' => '1.07', + 'IO::File' => '1.14', + 'IO::Handle' => '1.28', + 'IO::Pipe' => '1.13', + 'IO::Poll' => '0.07', + 'IO::Seekable' => '1.10', + 'IO::Select' => '1.17', + 'IO::Socket' => '1.31', + 'IO::Socket::INET' => '1.31', + 'IO::Socket::UNIX' => '1.23', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.024', + 'IO::Uncompress::Adapter::Identity'=> '2.024', + 'IO::Uncompress::Adapter::Inflate'=> '2.024', + 'IO::Uncompress::AnyInflate'=> '2.024', + 'IO::Uncompress::AnyUncompress'=> '2.024', + 'IO::Uncompress::Base' => '2.024', + 'IO::Uncompress::Bunzip2'=> '2.024', + 'IO::Uncompress::Gunzip'=> '2.024', + 'IO::Uncompress::Inflate'=> '2.024', + 'IO::Uncompress::RawInflate'=> '2.024', + 'IO::Uncompress::Unzip' => '2.024', + 'IO::Zlib' => '1.10', + 'IPC::Cmd' => '0.54', + 'IPC::Msg' => '2.01', + 'IPC::Open2' => '1.03', + 'IPC::Open3' => '1.05', + 'IPC::Semaphore' => '2.01', + 'IPC::SharedMem' => '2.01', + 'IPC::SysV' => '2.01', + 'List::Util' => '1.22', + 'List::Util::PP' => '1.22', + 'List::Util::XS' => '1.22', + 'Locale::Constants' => '2.07', + 'Locale::Country' => '2.07', + 'Locale::Currency' => '2.07', + 'Locale::Language' => '2.07', + 'Locale::Maketext' => '1.14', + 'Locale::Maketext::Guts'=> '1.13', + 'Locale::Maketext::GutsLoader'=> '1.13', + 'Locale::Maketext::Simple'=> '0.21', + 'Locale::Script' => '2.07', + 'Log::Message' => '0.02', + 'Log::Message::Config' => '0.01', + 'Log::Message::Handlers'=> undef, + 'Log::Message::Item' => undef, + 'Log::Message::Simple' => '0.06', + 'MIME::Base64' => '3.08', + 'MIME::QuotedPrint' => '3.08', + 'Math::BigFloat' => '1.60', + 'Math::BigFloat::Trace' => '0.01', + 'Math::BigInt' => '1.89_01', + 'Math::BigInt::Calc' => '0.52', + 'Math::BigInt::CalcEmu' => '0.05', + 'Math::BigInt::FastCalc'=> '0.19', + 'Math::BigInt::Trace' => '0.01', + 'Math::BigRat' => '0.24', + 'Math::Complex' => '1.56', + 'Math::Trig' => '1.2', + 'Memoize' => '1.01_03', + 'Memoize::AnyDBM_File' => '0.65', + 'Memoize::Expire' => '1.00', + 'Memoize::ExpireFile' => '1.01', + 'Memoize::ExpireTest' => '0.65', + 'Memoize::NDBM_File' => '0.65', + 'Memoize::SDBM_File' => '0.65', + 'Memoize::Storable' => '0.65', + 'Module::Build' => '0.3603', + 'Module::Build::Base' => '0.3603', + 'Module::Build::Compat' => '0.3603', + 'Module::Build::Config' => '0.3603', + 'Module::Build::ConfigData'=> undef, + 'Module::Build::Cookbook'=> '0.3603', + 'Module::Build::Dumper' => '0.3603', + 'Module::Build::ModuleInfo'=> '0.3603', + 'Module::Build::Notes' => '0.3603', + 'Module::Build::PPMMaker'=> '0.3603', + 'Module::Build::Platform::Amiga'=> '0.3603', + 'Module::Build::Platform::Default'=> '0.3603', + 'Module::Build::Platform::EBCDIC'=> '0.3603', + 'Module::Build::Platform::MPEiX'=> '0.3603', + 'Module::Build::Platform::MacOS'=> '0.3603', + 'Module::Build::Platform::RiscOS'=> '0.3603', + 'Module::Build::Platform::Unix'=> '0.3603', + 'Module::Build::Platform::VMS'=> '0.3603', + 'Module::Build::Platform::VOS'=> '0.3603', + 'Module::Build::Platform::Windows'=> '0.3603', + 'Module::Build::Platform::aix'=> '0.3603', + 'Module::Build::Platform::cygwin'=> '0.3603', + 'Module::Build::Platform::darwin'=> '0.3603', + 'Module::Build::Platform::os2'=> '0.3603', + 'Module::Build::PodParser'=> '0.3603', + 'Module::Build::Version'=> '0.77', + 'Module::Build::YAML' => '1.40', + 'Module::CoreList' => '2.37', + 'Module::Load' => '0.16', + 'Module::Load::Conditional'=> '0.38', + 'Module::Loaded' => '0.06', + 'Module::Pluggable' => '3.9', + 'Module::Pluggable::Object'=> '3.9', + 'Moped::Msg' => '0.01', + 'NDBM_File' => '1.08', + 'NEXT' => '0.64', + 'Net::Cmd' => '2.29', + 'Net::Config' => '1.11', + 'Net::Domain' => '2.20', + 'Net::FTP' => '2.77', + 'Net::FTP::A' => '1.18', + 'Net::FTP::E' => '0.01', + 'Net::FTP::I' => '1.12', + 'Net::FTP::L' => '0.01', + 'Net::FTP::dataconn' => '0.11', + 'Net::NNTP' => '2.24', + 'Net::Netrc' => '2.12', + 'Net::POP3' => '2.29', + 'Net::Ping' => '2.36', + 'Net::SMTP' => '2.31', + 'Net::Time' => '2.10', + 'Net::hostent' => '1.01', + 'Net::netent' => '1.00', + 'Net::protoent' => '1.00', + 'Net::servent' => '1.01', + 'O' => '1.01', + 'ODBM_File' => '1.07', + 'Object::Accessor' => '0.36', + 'Opcode' => '1.15', + 'POSIX' => '1.19', + 'Package::Constants' => '0.02', + 'Params::Check' => '0.26', + 'Parse::CPAN::Meta' => '1.40', + 'PerlIO' => '1.06', + 'PerlIO::encoding' => '0.12', + 'PerlIO::scalar' => '0.08', + 'PerlIO::via' => '0.09', + 'PerlIO::via::QuotedPrint'=> '0.06', + 'Pod::Checker' => '1.45', + 'Pod::Escapes' => '1.04', + 'Pod::Find' => '1.35', + 'Pod::Functions' => '1.04', + 'Pod::Html' => '1.09', + 'Pod::InputObjects' => '1.31', + 'Pod::LaTeX' => '0.58', + 'Pod::Man' => '2.23', + 'Pod::ParseLink' => '1.10', + 'Pod::ParseUtils' => '1.36', + 'Pod::Parser' => '1.37', + 'Pod::Perldoc' => '3.15_02', + 'Pod::Perldoc::BaseTo' => undef, + 'Pod::Perldoc::GetOptsOO'=> undef, + 'Pod::Perldoc::ToChecker'=> undef, + 'Pod::Perldoc::ToMan' => undef, + 'Pod::Perldoc::ToNroff' => undef, + 'Pod::Perldoc::ToPod' => undef, + 'Pod::Perldoc::ToRtf' => undef, + 'Pod::Perldoc::ToText' => undef, + 'Pod::Perldoc::ToTk' => undef, + 'Pod::Perldoc::ToXml' => undef, + 'Pod::PlainText' => '2.04', + 'Pod::Plainer' => '1.02', + 'Pod::Select' => '1.36', + 'Pod::Simple' => '3.14', + 'Pod::Simple::BlackBox' => '3.14', + 'Pod::Simple::Checker' => '3.14', + 'Pod::Simple::Debug' => '3.14', + 'Pod::Simple::DumpAsText'=> '3.14', + 'Pod::Simple::DumpAsXML'=> '3.14', + 'Pod::Simple::HTML' => '3.14', + 'Pod::Simple::HTMLBatch'=> '3.14', + 'Pod::Simple::HTMLLegacy'=> '5.01', + 'Pod::Simple::LinkSection'=> '3.14', + 'Pod::Simple::Methody' => '3.14', + 'Pod::Simple::Progress' => '3.14', + 'Pod::Simple::PullParser'=> '3.14', + 'Pod::Simple::PullParserEndToken'=> '3.14', + 'Pod::Simple::PullParserStartToken'=> '3.14', + 'Pod::Simple::PullParserTextToken'=> '3.14', + 'Pod::Simple::PullParserToken'=> '3.14', + 'Pod::Simple::RTF' => '3.14', + 'Pod::Simple::Search' => '3.14', + 'Pod::Simple::SimpleTree'=> '3.14', + 'Pod::Simple::Text' => '3.14', + 'Pod::Simple::TextContent'=> '3.14', + 'Pod::Simple::TiedOutFH'=> '3.14', + 'Pod::Simple::Transcode'=> '3.14', + 'Pod::Simple::TranscodeDumb'=> '3.14', + 'Pod::Simple::TranscodeSmart'=> '3.14', + 'Pod::Simple::XHTML' => '3.14', + 'Pod::Simple::XMLOutStream'=> '3.14', + 'Pod::Text' => '3.14', + 'Pod::Text::Color' => '2.06', + 'Pod::Text::Overstrike' => '2.04', + 'Pod::Text::Termcap' => '2.06', + 'Pod::Usage' => '1.36', + 'SDBM_File' => '1.06', + 'Safe' => '2.27', + 'Scalar::Util' => '1.22', + 'Scalar::Util::PP' => '1.22', + 'Search::Dict' => '1.02', + 'SelectSaver' => '1.02', + 'SelfLoader' => '1.17', + 'Shell' => '0.72_01', + 'Socket' => '1.87', + 'Storable' => '2.22', + 'Switch' => '2.16', + 'Symbol' => '1.07', + 'Sys::Hostname' => '1.11', + 'Sys::Syslog' => '0.27', + 'Sys::Syslog::win32::Win32'=> undef, + 'TAP::Base' => '3.17', + 'TAP::Formatter::Base' => '3.17', + 'TAP::Formatter::Color' => '3.17', + 'TAP::Formatter::Console'=> '3.17', + 'TAP::Formatter::Console::ParallelSession'=> '3.17', + 'TAP::Formatter::Console::Session'=> '3.17', + 'TAP::Formatter::File' => '3.17', + 'TAP::Formatter::File::Session'=> '3.17', + 'TAP::Formatter::Session'=> '3.17', + 'TAP::Harness' => '3.17', + 'TAP::Object' => '3.17', + 'TAP::Parser' => '3.17', + 'TAP::Parser::Aggregator'=> '3.17', + 'TAP::Parser::Grammar' => '3.17', + 'TAP::Parser::Iterator' => '3.17', + 'TAP::Parser::Iterator::Array'=> '3.17', + 'TAP::Parser::Iterator::Process'=> '3.17', + 'TAP::Parser::Iterator::Stream'=> '3.17', + 'TAP::Parser::IteratorFactory'=> '3.17', + 'TAP::Parser::Multiplexer'=> '3.17', + 'TAP::Parser::Result' => '3.17', + 'TAP::Parser::Result::Bailout'=> '3.17', + 'TAP::Parser::Result::Comment'=> '3.17', + 'TAP::Parser::Result::Plan'=> '3.17', + 'TAP::Parser::Result::Pragma'=> '3.17', + 'TAP::Parser::Result::Test'=> '3.17', + 'TAP::Parser::Result::Unknown'=> '3.17', + 'TAP::Parser::Result::Version'=> '3.17', + 'TAP::Parser::Result::YAML'=> '3.17', + 'TAP::Parser::ResultFactory'=> '3.17', + 'TAP::Parser::Scheduler'=> '3.17', + 'TAP::Parser::Scheduler::Job'=> '3.17', + 'TAP::Parser::Scheduler::Spinner'=> '3.17', + 'TAP::Parser::Source' => '3.17', + 'TAP::Parser::Source::Perl'=> '3.17', + 'TAP::Parser::Utils' => '3.17', + 'TAP::Parser::YAMLish::Reader'=> '3.17', + 'TAP::Parser::YAMLish::Writer'=> '3.17', + 'Term::ANSIColor' => '2.02', + 'Term::Cap' => '1.12', + 'Term::Complete' => '1.402', + 'Term::ReadLine' => '1.05', + 'Term::UI' => '0.20', + 'Term::UI::History' => undef, + 'Test' => '1.25_02', + 'Test::Builder' => '0.94', + 'Test::Builder::Module' => '0.94', + 'Test::Builder::Tester' => '1.18', + 'Test::Builder::Tester::Color'=> '1.18', + 'Test::Harness' => '3.17', + 'Test::More' => '0.94', + 'Test::Simple' => '0.94', + 'Text::Abbrev' => '1.01', + 'Text::Balanced' => '2.02', + 'Text::ParseWords' => '3.27', + 'Text::Soundex' => '3.03_01', + 'Text::Tabs' => '2009.0305', + 'Text::Wrap' => '2009.0305', + 'Thread' => '3.02', + 'Thread::Queue' => '2.11', + 'Thread::Semaphore' => '2.09', + 'Tie::Array' => '1.03', + 'Tie::File' => '0.97_02', + 'Tie::Handle' => '4.2', + 'Tie::Hash' => '1.03', + 'Tie::Hash::NamedCapture'=> '0.06', + 'Tie::Memoize' => '1.1', + 'Tie::RefHash' => '1.38', + 'Tie::Scalar' => '1.02', + 'Tie::StdHandle' => '4.2', + 'Tie::SubstrHash' => '1.00', + 'Time::HiRes' => '1.9719', + 'Time::Local' => '1.1901_01', + 'Time::Piece' => '1.15_01', + 'Time::Piece::Seconds' => undef, + 'Time::Seconds' => undef, + 'Time::gmtime' => '1.03', + 'Time::localtime' => '1.02', + 'Time::tm' => '1.00', + 'UNIVERSAL' => '1.06', + 'Unicode' => '5.2.0', + 'Unicode::Collate' => '0.52_01', + 'Unicode::Normalize' => '1.03', + 'Unicode::UCD' => '0.27', + 'User::grent' => '1.01', + 'User::pwent' => '1.00', + 'VMS::DCLsym' => '1.03', + 'VMS::Filespec' => '1.12', + 'VMS::Stdio' => '2.4', + 'Win32' => '0.39', + 'Win32API::File' => '0.1101', + 'Win32API::File::ExtUtils::Myconst2perl'=> '1', + 'Win32CORE' => '0.02', + 'XS::APItest' => '0.17', + 'XS::APItest::KeywordRPN'=> '0.003', + 'XS::Typemap' => '0.03', + 'XSLoader' => '0.10', + 'XSLoader::XSLoader' => '0.10', + 'attributes' => '0.12', + 'autodie' => '2.06_01', + 'autodie::exception' => '2.06_01', + 'autodie::exception::system'=> '2.06_01', + 'autodie::hints' => '2.06_01', + 'autouse' => '1.06', + 'base' => '2.15', + 'bigint' => '0.23', + 'bignum' => '0.23', + 'bigrat' => '0.23', + 'blib' => '1.04', + 'bytes' => '1.04', + 'charnames' => '1.07', + 'constant' => '1.20', + 'deprecate' => '0.01', + 'diagnostics' => '1.19', + 'encoding' => '2.6_01', + 'encoding::warnings' => '0.11', + 'feature' => '1.16', + 'fields' => '2.15', + 'filetest' => '1.02', + 'if' => '0.05', + 'inc::latest' => '0.3603', + 'integer' => '1.00', + 'less' => '0.03', + 'lib' => '0.62', + 'locale' => '1.00', + 'mro' => '1.02', + 'open' => '1.07', + 'ops' => '1.02', + 'overload' => '1.10', + 'overload::numbers' => undef, + 'overloading' => '0.01', + 'parent' => '0.223', + 're' => '0.11', + 'sigtrap' => '1.04', + 'sort' => '2.01', + 'strict' => '1.04', + 'subs' => '1.00', + 'threads' => '1.75', + 'threads::shared' => '1.32', + 'utf8' => '1.08', + 'vars' => '1.01', + 'version' => '0.82', + 'vmsish' => '1.02', + 'warnings' => '1.09', + 'warnings::register' => '1.01', + }, ); %deprecated = ( @@ -18018,6 +18643,12 @@ for my $version ( sort { $a <=> $b } keys %released ) { 5.013004 => { 'Shell' => '1', }, + 5.012002 => { + 'Class::ISA' => '1', + 'Pod::Plainer' => '1', + 'Shell' => '1', + 'Switch' => '1', + }, ); %upstream = ( @@ -1434,7 +1434,14 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv) Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && (hvname = HvNAME_get(sv))) - PerlIO_printf(file, "\t\"%s\"\n", hvname); + { + /* we have to use pv_display and HvNAMELEN_get() so that we display the real package + name which quite legally could contain insane things like tabs, newlines, nulls or + other scary crap - this should produce sane results - except maybe for unicode package + names - but we will wait for someone to file a bug on that - demerphq */ + SV * const tmpsv = newSVpvs(""); + PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024)); + } else PerlIO_putc(file, '\n'); } @@ -165,7 +165,7 @@ npR |MEM_SIZE|malloc_good_size |size_t nbytes AnpR |void* |get_context Anp |void |set_context |NN void *t -EXpRnP |I32 |regcurly |NN const char *s +EXpRnPM |I32 |regcurly |NN const char *s END_EXTERN_C @@ -768,26 +768,26 @@ p |void |my_unexec Apa |OP* |newANONLIST |NULLOK OP* o Apa |OP* |newANONHASH |NULLOK OP* o Ap |OP* |newANONSUB |I32 floor|NULLOK OP* proto|NULLOK OP* block -Apa |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right -Apa |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop +Apda |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right +Apda |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop Apd |CV* |newCONSTSUB |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv #ifdef PERL_MAD Ap |OP* |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block #else Ap |void |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block #endif -Apa |OP* |newFOROP |I32 flags|NULLOK char* label|line_t forline \ +Apda |OP* |newFOROP |I32 flags|NULLOK char* label|line_t forline \ |NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont -Apa |OP* |newGIVENOP |NN OP* cond|NN OP* block|PADOFFSET defsv_off -Apa |OP* |newLOGOP |I32 optype|I32 flags|NN OP *first|NN OP *other -Apa |OP* |newLOOPEX |I32 type|NN OP* label -Apa |OP* |newLOOPOP |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block -Apa |OP* |newNULLLIST -Apa |OP* |newOP |I32 optype|I32 flags +Apda |OP* |newGIVENOP |NN OP* cond|NN OP* block|PADOFFSET defsv_off +Apda |OP* |newLOGOP |I32 optype|I32 flags|NN OP *first|NN OP *other +Apda |OP* |newLOOPEX |I32 type|NN OP* label +Apda |OP* |newLOOPOP |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block +Apda |OP* |newNULLLIST +Apda |OP* |newOP |I32 optype|I32 flags Ap |void |newPROG |NN OP* o -Apa |OP* |newRANGE |I32 flags|NN OP* left|NN OP* right -Apa |OP* |newSLICEOP |I32 flags|NULLOK OP* subscript|NULLOK OP* listop -Apa |OP* |newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o +Apda |OP* |newRANGE |I32 flags|NN OP* left|NN OP* right +Apda |OP* |newSLICEOP |I32 flags|NULLOK OP* subscript|NULLOK OP* listop +Apda |OP* |newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o Ap |CV* |newSUB |I32 floor|NULLOK OP* o|NULLOK OP* proto|NULLOK OP* block ApM |CV * |newXS_flags |NULLOK const char *name|NN XSUBADDR_t subaddr\ |NN const char *const filename \ @@ -796,26 +796,26 @@ Apd |CV* |newXS |NULLOK const char *name|NN XSUBADDR_t subaddr\ |NN const char *filename AmdbR |AV* |newAV Apa |OP* |newAVREF |NN OP* o -Apa |OP* |newBINOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +Apda |OP* |newBINOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last Apa |OP* |newCVREF |I32 flags|NULLOK OP* o -Apa |OP* |newGVOP |I32 type|I32 flags|NN GV* gv +Apda |OP* |newGVOP |I32 type|I32 flags|NN GV* gv Apa |GV* |newGVgen |NN const char* pack Apa |OP* |newGVREF |I32 type|NULLOK OP* o ApaR |OP* |newHVREF |NN OP* o AmdbR |HV* |newHV ApaR |HV* |newHVhv |NULLOK HV *hv Apabm |IO* |newIO -Apa |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +Apda |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last #ifdef USE_ITHREADS -Apa |OP* |newPADOP |I32 type|I32 flags|NN SV* sv +Apda |OP* |newPADOP |I32 type|I32 flags|NN SV* sv #endif -Apa |OP* |newPMOP |I32 type|I32 flags -Apa |OP* |newPVOP |I32 type|I32 flags|NULLOK char* pv +Apda |OP* |newPMOP |I32 type|I32 flags +Apda |OP* |newPVOP |I32 type|I32 flags|NULLOK char* pv Apa |SV* |newRV |NN SV *const sv Apda |SV* |newRV_noinc |NN SV *const sv Apda |SV* |newSV |const STRLEN len Apa |OP* |newSVREF |NN OP* o -Apa |OP* |newSVOP |I32 type|I32 flags|NN SV* sv +Apda |OP* |newSVOP |I32 type|I32 flags|NN SV* sv Apda |SV* |newSViv |const IV i Apda |SV* |newSVuv |const UV u Apda |SV* |newSVnv |const NV n @@ -829,9 +829,9 @@ Apa |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname Apda |SV* |newSVsv |NULLOK SV *const old Apda |SV* |newSV_type |const svtype type -Apa |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first -Apa |OP* |newWHENOP |NULLOK OP* cond|NN OP* block -Apa |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \ +Apda |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first +Apda |OP* |newWHENOP |NULLOK OP* cond|NN OP* block +Apda |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \ |I32 whileline|NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \ |I32 has_my Apa |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems @@ -887,8 +887,9 @@ sd |void |pad_reset #endif : Used in op.c pd |void |pad_swipe |PADOFFSET po|bool refadjust -: FIXME +: peephole optimiser p |void |peep |NULLOK OP* o +p |void |rpeep |NULLOK OP* o : Defined in doio.c, used only in pp_hot.c dopM |PerlIO*|start_glob |NN SV *tmpglob|NN IO *io #if defined(USE_REENTRANT_API) @@ -706,6 +706,7 @@ #ifdef PERL_CORE #define pad_swipe Perl_pad_swipe #define peep Perl_peep +#define rpeep Perl_rpeep #endif #if defined(USE_REENTRANT_API) #define reentrant_size Perl_reentrant_size @@ -3152,6 +3153,7 @@ #ifdef PERL_CORE #define pad_swipe(a,b) Perl_pad_swipe(aTHX_ a,b) #define peep(a) Perl_peep(aTHX_ a) +#define rpeep(a) Perl_rpeep(aTHX_ a) #endif #if defined(USE_REENTRANT_API) #define reentrant_size() Perl_reentrant_size(aTHX) diff --git a/embedvar.h b/embedvar.h index 587bc94863..e57eed9d7f 100644 --- a/embedvar.h +++ b/embedvar.h @@ -258,6 +258,7 @@ #define PL_replgv (vTHX->Ireplgv) #define PL_restartjmpenv (vTHX->Irestartjmpenv) #define PL_restartop (vTHX->Irestartop) +#define PL_rpeepp (vTHX->Irpeepp) #define PL_rs (vTHX->Irs) #define PL_runops (vTHX->Irunops) #define PL_savebegin (vTHX->Isavebegin) @@ -589,6 +590,7 @@ #define PL_Ireplgv PL_replgv #define PL_Irestartjmpenv PL_restartjmpenv #define PL_Irestartop PL_restartop +#define PL_Irpeepp PL_rpeepp #define PL_Irs PL_rs #define PL_Irunops PL_runops #define PL_Isavebegin PL_savebegin diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 4e39d109e0..0b9009a315 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -8,7 +8,7 @@ BEGIN { } } -use Test::More tests => 52; +use Test::More tests => 54; use Devel::Peek; @@ -663,3 +663,25 @@ do_test(26, PADLIST = $ADDR PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\) OUTSIDE = $ADDR \\(MAIN\\)'); + +do_test(27, + (bless {}, "\0::foo::\n::baz::\t::\0"), +'SV = $RV\\($ADDR\\) at $ADDR + REFCNT = 1 + FLAGS = \\(ROK\\) + RV = $ADDR + SV = PVHV\\($ADDR\\) at $ADDR + REFCNT = 1 + FLAGS = \\(OBJECT,SHAREKEYS\\) + IV = 0 # $] < 5.009 + NV = 0 # $] < 5.009 + STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0" + ARRAY = $ADDR + KEYS = 0 + FILL = 0 + MAX = 7 + RITER = -1 + EITER = 0x0', '', + $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag' + : "Something causes the HV's array to become allocated"); + diff --git a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs index adb7e6b7bc..a5dfcd9adc 100644 --- a/ext/XS-APItest-KeywordRPN/KeywordRPN.xs +++ b/ext/XS-APItest-KeywordRPN/KeywordRPN.xs @@ -166,7 +166,7 @@ static OP *THX_parse_keyword_stufftest(pTHX) } else if(c != /*{*/'}') { croak("syntax error"); } - if(do_stuff) lex_stuff_pvn(" ", 1, 0); + if(do_stuff) lex_stuff_pvs(" ", 0); return newOP(OP_NULL, 0); } #define parse_keyword_stufftest() THX_parse_keyword_stufftest(aTHX) @@ -314,6 +314,13 @@ Like C<hv_fetch>, but takes a literal string instead of a string/length pair. Like C<hv_store>, but takes a literal string instead of a string/length pair and omits the hash parameter. +=head1 Lexer interface + +=for apidoc Amx|void|lex_stuff_pvs|const char *pv|U32 flags + +Like L</lex_stuff_pvn>, but takes a literal string instead of a +string/length pair. + =cut */ @@ -344,6 +351,8 @@ and omits the hash parameter. ((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \ (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), 0)) +#define lex_stuff_pvs(pv,flags) Perl_lex_stuff_pvn(aTHX_ STR_WITH_LEN(pv), flags) + #define get_cvs(str, flags) \ Perl_get_cvn_flags(aTHX_ STR_WITH_LEN(str), (flags)) diff --git a/intrpvar.h b/intrpvar.h index 21fb933254..503d9d666f 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -172,7 +172,9 @@ PERLVARI(Irehash_seed_set, bool, FALSE) /* 582 hash initialized? */ PERLVARA(Icolors,6, char *) /* from regcomp.c */ PERLVARI(Ipeepp, peep_t, MEMBER_TO_FPTR(Perl_peep)) - /* Pointer to peephole optimizer */ + /* Pointer to per-sub peephole optimizer */ +PERLVARI(Irpeepp, peep_t, MEMBER_TO_FPTR(Perl_rpeep)) + /* Pointer to recursive peephole optimizer */ /* =for apidoc Amn|Perl_ophook_t|PL_opfreehook diff --git a/lib/blib.pm b/lib/blib.pm index 854ec0b4f8..63855cb594 100644 --- a/lib/blib.pm +++ b/lib/blib.pm @@ -67,6 +67,11 @@ sub import $dir = File::Spec->curdir unless ($dir); die "$dir is not a directory\n" unless (-d $dir); } + + # detaint: if the user asked for blib, s/he presumably knew + # what s/he wanted + $dir = $1 if $dir =~ /^(.*)$/; + my $i = 5; my($blib, $blib_lib, $blib_arch); while ($i--) diff --git a/lib/perl5db.t b/lib/perl5db.t index 3f68759efe..b2f72661c6 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -27,7 +27,7 @@ my $dev_tty = '/dev/tty'; } } -plan(8); +plan(9); sub rc { open RC, ">", ".perldb" or die $!; @@ -167,6 +167,15 @@ SKIP: { like($output, "All tests successful.", "[perl #66110]"); } +# taint tests + +{ + local $ENV{PERLDB_OPTS} = "ReadLine=0 NonStop=1"; + my $output = runperl(switches => [ '-d', '-T' ], stderr => 1, + progfile => '../lib/perl5db/t/taint'); + is($output, '[$^X][done]', "taint"); +} + # clean up. diff --git a/lib/perl5db/t/taint b/lib/perl5db/t/taint new file mode 100644 index 0000000000..e40f1945c7 --- /dev/null +++ b/lib/perl5db/t/taint @@ -0,0 +1,17 @@ +#!/usr/bin/perl -T +# +# This code is used by lib/perl5db.t !!! +# +use Scalar::Util qw(tainted); + +# [perl #76872] don't taint $DB::sub + +sub f {} + +BEGIN { + print "[\$^X]" if tainted($^X); + ($^X || 1) && f(); # maybe taint $DB::sub; + print "[\$DB::sub]" if tainted($DB::sub); +} +print "[done]"; + diff --git a/lib/unicore/mktables b/lib/unicore/mktables index 312e682783..77adadbd84 100644 --- a/lib/unicore/mktables +++ b/lib/unicore/mktables @@ -9,11 +9,12 @@ # 5.8: needs pack "U". But almost all occurrences of objaddr have been # removed in favor of using 'no overloading'. You also would have to go # through and replace occurrences like: -# my $addr; { no overloading; $addr = 0+$self; } +# my $addr = do { no overloading; pack 'J', $self; } # with # my $addr = main::objaddr $self; # (or reverse commit 9b01bafde4b022706c3d6f947a0963f821b2e50b -# that instituted this change.) +# that instituted the change to main::objaddr, and subsequent commits that +# changed 0+$self to pack 'J', $self.) require 5.010_001; use strict; @@ -585,6 +586,12 @@ sub uniques { # Encapsulated Cleverness". p. 455 in first edition. my %seen; + # Arguably this breaks encapsulation, if the goal is to permit multiple + # distinct objects to stringify to the same value, and be interchangeable. + # However, for this program, no two objects stringify identically, and all + # lists passed to this function are either objects or strings. So this + # doesn't affect correctness, but it does give a couple of percent speedup. + no overloading; return grep { ! $seen{$_}++ } @_; } @@ -1234,7 +1241,7 @@ sub objaddr($) { no overloading; # If overloaded, numifying below won't work. # Numifying a ref gives its address. - return 0 + $_[0]; + return pack 'J', $_[0]; } # Commented code below should work on Perl 5.8. @@ -1259,7 +1266,7 @@ sub objaddr($) { # bless $_[0], 'main::Fake'; # # # Numifying a ref gives its address. -# my $addr = 0 + $_[0]; +# my $addr = pack 'J', $_[0]; # # # Return to original class # bless $_[0], $pkg; @@ -1449,7 +1456,7 @@ package main; # Use typeglob to give the anonymous subroutine the name we want *$destroy_name = sub { my $self = shift; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $self->$destroy_callback if $destroy_callback; foreach my $field (keys %{$package_fields{$package}}) { @@ -1548,7 +1555,7 @@ package main; return Carp::carp_too_few_args(\@_, 2) if main::DEBUG && @_ < 2; my $self = shift; my $value = shift; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; Carp::carp_extra_args(\@_) if main::DEBUG && @_; if (ref $value) { return if grep { $value == $_ } @{$field->{$addr}}; @@ -1582,7 +1589,7 @@ package main; *$subname = sub { use strict "refs"; Carp::carp_extra_args(\@_) if main::DEBUG && @_ > 1; - my $addr; { no overloading; $addr = 0+$_[0]; } + my $addr = do { no overloading; pack 'J', $_[0]; }; if (ref $field->{$addr} ne 'ARRAY') { my $type = ref $field->{$addr}; $type = 'scalar' unless $type; @@ -1605,7 +1612,7 @@ package main; use strict "refs"; Carp::carp_extra_args(\@_) if main::DEBUG && @_ > 1; no overloading; - return $field->{0+$_[0]}; + return $field->{pack 'J', $_[0]}; } } } @@ -1620,7 +1627,7 @@ package main; } # $self is $_[0]; $value is $_[1] no overloading; - $field->{0+$_[0]} = $_[1]; + $field->{pack 'J', $_[0]} = $_[1]; return; } } @@ -1780,7 +1787,7 @@ sub trace { return main::trace(@_); } my $class = shift; my $self = bless \do{ my $anonymous_scalar }, $class; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Set defaults $handler{$addr} = \&main::process_generic_property_file; @@ -1871,7 +1878,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $file = $file{$addr}; @@ -2041,7 +2048,7 @@ END my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Here the file is open (or if the handle is not a ref, is an open # 'virtual' file). Get the next line; any inserted lines get priority @@ -2186,7 +2193,7 @@ END # # an each_line_handler() on the line. # # my $self = shift; -# my $addr; { no overloading; $addr = 0+$self; } +# my $addr = do { no overloading; pack 'J', $self; }; # # foreach my $inserted_ref (@{$added_lines{$addr}}) { # my ($adjusted, $line) = @{$inserted_ref}; @@ -2228,7 +2235,7 @@ END # indicate that this line hasn't been adjusted, and needs to be # processed. no overloading; - push @{$added_lines{0+$self}}, map { [ 0, $_ ] } @_; + push @{$added_lines{pack 'J', $self}}, map { [ 0, $_ ] } @_; return; } @@ -2252,7 +2259,7 @@ END # Each inserted line is an array, with the first element being 1 to # indicate that this line has been adjusted no overloading; - push @{$added_lines{0+$self}}, map { [ 1, $_ ] } @_; + push @{$added_lines{pack 'J', $self}}, map { [ 1, $_ ] } @_; return; } @@ -2265,7 +2272,7 @@ END my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # If not accepting a list return, just return the first one. return shift @{$missings{$addr}} unless wantarray; @@ -2279,7 +2286,7 @@ END # Add a property field to $_, if this file requires it. my $self = shift; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $property = $property{$addr}; Carp::carp_extra_args(\@_) if main::DEBUG && @_; @@ -2298,7 +2305,7 @@ END my $message = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $message = 'Unexpected line' unless $message; @@ -2363,7 +2370,7 @@ package Multi_Default; my $class = shift; my $self = bless \do{my $anonymous_scalar}, $class; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; while (@_ > 1) { my $default = shift; @@ -2381,7 +2388,7 @@ package Multi_Default; my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return each %{$class_defaults{$addr}}; } @@ -2428,7 +2435,7 @@ package Alias; my $class = shift; my $self = bless \do { my $anonymous_scalar }, $class; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $name{$addr} = shift; $loose_match{$addr} = shift; @@ -2490,7 +2497,7 @@ sub trace { return main::trace(@_); } my $class = shift; my $self = bless \do { my $anonymous_scalar }, $class; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $start{$addr} = shift; $end{$addr} = shift; @@ -2520,7 +2527,7 @@ sub trace { return main::trace(@_); } sub _operator_stringify { my $self = shift; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Output it like '0041..0065 (value)' my $return = sprintf("%04X", $start{$addr}) @@ -2543,7 +2550,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return $standard_form{$addr} if defined $standard_form{$addr}; return $value{$addr}; @@ -2556,7 +2563,7 @@ sub trace { return main::trace(@_); } my $indent = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $return = $indent . sprintf("%04X", $start{$addr}) @@ -2638,7 +2645,7 @@ sub trace { return main::trace(@_); } return _union($class, $initialize, %args) if defined $initialize; $self = bless \do { my $anonymous_scalar }, $class; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Optional parent object, only for debug info. $owner_name_of{$addr} = delete $args{'Owner'}; @@ -2670,7 +2677,7 @@ sub trace { return main::trace(@_); } sub _operator_stringify { my $self = shift; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return "Range_List attached to '$owner_name_of{$addr}'" if $owner_name_of{$addr}; @@ -2729,7 +2736,7 @@ sub trace { return main::trace(@_); } my $message = ""; if (defined $self) { no overloading; - $message .= $owner_name_of{0+$self}; + $message .= $owner_name_of{pack 'J', $self}; } Carp::my_carp_bug($message .= "Undefined argument to _union. No union done."); return; @@ -2751,7 +2758,7 @@ sub trace { return main::trace(@_); } my $message = ""; if (defined $self) { no overloading; - $message .= $owner_name_of{0+$self}; + $message .= $owner_name_of{pack 'J', $self}; } Carp::my_carp_bug($message . "Cannot take the union of a $type. No union done."); return; @@ -2792,7 +2799,7 @@ sub trace { return main::trace(@_); } Carp::carp_extra_args(\@_) if main::DEBUG && @_; no overloading; - return scalar @{$ranges{0+$self}}; + return scalar @{$ranges{pack 'J', $self}}; } sub min { @@ -2805,7 +2812,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # If the range list is empty, return a large value that isn't adjacent # to any that could be in the range list, for simpler tests @@ -2830,7 +2837,7 @@ sub trace { return main::trace(@_); } # So is in the table if and only iff it is at least the start position # of range $i. no overloading; - return 0 if $ranges{0+$self}->[$i]->start > $codepoint; + return 0 if $ranges{pack 'J', $self}->[$i]->start > $codepoint; return $i + 1; } @@ -2846,7 +2853,7 @@ sub trace { return main::trace(@_); } # contains() returns 1 beyond where we should look no overloading; - return $ranges{0+$self}->[$i-1]->value; + return $ranges{pack 'J', $self}->[$i-1]->value; } sub _search_ranges { @@ -2860,7 +2867,7 @@ sub trace { return main::trace(@_); } my $code_point = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return if $code_point > $max{$addr}; my $r = $ranges{$addr}; # The current list of ranges @@ -3034,7 +3041,7 @@ sub trace { return main::trace(@_); } Carp::carp_extra_args(\%args) if main::DEBUG && %args; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; if ($operation ne '+' && $operation ne '-') { Carp::my_carp_bug("$owner_name_of{$addr}First parameter to _add_delete must be '+' or '-'. No action taken."); @@ -3619,7 +3626,7 @@ sub trace { return main::trace(@_); } Carp::carp_extra_args(\@_) if main::DEBUG && @_; no overloading; - undef $each_range_iterator{0+$self}; + undef $each_range_iterator{pack 'J', $self}; return; } @@ -3630,7 +3637,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return if $self->is_empty; @@ -3647,7 +3654,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $count = 0; foreach my $range (@{$ranges{$addr}}) { @@ -3671,7 +3678,7 @@ sub trace { return main::trace(@_); } Carp::carp_extra_args(\@_) if main::DEBUG && @_; no overloading; - return scalar @{$ranges{0+$self}} == 0; + return scalar @{$ranges{pack 'J', $self}} == 0; } sub hash { @@ -3682,7 +3689,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # These are quickly computable. Return looks like 'min..max;count' return $self->min . "..$max{$addr};" . scalar @{$ranges{$addr}}; @@ -3990,7 +3997,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # On first pass, don't choose less desirable code points; if no good # one is found, repeat, allowing a less desirable one to be selected. @@ -4182,7 +4189,7 @@ sub trace { return main::trace(@_); } my $class = shift; my $self = bless \do { my $anonymous_scalar }, $class; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my %args = @_; @@ -4336,7 +4343,7 @@ sub trace { return main::trace(@_); } # Returns the array of ranges associated with this table. no overloading; - return $range_list{0+shift}->ranges; + return $range_list{pack 'J', shift}->ranges; } sub add_alias { @@ -4372,7 +4379,7 @@ sub trace { return main::trace(@_); } # release $name = ucfirst($name) unless $name =~ /^k[A-Z]/; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Figure out if should be loosely matched if not already specified. if (! defined $loose_match) { @@ -4434,7 +4441,7 @@ sub trace { return main::trace(@_); } # This name may be shorter than any existing ones, so clear the cache # of the shortest, so will have to be recalculated. no overloading; - undef $short_name{0+$self}; + undef $short_name{pack 'J', $self}; return; } @@ -4457,7 +4464,7 @@ sub trace { return main::trace(@_); } my $nominal_length_ptr = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # For efficiency, don't recalculate, but this means that adding new # aliases could change what the shortest is, so the code that does @@ -4533,7 +4540,7 @@ sub trace { return main::trace(@_); } Carp::carp_extra_args(\@_) if main::DEBUG && @_; no overloading; - push @{$description{0+$self}}, $description; + push @{$description{pack 'J', $self}}, $description; return; } @@ -4546,7 +4553,7 @@ sub trace { return main::trace(@_); } Carp::carp_extra_args(\@_) if main::DEBUG && @_; no overloading; - push @{$note{0+$self}}, $note; + push @{$note{pack 'J', $self}}, $note; return; } @@ -4560,7 +4567,7 @@ sub trace { return main::trace(@_); } chomp $comment; no overloading; - push @{$comment{0+$self}}, $comment; + push @{$comment{pack 'J', $self}}, $comment; return; } @@ -4573,7 +4580,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my @list = @{$comment{$addr}}; return @list if wantarray; my $return = ""; @@ -4591,7 +4598,7 @@ sub trace { return main::trace(@_); } # initialization for range lists. my $self = shift; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $initialization = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; @@ -4615,7 +4622,7 @@ sub trace { return main::trace(@_); } $return .= $DEVELOPMENT_ONLY if $compare_versions; $return .= $HEADER; no overloading; - $return .= $INTERNAL_ONLY if $internal_only{0+$self}; + $return .= $INTERNAL_ONLY if $internal_only{pack 'J', $self}; return $return; } @@ -4630,7 +4637,7 @@ sub trace { return main::trace(@_); } # the range Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Start with the header my @OUT = $self->header; @@ -4727,7 +4734,7 @@ sub trace { return main::trace(@_); } my $info = shift; # Any message associated with it. Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $status{$addr} = $status; $status_info{$addr} = $info; @@ -4742,7 +4749,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $locked{$addr} = ""; @@ -4770,7 +4777,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return 0 if ! $locked{$addr}; Carp::my_carp_bug("Can't modify a locked table. Stack trace of locking:\n$locked{$addr}\n\n"); @@ -4782,7 +4789,7 @@ sub trace { return main::trace(@_); } # Rest of parameters passed on no overloading; - @{$file_path{0+$self}} = @_; + @{$file_path{pack 'J', $self}} = @_; return } @@ -4806,7 +4813,7 @@ sub trace { return main::trace(@_); } use strict "refs"; my $self = shift; no overloading; - return $range_list{0+$self}->$sub(@_); + return $range_list{pack 'J', $self}->$sub(@_); } } @@ -4822,7 +4829,7 @@ sub trace { return main::trace(@_); } return if $self->carp_if_locked; no overloading; - return $range_list{0+$self}->$sub(@_); + return $range_list{pack 'J', $self}->$sub(@_); } } @@ -4928,7 +4935,7 @@ sub trace { return main::trace(@_); } _Range_List => $range_list, %args); - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $anomalous_entries{$addr} = []; $core_access{$addr} = $core_access; @@ -4980,7 +4987,7 @@ sub trace { return main::trace(@_); } # Can't change the table if locked. return if $self->carp_if_locked; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $has_specials{$addr} = 1 if $type; @@ -4998,7 +5005,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return "" unless @{$anomalous_entries{$addr}}; return join("\n", @{$anomalous_entries{$addr}}) . "\n"; @@ -5025,8 +5032,8 @@ sub trace { return main::trace(@_); } return; } - my $addr; { no overloading; $addr = 0+$self; } - my $other_addr; { no overloading; $other_addr = 0+$other; } + my $addr = do { no overloading; pack 'J', $self; }; + my $other_addr = do { no overloading; pack 'J', $other; }; local $to_trace = 0 if main::DEBUG; @@ -5059,7 +5066,7 @@ sub trace { return main::trace(@_); } my $map = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Convert the input to the standard equivalent, if any (won't have any # for $STRING properties) @@ -5104,7 +5111,7 @@ sub trace { return main::trace(@_); } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # If overridden, use that return $to_output_map{$addr} if defined $to_output_map{$addr}; @@ -5149,7 +5156,7 @@ sub trace { return main::trace(@_); } # No sense generating a comment if aren't going to write it out. return if ! $self->to_output_map; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $property = $self->property; @@ -5321,7 +5328,7 @@ END my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $name = $self->property->swash_name; @@ -5453,7 +5460,9 @@ END # multiple code points. These do not appear in the main body, but are defined # in the hash below. -# The key: UTF-8 _bytes_, the value: UTF-8 (speed hack) +# Each key is the string of N bytes that together make up the UTF-8 encoding +# for the code point. (i.e. the same as looking at the code point's UTF-8 +# under "use bytes"). Each value is the UTF-8 of the translation, for speed. %utf8::ToSpec$name = ( END $pre_body .= join("\n", @multi_code_point_maps) . "\n);\n"; @@ -5764,7 +5773,7 @@ END my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return $self->SUPER::write( ($self->property == $block) @@ -5911,7 +5920,7 @@ sub trace { return main::trace(@_); } _Property => $property, _Range_List => $range_list, ); - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $conflicting{$addr} = [ ]; $equivalents{$addr} = [ ]; @@ -5952,7 +5961,7 @@ sub trace { return main::trace(@_); } return if $self->carp_if_locked; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; if (ref $other) { @@ -6019,7 +6028,7 @@ sub trace { return main::trace(@_); } # be an optional parameter. Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Check if the conflicting name is exactly the same as any existing # alias in this table (as long as there is a real object there to @@ -6067,7 +6076,7 @@ sub trace { return main::trace(@_); } # Two tables are equivalent if they have the same leader. no overloading; - return $leader{0+$self} == $leader{0+$other}; + return $leader{pack 'J', $self} == $leader{pack 'J', $other}; return; } @@ -6141,7 +6150,7 @@ sub trace { return main::trace(@_); } my $are_equivalent = $self->is_equivalent_to($other); return if ! defined $are_equivalent || $are_equivalent; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $current_leader = ($related) ? $parent{$addr} : $leader{$addr}; if ($related && @@ -6152,8 +6161,8 @@ sub trace { return main::trace(@_); } $related = 0; } - my $leader; { no overloading; $leader = 0+$current_leader; } - my $other_addr; { no overloading; $other_addr = 0+$other; } + my $leader = do { no overloading; pack 'J', $current_leader; }; + my $other_addr = do { no overloading; pack 'J', $other; }; # Any tables that are equivalent to or children of this table must now # instead be equivalent to or (children) to the new leader (parent), @@ -6168,7 +6177,7 @@ sub trace { return main::trace(@_); } next if $table == $other; trace "setting $other to be the leader of $table, status=$status" if main::DEBUG && $to_trace; - my $table_addr; { no overloading; $table_addr = 0+$table; } + my $table_addr = do { no overloading; pack 'J', $table; }; $leader{$table_addr} = $other; $matches_all{$table_addr} = $matches_all; $self->_set_range_list($other->_range_list); @@ -6222,7 +6231,7 @@ sub trace { return main::trace(@_); } # an equivalent group Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$leader; } + my $addr = do { no overloading; pack 'J', $leader; }; if ($leader{$addr} != $leader) { Carp::my_carp_bug(<<END @@ -6277,7 +6286,7 @@ END && $parent == $property->table('N') && defined (my $yes = $property->table('Y'))) { - my $yes_addr; { no overloading; $yes_addr = 0+$yes; } + my $yes_addr = do { no overloading; pack 'J', $yes; }; @yes_perl_synonyms = grep { $_->property == $perl } main::uniques($yes, @@ -6293,12 +6302,12 @@ END my @conflicting; # Will hold the table conflicts. # Look at the parent, any yes synonyms, and all the children - my $parent_addr; { no overloading; $parent_addr = 0+$parent; } + my $parent_addr = do { no overloading; pack 'J', $parent; }; for my $table ($parent, @yes_perl_synonyms, @{$children{$parent_addr}}) { - my $table_addr; { no overloading; $table_addr = 0+$table; } + my $table_addr = do { no overloading; pack 'J', $table; }; my $table_property = $table->property; # Tables are separated by a blank line to create a grouping. @@ -6715,7 +6724,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } my %args = @_; $self = bless \do { my $anonymous_scalar }, $class; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; $directory{$addr} = delete $args{'Directory'}; $file{$addr} = delete $args{'File'}; @@ -6776,7 +6785,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } } else { no overloading; - $map{0+$self}->delete_range($other, $other); + $map{pack 'J', $self}->delete_range($other, $other); } return $self; } @@ -6789,7 +6798,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } my $name = shift; my %args = @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $table = $table_ref{$addr}{$name}; my $standard_name = main::standardize($name); @@ -6857,7 +6866,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } my $name = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return $table_ref{$addr}{$name} if defined $table_ref{$addr}{$name}; @@ -6876,7 +6885,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } # property no overloading; - return main::uniques(values %{$table_ref{0+shift}}); + return main::uniques(values %{$table_ref{pack 'J', shift}}); } sub directory { @@ -6885,7 +6894,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } # priority; 'undef' is returned if the type isn't defined; # or $map_directory for everything else. - my $addr; { no overloading; $addr = 0+shift; } + my $addr = do { no overloading; pack 'J', shift; }; return $directory{$addr} if defined $directory{$addr}; return undef if $type{$addr} == $UNKNOWN; @@ -6906,7 +6915,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; return $file{$addr} if defined $file{$addr}; return $map{$addr}->external_name; @@ -6922,7 +6931,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } # The whole point of this pseudo property is match tables. return 1 if $self == $perl; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # Don't generate tables of code points that match the property values # of a string property. Such a list would most likely have many @@ -6957,7 +6966,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } } no overloading; - return $map{0+$self}->map_add_or_replace_non_nulls($map{0+$other}); + return $map{pack 'J', $self}->map_add_or_replace_non_nulls($map{pack 'J', $other}); } sub set_type { @@ -6976,7 +6985,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } return; } - { no overloading; $type{0+$self} = $type; } + { no overloading; $type{pack 'J', $self} = $type; } return if $type != $BINARY; my $yes = $self->table('Y'); @@ -7006,7 +7015,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } my $map = shift; # What the range maps to. # Rest of parameters passed on. - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; # If haven't the type of the property, gather information to figure it # out. @@ -7058,7 +7067,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$self; } + my $addr = do { no overloading; pack 'J', $self; }; my $type = $type{$addr}; @@ -7168,7 +7177,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } use strict "refs"; my $self = shift; no overloading; - return $map{0+$self}->$sub(@_); + return $map{pack 'J', $self}->$sub(@_); } } @@ -7456,12 +7465,7 @@ sub write ($\@) { push @files_actually_output, $file; - my $text; - if (@$lines_ref) { - $text = join "", @$lines_ref; - } - else { - $text = ""; + unless (@$lines_ref) { Carp::my_carp("Output file '$file' is empty; writing it anyway;"); } @@ -7472,10 +7476,12 @@ sub write ($\@) { Carp::my_carp("can't open $file for output. Skipping this file: $!"); return; } + + print $OUT @$lines_ref or die Carp::my_carp("write to '$file' failed: $!"); + close $OUT or die Carp::my_carp("close '$file' failed: $!"); + print "$file written.\n" if $verbosity >= $VERBOSE; - print $OUT $text; - close $OUT; return; } @@ -7576,7 +7582,7 @@ sub standardize ($) { else { # Keep track of cycles in the input, and refuse to infinitely loop - my $addr; { no overloading; $addr = 0+$item; } + my $addr = do { no overloading; pack 'J', $item; }; if (defined $already_output{$addr}) { return "${indent}ALREADY OUTPUT: $item\n"; } @@ -7697,7 +7703,7 @@ sub dump_inside_out { my $fields_ref = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - my $addr; { no overloading; $addr = 0+$object; } + my $addr = do { no overloading; pack 'J', $object; }; my %hash; foreach my $key (keys %$fields_ref) { @@ -7725,7 +7731,7 @@ sub _operator_dot { } else { my $ref = ref $$which; - my $addr; { no overloading; $addr = 0+$$which; } + my $addr = do { no overloading; pack 'J', $$which; }; $$which = "$ref ($addr)"; } } @@ -7744,7 +7750,7 @@ sub _operator_equal { return 0 unless defined $other; return 0 unless ref $other; no overloading; - return 0+$self == 0+$other; + return $self == $other; } sub _operator_not_equal { @@ -8705,7 +8711,7 @@ END $file->carp_bad_line("Unexpected property '$property_name'. Skipped"); next LINE; } - { no overloading; $property_addr = 0+($property_object); } + { no overloading; $property_addr = pack 'J', $property_object; } # Defer changing names until have a line that is acceptable # (the 'next' statement above means is unacceptable) @@ -8757,7 +8763,7 @@ END if $file->has_missings_defaults; foreach my $default_ref (@missings_list) { my $default = $default_ref->[0]; - my $addr; { no overloading; $addr = 0+property_ref($default_ref->[1]); } + my $addr = do { no overloading; pack 'J', property_ref($default_ref->[1]); }; # For string properties, the default is just what the # file says, but non-string properties should already @@ -13141,12 +13147,11 @@ sub generate_separator($) { . $spaces_after; } -sub generate_tests($$$$$$) { +sub generate_tests($$$$$) { # This used only for making the test script. It generates test cases that # are expected to compile successfully in perl. Note that the lhs and # rhs are assumed to already be as randomized as the caller wants. - my $file_handle = shift; # Where to output the tests my $lhs = shift; # The property: what's to the left of the colon # or equals separator my $rhs = shift; # The property value; what's to the right @@ -13163,35 +13168,31 @@ sub generate_tests($$$$$$) { # The whole 'property=value' my $name = "$lhs$separator$rhs"; + my @output; # Create a complete set of tests, with complements. if (defined $valid_code) { - printf $file_handle - qq/Expect(1, $valid_code, '\\p{$name}', $warning);\n/; - printf $file_handle - qq/Expect(0, $valid_code, '\\p{^$name}', $warning);\n/; - printf $file_handle - qq/Expect(0, $valid_code, '\\P{$name}', $warning);\n/; - printf $file_handle - qq/Expect(1, $valid_code, '\\P{^$name}', $warning);\n/; + push @output, <<"EOC" +Expect(1, $valid_code, '\\p{$name}', $warning); +Expect(0, $valid_code, '\\p{^$name}', $warning); +Expect(0, $valid_code, '\\P{$name}', $warning); +Expect(1, $valid_code, '\\P{^$name}', $warning); +EOC } if (defined $invalid_code) { - printf $file_handle - qq/Expect(0, $invalid_code, '\\p{$name}', $warning);\n/; - printf $file_handle - qq/Expect(1, $invalid_code, '\\p{^$name}', $warning);\n/; - printf $file_handle - qq/Expect(1, $invalid_code, '\\P{$name}', $warning);\n/; - printf $file_handle - qq/Expect(0, $invalid_code, '\\P{^$name}', $warning);\n/; - } - return; + push @output, <<"EOC" +Expect(0, $invalid_code, '\\p{$name}', $warning); +Expect(1, $invalid_code, '\\p{^$name}', $warning); +Expect(1, $invalid_code, '\\P{$name}', $warning); +Expect(0, $invalid_code, '\\P{^$name}', $warning); +EOC + } + return @output; } -sub generate_error($$$$) { +sub generate_error($$$) { # This used only for making the test script. It generates test cases that # are expected to not only not match, but to be syntax or similar errors - my $file_handle = shift; # Where to output to. my $lhs = shift; # The property: what's to the left of the # colon or equals separator my $rhs = shift; # The property value; what's to the right @@ -13208,9 +13209,10 @@ sub generate_error($$$$) { my $property = $lhs . $separator . $rhs; - print $file_handle qq/Error('\\p{$property}');\n/; - print $file_handle qq/Error('\\P{$property}');\n/; - return; + return <<"EOC"; +Error('\\p{$property}'); +Error('\\P{$property}'); +EOC } # These are used only for making the test script @@ -13376,14 +13378,6 @@ sub make_property_test_script() { $t_path = 'TestProp.pl' unless defined $t_path; # the traditional name - force_unlink ($t_path); - push @files_actually_output, $t_path; - my $OUT; - if (not open $OUT, "> $t_path") { - Carp::my_carp("Can't open $t_path. Skipping: $!"); - return; - } - # Keep going down an order of magnitude # until find that adding this quantity to # 1 remains 1; but put an upper limit on @@ -13400,7 +13394,10 @@ sub make_property_test_script() { # use previous one $min_floating_slop = $next; } - print $OUT $HEADER, <DATA>; + + # It doesn't matter whether the elements of this array contain single lines + # or multiple lines. main::write doesn't count the lines. + my @output; foreach my $property (property_ref('*')) { foreach my $table ($property->tables) { @@ -13435,10 +13432,9 @@ sub make_property_test_script() { my $already_error = ! $table->file_path; # Generate error cases for this alias. - generate_error($OUT, - $property_name, - $table_name, - $already_error); + push @output, generate_error($property_name, + $table_name, + $already_error); # If the table is guaranteed to always generate an error, # quit now without generating success cases. @@ -13459,13 +13455,12 @@ sub make_property_test_script() { # Don't output duplicate test cases. if (! exists $test_generated{$test_name}) { $test_generated{$test_name} = 1; - generate_tests($OUT, - $property_name, - $standard, - $valid, - $invalid, - $warning, - ); + push @output, generate_tests($property_name, + $standard, + $valid, + $invalid, + $warning, + ); } $random = randomize_loose_name($table_name) } @@ -13477,13 +13472,12 @@ sub make_property_test_script() { my $test_name = "$property_name=$random"; if (! exists $test_generated{$test_name}) { $test_generated{$test_name} = 1; - generate_tests($OUT, - $property_name, - $random, - $valid, - $invalid, - $warning, - ); + push @output, generate_tests($property_name, + $random, + $valid, + $invalid, + $warning, + ); # If the name is a rational number, add tests for the # floating point equivalent. @@ -13525,24 +13519,22 @@ sub make_property_test_script() { if abs($table_name - $existing) < $MAX_FLOATING_SLOP; } - generate_error($OUT, - $property_name, - $table_name, - 1 # 1 => already an error - ); + push @output, generate_error($property_name, + $table_name, + 1 # 1 => already an error + ); } else { # Here the number of digits exceeds the # minimum we think is needed. So generate a # success test case for it. - generate_tests($OUT, - $property_name, - $table_name, - $valid, - $invalid, - $warning, - ); + push @output, generate_tests($property_name, + $table_name, + $valid, + $invalid, + $warning, + ); } } } @@ -13551,12 +13543,10 @@ sub make_property_test_script() { } } - foreach my $test (@backslash_X_tests) { - print $OUT "Test_X('$test');\n"; - } - - print $OUT "Finished();\n"; - close $OUT; + &write($t_path, [<DATA>, + @output, + (map {"Test_X('$_');\n"} @backslash_X_tests), + "Finished();\n"]); return; } diff --git a/makedef.pl b/makedef.pl index bb60643e02..810a4c80ec 100644 --- a/makedef.pl +++ b/makedef.pl @@ -1241,10 +1241,8 @@ else { my $glob = readvar($perlvars_h); emit_symbols $glob; } - unless ($define{'MULTIPLICITY'}) { - my $glob = readvar($intrpvar_h); - emit_symbols $glob; - } + my $glob = readvar($intrpvar_h); + emit_symbols $glob; } sub try_symbol { @@ -104,6 +104,7 @@ recursive, but it's recursive on basic blocks, not on tree nodes. #include "keywords.h" #define CALL_PEEP(o) PL_peepp(aTHX_ o) +#define CALL_RPEEP(o) PL_rpeepp(aTHX_ o) #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o) #if defined(PL_OP_SLAB_ALLOC) @@ -2668,7 +2669,7 @@ S_gen_constant_list(pTHX_ register OP *o) o->op_ppaddr = PL_ppaddr[OP_RV2AV]; o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */ o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */ - o->op_opt = 0; /* needs to be revisited in peep() */ + o->op_opt = 0; /* needs to be revisited in rpeep() */ curop = ((UNOP*)o)->op_first; ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(*PL_stack_sp--)); #ifdef PERL_MAD @@ -3050,6 +3051,17 @@ Perl_mad_free(pTHX_ MADPROP* mp) #endif +/* +=head1 Optree construction + +=for apidoc Am|OP *|newNULLLIST + +Constructs, checks, and returns a new C<stub> op, which represents an +empty list expression. + +=cut +*/ + OP * Perl_newNULLLIST(pTHX) { @@ -3065,6 +3077,18 @@ S_force_list(pTHX_ OP *o) return o; } +/* +=for apidoc Am|OP *|newLISTOP|I32 type|I32 flags|OP *first|OP *last + +Constructs, checks, and returns an op of any list type. I<type> is +the opcode. I<flags> gives the eight bits of C<op_flags>, except that +C<OPf_KIDS> will be set automatically if required. I<first> and I<last> +supply up to two ops to be direct children of the list op; they are +consumed by this function and become part of the constructed op tree. + +=cut +*/ + OP * Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) { @@ -3101,6 +3125,17 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) return CHECKOP(type, listop); } +/* +=for apidoc Am|OP *|newOP|I32 type|I32 flags + +Constructs, checks, and returns an op of any base type (any type that +has no extra fields). I<type> is the opcode. I<flags> gives the +eight bits of C<op_flags>, and, shifted up eight bits, the eight bits +of C<op_private>. + +=cut +*/ + OP * Perl_newOP(pTHX_ I32 type, I32 flags) { @@ -3129,6 +3164,20 @@ Perl_newOP(pTHX_ I32 type, I32 flags) return CHECKOP(type, o); } +/* +=for apidoc Am|OP *|newUNOP|I32 type|I32 flags|OP *first + +Constructs, checks, and returns an op of any unary type. I<type> is +the opcode. I<flags> gives the eight bits of C<op_flags>, except that +C<OPf_KIDS> will be set automatically if required, and, shifted up eight +bits, the eight bits of C<op_private>, except that the bit with value 1 +is automatically set. I<first> supplies an optional op to be the direct +child of the unary op; it is consumed by this function and become part +of the constructed op tree. + +=cut +*/ + OP * Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first) { @@ -3161,6 +3210,20 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first) return fold_constants((OP *) unop); } +/* +=for apidoc Am|OP *|newBINOP|I32 type|I32 flags|OP *first|OP *last + +Constructs, checks, and returns an op of any binary type. I<type> +is the opcode. I<flags> gives the eight bits of C<op_flags>, except +that C<OPf_KIDS> will be set automatically, and, shifted up eight bits, +the eight bits of C<op_private>, except that the bit with value 1 or +2 is automatically set as required. I<first> and I<last> supply up to +two ops to be the direct children of the binary op; they are consumed +by this function and become part of the constructed op tree. + +=cut +*/ + OP * Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) { @@ -3559,6 +3622,16 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) return o; } +/* +=for apidoc Am|OP *|newPMOP|I32 type|I32 flags + +Constructs, checks, and returns an op of any pattern matching type. +I<type> is the opcode. I<flags> gives the eight bits of C<op_flags> +and, shifted up eight bits, the eight bits of C<op_private>. + +=cut +*/ + OP * Perl_newPMOP(pTHX_ I32 type, I32 flags) { @@ -3803,6 +3876,17 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg) return (OP*)pm; } +/* +=for apidoc Am|OP *|newSVOP|I32 type|I32 flags|SV *sv + +Constructs, checks, and returns an op of any type that involves an +embedded SV. I<type> is the opcode. I<flags> gives the eight bits +of C<op_flags>. I<sv> gives the SV to embed in the op; this function +takes ownership of one reference to it. + +=cut +*/ + OP * Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv) { @@ -3829,6 +3913,21 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv) } #ifdef USE_ITHREADS + +/* +=for apidoc Am|OP *|newPADOP|I32 type|I32 flags|SV *sv + +Constructs, checks, and returns an op of any type that involves a +reference to a pad element. I<type> is the opcode. I<flags> gives the +eight bits of C<op_flags>. A pad slot is automatically allocated, and +is populated with I<sv>; this function takes ownership of one reference +to it. + +This function only exists if Perl has been compiled to use ithreads. + +=cut +*/ + OP * Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv) { @@ -3857,7 +3956,20 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv) padop->op_targ = pad_alloc(type, SVs_PADTMP); return CHECKOP(type, padop); } -#endif + +#endif /* !USE_ITHREADS */ + +/* +=for apidoc Am|OP *|newGVOP|I32 type|I32 flags|GV *gv + +Constructs, checks, and returns an op of any type that involves an +embedded reference to a GV. I<type> is the opcode. I<flags> gives the +eight bits of C<op_flags>. I<gv> identifies the GV that the op should +reference; calling this function does not transfer ownership of any +reference to it. + +=cut +*/ OP * Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) @@ -3874,6 +3986,18 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) #endif } +/* +=for apidoc Am|OP *|newPVOP|I32 type|I32 flags|char *pv + +Constructs, checks, and returns an op of any type that involves an +embedded C-level pointer (PV). I<type> is the opcode. I<flags> gives +the eight bits of C<op_flags>. I<pv> supplies the C-level pointer, which +must have been allocated using L</PerlMemShared_malloc>; the memory will +be freed when the op is destroyed. + +=cut +*/ + OP * Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv) { @@ -4191,6 +4315,22 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin) return doop; } +/* +=head1 Optree construction + +=for apidoc Am|OP *|newSLICEOP|I32 flags|OP *subscript|OP *listval + +Constructs, checks, and returns an C<lslice> (list slice) op. I<flags> +gives the eight bits of C<op_flags>, except that C<OPf_KIDS> will +be set automatically, and, shifted up eight bits, the eight bits of +C<op_private>, except that the bit with value 1 or 2 is automatically +set as required. I<listval> and I<subscript> supply the parameters of +the slice; they are consumed by this function and become part of the +constructed op tree. + +=cut +*/ + OP * Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval) { @@ -4243,6 +4383,29 @@ S_is_list_assignment(pTHX_ register const OP *o) return FALSE; } +/* +=for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right + +Constructs, checks, and returns an assignment op. I<left> and I<right> +supply the parameters of the assignment; they are consumed by this +function and become part of the constructed op tree. + +If I<optype> is C<OP_ANDASSIGN>, C<OP_ORASSIGN>, or C<OP_DORASSIGN>, then +a suitable conditional optree is constructed. If I<optype> is the opcode +of a binary operator, such as C<OP_BIT_OR>, then an op is constructed that +performs the binary operation and assigns the result to the left argument. +Either way, if I<optype> is non-zero then I<flags> has no effect. + +If I<optype> is zero, then a plain scalar or list assignment is +constructed. Which type of assignment it is is automatically determined. +I<flags> gives the eight bits of C<op_flags>, except that C<OPf_KIDS> +will be set automatically, and, shifted up eight bits, the eight bits +of C<op_private>, except that the bit with value 1 or 2 is automatically +set as required. + +=cut +*/ + OP * Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) { @@ -4491,6 +4654,24 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) return o; } +/* +=for apidoc Am|OP *|newSTATEOP|I32 flags|char *label|OP *o + +Constructs a state op (COP). The state op is normally a C<nextstate> op, +but will be a C<dbstate> op if debugging is enabled for currently-compiled +code. The state op is populated from L</PL_curcop> (or L</PL_compiling>). +If I<label> is non-null, it supplies the name of a label to attach to +the state op; this function takes ownership of the memory pointed at by +I<label>, and will free it. I<flags> gives the eight bits of C<op_flags> +for the state op. + +If I<o> is null, the state op is returned. Otherwise the state op is +combined with I<o> into a C<lineseq> list op, which is returned. I<o> +is consumed by this function and becomes part of the returned op tree. + +=cut +*/ + OP * Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) { @@ -4568,6 +4749,19 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) return prepend_elem(OP_LINESEQ, (OP*)cop, o); } +/* +=for apidoc Am|OP *|newLOGOP|I32 type|I32 flags|OP *first|OP *other + +Constructs, checks, and returns a logical (flow control) op. I<type> +is the opcode. I<flags> gives the eight bits of C<op_flags>, except +that C<OPf_KIDS> will be set automatically, and, shifted up eight bits, +the eight bits of C<op_private>, except that the bit with value 1 is +automatically set. I<first> supplies the expression controlling the +flow, and I<other> supplies the side (alternate) chain of ops; they are +consumed by this function and become part of the constructed op tree. + +=cut +*/ OP * Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other) @@ -4784,6 +4978,20 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) return o; } +/* +=for apidoc Am|OP *|newCONDOP|I32 flags|OP *first|OP *trueop|OP *falseop + +Constructs, checks, and returns a conditional-expression (C<cond_expr>) +op. I<flags> gives the eight bits of C<op_flags>, except that C<OPf_KIDS> +will be set automatically, and, shifted up eight bits, the eight bits of +C<op_private>, except that the bit with value 1 is automatically set. +I<first> supplies the expression selecting between the two branches, +and I<trueop> and I<falseop> supply the branches; they are consumed by +this function and become part of the constructed op tree. + +=cut +*/ + OP * Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) { @@ -4849,6 +5057,20 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) return o; } +/* +=for apidoc Am|OP *|newRANGE|I32 flags|OP *left|OP *right + +Constructs and returns a C<range> op, with subordinate C<flip> and +C<flop> ops. I<flags> gives the eight bits of C<op_flags> for the +C<flip> op and, shifted up eight bits, the eight bits of C<op_private> +for both the C<flip> and C<range> ops, except that the bit with value +1 is automatically set. I<left> and I<right> supply the expressions +controlling the endpoints of the range; they are consumed by this function +and become part of the constructed op tree. + +=cut +*/ + OP * Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) { @@ -4898,6 +5120,22 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) return o; } +/* +=for apidoc Am|OP *|newLOOPOP|I32 flags|I32 debuggable|OP *expr|OP *block + +Constructs, checks, and returns an op tree expressing a loop. This is +only a loop in the control flow through the op tree; it does not have +the heavyweight loop structure that allows exiting the loop by C<last> +and suchlike. I<flags> gives the eight bits of C<op_flags> for the +top-level op, except that some bits will be set automatically as required. +I<expr> supplies the expression controlling loop iteration, and I<block> +supplies the body of the loop; they are consumed by this function and +become part of the constructed op tree. I<debuggable> is currently +unused and should always be 1. + +=cut +*/ + OP * Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) { @@ -4962,6 +5200,31 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) return o; } +/* +=for apidoc Am|OP *|newWHILEOP|I32 flags|I32 debuggable|LOOP *loop|I32 whileline|OP *expr|OP *block|OP *cont|I32 has_my + +Constructs, checks, and returns an op tree expressing a C<while> loop. +This is a heavyweight loop, with structure that allows exiting the loop +by C<last> and suchlike. + +I<loop> is an optional preconstructed C<enterloop> op to use in the +loop; if it is null then a suitable op will be constructed automatically. +I<expr> supplies the loop's controlling expression. I<block> supplies the +main body of the loop, and I<cont> optionally supplies a C<continue> block +that operates as a second half of the body. All of these optree inputs +are consumed by this function and become part of the constructed op tree. + +I<flags> gives the eight bits of C<op_flags> for the C<leaveloop> +op and, shifted up eight bits, the eight bits of C<op_private> for +the C<leaveloop> op, except that (in both cases) some bits will be set +automatically. I<debuggable> is currently unused and should always be 1. +I<whileline> is the line number that should be attributed to the loop's +controlling expression. I<has_my> can be supplied as true to force the +loop body to be enclosed in its own scope. + +=cut +*/ + OP * Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont, I32 has_my) @@ -5065,6 +5328,33 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my) return o; } +/* +=for apidoc Am|OP *|newFOROP|I32 flags|char *label|line_t forline|OP *sv|OP *expr|OP *block|OP *cont + +Constructs, checks, and returns an op tree expressing a C<foreach> +loop (iteration through a list of values). This is a heavyweight loop, +with structure that allows exiting the loop by C<last> and suchlike. + +I<sv> optionally supplies the variable that will be aliased to each +item in turn; if null, it defaults to C<$_> (either lexical or global). +I<expr> supplies the list of values to iterate over. I<block> supplies +the main body of the loop, and I<cont> optionally supplies a C<continue> +block that operates as a second half of the body. All of these optree +inputs are consumed by this function and become part of the constructed +op tree. + +I<flags> gives the eight bits of C<op_flags> for the C<leaveloop> +op and, shifted up eight bits, the eight bits of C<op_private> for +the C<leaveloop> op, except that (in both cases) some bits will be set +automatically. I<forline> is the line number that should be attributed +to the loop's list expression. If I<label> is non-null, it supplies +the name of a label to attach to the state op at the start of the loop; +this function takes ownership of the memory pointed at by I<label>, +and will free it. + +=cut +*/ + OP * Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP *block, OP *cont) { @@ -5191,6 +5481,17 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP return newSTATEOP(0, label, wop); } +/* +=for apidoc Am|OP *|newLOOPEX|I32 type|OP *label + +Constructs, checks, and returns a loop-exiting op (such as C<goto> +or C<last>). I<type> is the opcode. I<label> supplies the parameter +determining the target of the op; it is consumed by this function and +become part of the constructed op tree. + +=cut +*/ + OP* Perl_newLOOPEX(pTHX_ I32 type, OP *label) { @@ -5381,6 +5682,19 @@ S_looks_like_bool(pTHX_ const OP *o) } } +/* +=for apidoc Am|OP *|newGIVENOP|OP *cond|OP *block|PADOFFSET defsv_off + +Constructs, checks, and returns an op tree expressing a C<given> block. +I<cond> supplies the expression that will be locally assigned to a lexical +variable, and I<block> supplies the body of the C<given> construct; they +are consumed by this function and become part of the constructed op tree. +I<defsv_off> is the pad offset of the scalar lexical variable that will +be affected. + +=cut +*/ + OP * Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off) { @@ -5393,7 +5707,19 @@ Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off) defsv_off); } -/* If cond is null, this is a default {} block */ +/* +=for apidoc Am|OP *|newWHENOP|OP *cond|OP *block + +Constructs, checks, and returns an op tree expressing a C<when> block. +I<cond> supplies the test expression, and I<block> supplies the block +that will be executed if the test evaluates to true; they are consumed +by this function and become part of the constructed op tree. I<cond> +will be interpreted DWIMically, often as a comparison against C<$_>, +and may be null to generate a C<default> block. + +=cut +*/ + OP * Perl_newWHENOP(pTHX_ OP *cond, OP *block) { @@ -5417,6 +5743,8 @@ Perl_newWHENOP(pTHX_ OP *cond, OP *block) } /* +=head1 Embedding Functions + =for apidoc cv_undef Clear out all the active components of a CV. This can happen either @@ -8516,7 +8844,7 @@ S_is_inplace_av(pTHX_ OP *o, OP *oright) { * peep() is called */ void -Perl_peep(pTHX_ register OP *o) +Perl_rpeep(pTHX_ register OP *o) { dVAR; register OP* oldop = NULL; @@ -8609,7 +8937,7 @@ Perl_peep(pTHX_ register OP *o) PL_curcop = ((COP*)o); } /* XXX: We avoid setting op_seq here to prevent later calls - to peep() from mistakenly concluding that optimisation + to rpeep() from mistakenly concluding that optimisation has already occurred. This doesn't fix the real problem, though (See 20010220.007). AMS 20010719 */ /* op_seq functionality is now replaced by op_opt */ @@ -8715,7 +9043,7 @@ Perl_peep(pTHX_ register OP *o) sop = fop->op_sibling; while (cLOGOP->op_other->op_type == OP_NULL) cLOGOP->op_other = cLOGOP->op_other->op_next; - peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */ + CALL_RPEEP(cLOGOP->op_other); stitch_keys: o->op_opt = 1; @@ -8766,20 +9094,20 @@ Perl_peep(pTHX_ register OP *o) case OP_ONCE: while (cLOGOP->op_other->op_type == OP_NULL) cLOGOP->op_other = cLOGOP->op_other->op_next; - peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */ + CALL_RPEEP(cLOGOP->op_other); break; case OP_ENTERLOOP: case OP_ENTERITER: while (cLOOP->op_redoop->op_type == OP_NULL) cLOOP->op_redoop = cLOOP->op_redoop->op_next; - peep(cLOOP->op_redoop); + CALL_RPEEP(cLOOP->op_redoop); while (cLOOP->op_nextop->op_type == OP_NULL) cLOOP->op_nextop = cLOOP->op_nextop->op_next; - peep(cLOOP->op_nextop); + CALL_RPEEP(cLOOP->op_nextop); while (cLOOP->op_lastop->op_type == OP_NULL) cLOOP->op_lastop = cLOOP->op_lastop->op_next; - peep(cLOOP->op_lastop); + CALL_RPEEP(cLOOP->op_lastop); break; case OP_SUBST: @@ -8788,7 +9116,7 @@ Perl_peep(pTHX_ register OP *o) cPMOP->op_pmstashstartu.op_pmreplstart->op_type == OP_NULL) cPMOP->op_pmstashstartu.op_pmreplstart = cPMOP->op_pmstashstartu.op_pmreplstart->op_next; - peep(cPMOP->op_pmstashstartu.op_pmreplstart); + CALL_RPEEP(cPMOP->op_pmstashstartu.op_pmreplstart); break; case OP_EXEC: @@ -9164,6 +9492,12 @@ Perl_peep(pTHX_ register OP *o) LEAVE; } +void +Perl_peep(pTHX_ register OP *o) +{ + CALL_RPEEP(o); +} + const char* Perl_custom_op_name(pTHX_ const OP* o) { @@ -209,7 +209,7 @@ for (@ops) { my($safe_desc) = $desc{$_}; # Have to escape double quotes and escape characters. - $safe_desc =~ s/(^|[^\\])([\\"])/$1\\$2/g; + $safe_desc =~ s/([\\"])/\\$1/g; print qq(\t"$safe_desc",\n); } @@ -552,6 +552,8 @@ END_EXTERN_C #define PL_restartjmpenv (*Perl_Irestartjmpenv_ptr(aTHX)) #undef PL_restartop #define PL_restartop (*Perl_Irestartop_ptr(aTHX)) +#undef PL_rpeepp +#define PL_rpeepp (*Perl_Irpeepp_ptr(aTHX)) #undef PL_rs #define PL_rs (*Perl_Irs_ptr(aTHX)) #undef PL_runops diff --git a/pod/perlport.pod b/pod/perlport.pod index 791c90d695..47968e8f14 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -624,7 +624,7 @@ because that is OS- and implementation-specific. It is better to store a date in an unambiguous representation. The ISO 8601 standard defines YYYY-MM-DD as the date format, or YYYY-MM-DDTHH-MM-SS (that's a literal "T" separating the date from the time). -Please do use the ISO 8601 instead of making us to guess what +Please do use the ISO 8601 instead of making us guess what date 02/03/04 might be. ISO 8601 even sorts nicely as-is. A text representation (like "1987-12-18") can be easily converted into an OS-specific value using a module like Date::Parse. diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 75e7ce1009..f3db450543 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -398,7 +398,7 @@ B<-D14> is equivalent to B<-Dtls>): 32768 D Cleaning up 131072 T Tokenising 262144 R Include reference counts of dumped variables (eg when using -Ds) - 524288 J Do not s,t,P-debug (Jump over) opcodes within package DB + 524288 J show s,t,P-debug (don't Jump over) on opcodes within package DB 1048576 v Verbose: use in conjunction with other flags 2097152 C Copy On Write 4194304 A Consistency checks on internal structures diff --git a/pod/perltrap.pod b/pod/perltrap.pod index b5f0935166..31234369c0 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -497,7 +497,7 @@ of a variable, or as a delimiter for any kind of quote construct. Double darn. $a = ("foo bar"); - $b = q baz; + $b = q baz ; print "a is $a, b is $b\n"; # perl4 prints: a is foo bar, b is baz diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index 76dc40d277..950753631a 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -884,18 +884,21 @@ properties: to define subroutines with names C<ToLower> (for C<lc()> and C<lcfirst()>); C<ToTitle> (for C<ucfirst()>); and C<ToUpper> (for C<uc()>). -The string returned by the subroutines needs to be two hexadecimal numbers -separated by two tabulators: the two numbers being, respectively, the source -code point and the destination code point. For example: +The string returned by the subroutines needs to be lines each containing +two hexadecimal numbers separated by two tabulators: the two numbers +being, respectively, the source code point and the destination code +point. For example: sub ToUpper { return <<END; 0061\t\t0041 + 0062\t\t0042 END } defines a mapping for C<uc()> (and C<\U>) that causes only the character "a" -to be mapped to "A"; all other characters will remain unchanged. +to be mapped to "A", and the character "b" to be mapped to "B"; the +mapping for all other characters is to themselves. (For serious hackers only) The above means you have to furnish a complete mapping; you can't just override a couple of characters and leave the rest @@ -915,21 +918,24 @@ subroutine. But this will only be valid on Perls that use the same Unicode version. Another option would be to have your subroutine read the official mapping file(s) and overwrite the affected code points. -If you have only a few mappings to change, starting in 5.14 you can use the -following trick, here illustrated for Turkish. +If you have only a few mappings to change you can use the +following trick (but see below for a big caveat), here illustrated for +Turkish: use Config; + use charnames ":full"; sub ToUpper { my $official = do "$Config{privlib}/unicore/To/Upper.pl"; - $utf8::ToSpecUpper{'i'} = + $utf8::ToSpecUpper{'i'} = "\N{LATIN CAPITAL LETTER I WITH DOT ABOVE}"; return $official; } This takes the official mappings and overrides just one, for "LATIN SMALL -LETTER I". The keys to the hash must be in UTF-8 (or on EBCDIC platforms, -UTF-EBCDIC), as illustrated by the inverse function. +LETTER I". Each hash key must be the string of bytes that form the UTF-8 +(on EBCDIC platforms, UTF-EBCDIC) of the character, as illustrated by +the inverse function. sub ToLower { my $official = do $lower; @@ -937,45 +943,89 @@ UTF-EBCDIC), as illustrated by the inverse function. return $official; } -This example is for an ASCII platform, and C<\xc4\xb0> is the UTF-8 string that -represents C<\N{LATIN CAPITAL LETTER I WITH DOT ABOVE}>, C<U+0130>. +This example is for an ASCII platform, and C<\xc4\xb0> is the string of +bytes that together form the UTF-8 that represents C<\N{LATIN CAPITAL +LETTER I WITH DOT ABOVE}>, C<U+0130>. You can avoid having to figure out +these bytes, and at the same time make it work on all platforms by +instead writing: -(The trick illustrated here does work in earlier releases, but only if all the -characters you want to override have ordinal values of 256 or higher.) - -The mappings are in effect only for the package they are defined in, and only -on scalars that have been marked as having Unicode characters, for example by -using C<utf8::upgrade()>. You can get around the latter restriction in the -scope of a C<S<use subs>>: - - use subs qw(uc ucfirst lc lcfirst); - - sub uc($) { - my $string = shift; - utf8::upgrade($string); - return CORE::uc($string); + sub ToLower { + my $official = do $lower; + my $sequence = "\N{LATIN CAPITAL LETTER I WITH DOT ABOVE}"; + utf8::encode($sequence); + $utf8::ToSpecLower{$sequence} = "i"; + return $official; } - sub lc($) { - my $string = shift; - utf8::upgrade($string); - - # Unless an I is before a dot_above, it turns into a dotless i. - $string =~ - s/I (?! [^\p{ccc=0}\p{ccc=Above}]* \x{0307} )/\x{131}/gx; - - # But when the I is followed by a dot_above, remove the - # dot_above so the end result will be i. - $string =~ s/I ([^\p{ccc=0}\p{ccc=Above}]* ) \x{0307}/i$1/gx; - return CORE::lc($string); - } +This works because C<utf8::encode()> takes the single character and +converts it to the sequence of bytes that constitute it. Note that we took +advantage of the fact that C<"i"> is the same in UTF-8 or UTF_EBCIDIC as not; +otherwise we would have had to write + + $utf8::ToSpecLower{$sequence} = "\N{LATIN SMALL LETTER I}"; + +in the ToLower example, and in the ToUpper example, use + + my $sequence = "\N{LATIN SMALL LETTER I}"; + utf8::encode($sequence); + +The mappings are in effect only for the package they are defined in. +Although probably not advisable, you can +cause the mappings to be used globally by importing into C<CORE::GLOBAL> +(see L<CORE>). + +A big caveat to the above trick, is that it works only on strings encoded in +UTF-8 (which will happen automatically for characters whose code points are +256 or higher), but you can partially get around this restriction +by using C<use subs> (or not advisably by importing with C<CORE::GLOBAL>). +For example: + + use subs qw(uc ucfirst lc lcfirst); + + sub uc($) { + my $string = shift; + utf8::upgrade($string); + return CORE::uc($string); + } + + sub lc($) { + my $string = shift; + utf8::upgrade($string); + + # Unless an I is before a dot_above, it turns into a dotless i. + # (The character class with the combining classes matches non-above + # marks following the I. Any number of these may be between the 'I' and + # the dot_above and the dot_above will still apply to the 'I'. + use charnames ":full"; + $string =~ + s/I + (?! [^\p{ccc=0}\p{ccc=Above}]* \N{COMBINING DOT ABOVE} ) + /\N{LATIN SMALL LETTER DOTLESS I}/gx; + + # But when the I is followed by a dot_above, remove the + # dot_above so the end result will be i. + $string =~ s/I + ([^\p{ccc=0}\p{ccc=Above}]* ) + \N{COMBINING DOT ABOVE} + /i$1/gx; + return CORE::lc($string); + } These examples (also for Turkish) make sure the input is in UTF-8, and then call the corresponding official function, which will use the C<ToUpper()> and -C<ToLower()> functions you have defined in the package. The C<lc()> example -shows how you can add context-dependent casing. (For Turkish, there other -required functions: C<ucfirst>, C<lcfirst>, and C<ToTitle>. These are very -similar to the ones given above.) +C<ToLower()> functions you have defined in the package. +(For Turkish, there are other required functions: C<ucfirst>, C<lcfirst>, +and C<ToTitle>. These are very similar to the ones given above.) + +The reason this is a partial work-around is that it doesn't affect the C<\l>, +C<\L>, C<\u>, and C<\U> case change operations, which still require the source +to be encoded in utf8 (see L</The "Unicode Bug">). + +The C<lc()> example shows how you can add context-dependent casing. Note +that context-dependent casing suffers from the problem that the string +passed to the casing function may not have sufficient context to make +the proper choice. And, it will not be called for the C<\l>, C<\L>, C<\u>, +and C<\U>. =head2 Character Encodings for Input and Output @@ -2572,6 +2572,7 @@ STATIC void S_pad_reset(pTHX); #endif PERL_CALLCONV void Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust); PERL_CALLCONV void Perl_peep(pTHX_ OP* o); +PERL_CALLCONV void Perl_rpeep(pTHX_ OP* o); PERL_CALLCONV PerlIO* Perl_start_glob(pTHX_ SV *tmpglob, IO *io) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); @@ -245,14 +245,22 @@ /* TODO: Combine JUMPABLE and HAS_TEXT to cache OP(rn) */ /* for use after a quantifier and before an EXACT-like node -- japhy */ -/* it would be nice to rework regcomp.sym to generate this stuff. sigh */ +/* it would be nice to rework regcomp.sym to generate this stuff. sigh + * + * NOTE that *nothing* that affects backtracking should be in here, specifically + * VERBS must NOT be included. JUMPABLE is used to determine if we can ignore a + * node that is in between two EXACT like nodes when ascertaining what the required + * "follow" character is. This should probably be moved to regex compile time + * although it may be done at run time beause of the REF possibility - more + * investigation required. -- demerphq +*/ #define JUMPABLE(rn) ( \ OP(rn) == OPEN || \ (OP(rn) == CLOSE && (!cur_eval || cur_eval->u.eval.close_paren != ARG(rn))) || \ OP(rn) == EVAL || \ OP(rn) == SUSPEND || OP(rn) == IFMATCH || \ OP(rn) == PLUS || OP(rn) == MINMOD || \ - OP(rn) == KEEPS || (PL_regkind[OP(rn)] == VERB) || \ + OP(rn) == KEEPS || \ (PL_regkind[OP(rn)] == CURLY && ARG1(rn) > 0) \ ) #define IS_EXACT(rn) (PL_regkind[OP(rn)] == EXACT) @@ -2018,33 +2026,68 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre end = HOP3c(strend, -dontbother, strbeg) - 1; /* for multiline we only have to try after newlines */ if (prog->check_substr || prog->check_utf8) { - if (s == startpos) - goto after_try; - while (1) { - if (regtry(®info, &s)) - goto got_it; - after_try: - if (s > end) - goto phooey; - if (prog->extflags & RXf_USE_INTUIT) { - s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL); - if (!s) - goto phooey; - } - else - s++; - } - } else { - if (s > startpos) + /* because of the goto we can not easily reuse the macros for bifurcating the + unicode/non-unicode match modes here like we do elsewhere - demerphq */ + if (utf8_target) { + if (s == startpos) + goto after_try_utf8; + while (1) { + if (regtry(®info, &s)) { + goto got_it; + } + after_try_utf8: + if (s > end) { + goto phooey; + } + if (prog->extflags & RXf_USE_INTUIT) { + s = re_intuit_start(rx, sv, s + UTF8SKIP(s), strend, flags, NULL); + if (!s) { + goto phooey; + } + } + else { + s += UTF8SKIP(s); + } + } + } /* end search for check string in unicode */ + else { + if (s == startpos) { + goto after_try_latin; + } + while (1) { + if (regtry(®info, &s)) { + goto got_it; + } + after_try_latin: + if (s > end) { + goto phooey; + } + if (prog->extflags & RXf_USE_INTUIT) { + s = re_intuit_start(rx, sv, s + 1, strend, flags, NULL); + if (!s) { + goto phooey; + } + } + else { + s++; + } + } + } /* end search for check string in latin*/ + } /* end search for check string */ + else { /* search for newline */ + if (s > startpos) { + /*XXX: The s-- is almost definitely wrong here under unicode - demeprhq*/ s--; + } + /* We can use a more efficient search as newlines are the same in unicode as they are in latin */ while (s < end) { if (*s++ == '\n') { /* don't need PL_utf8skip here */ if (regtry(®info, &s)) goto got_it; } - } - } - } + } + } /* end search for newline */ + } /* end anchored/multiline check string search */ goto phooey; } else if (RXf_GPOS_CHECK == (prog->extflags & RXf_GPOS_CHECK)) { @@ -839,8 +839,8 @@ struct body_details { + sizeof (((type*)SvANY((const SV *)0))->last_member) static const struct body_details bodies_by_type[] = { - { sizeof(HE), 0, 0, SVt_NULL, - FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) }, + /* HEs use this offset for their arena. */ + { 0, 0, 0, SVt_NULL, FALSE, NONV, NOARENA, 0 }, /* The bind placeholder pretends to be an RV for now. Also it's marked as "can't upgrade" to stop anyone using it before it's @@ -12740,6 +12740,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* Pluggable optimizer */ PL_peepp = proto_perl->Ipeepp; + PL_rpeepp = proto_perl->Irpeepp; /* op_free() hook */ PL_opfreehook = proto_perl->Iopfreehook; diff --git a/t/op/filetest_stack_ok.t b/t/op/filetest_stack_ok.t index 91e31e0a27..3c212b16fa 100644 --- a/t/op/filetest_stack_ok.t +++ b/t/op/filetest_stack_ok.t @@ -12,8 +12,35 @@ BEGIN { my @ops = split //, 'rwxoRWXOezsfdlpSbctugkTMBAC'; -plan( tests => @ops * 1 ); +plan( tests => @ops * 3 ); for my $op (@ops) { ok( 1 == @{ [ eval "-$op 'TEST'" ] }, "-$op returns single value" ); + + my $count = 0; + my $t; + for my $m ("a", "b") { + if ($count == 0) { + $t = eval "-$op _" ? 0 : "foo"; + } + elsif ($count == 1) { + is($m, "b", "-$op did not remove too many values from the stack"); + } + $count++; + } + + $count = 0; + for my $m ("c", "d") { + if ($count == 0) { + $t = eval "-$op -e \$^X" ? 0 : "bar"; + } + elsif ($count == 1) { + local $TODO; + if ($op eq 'T' or $op eq 't' or $op eq 'B') { + $TODO = "[perl #77388] stacked file test does not work with -$op"; + } + is($m, "d", "-$op -e \$^X did not remove too many values from the stack"); + } + $count++; + } } diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t index 87f6f7f8bd..3fbe27cb79 100644 --- a/t/porting/podcheck.t +++ b/t/porting/podcheck.t @@ -41,6 +41,7 @@ while (<$m>) { my ($file, $separator) = /^(\S+)(\s+)/; next if $file =~ /^cpan\//; next unless ($file =~ /\.(?:pm|pod|pl)$/); + next if $file eq 'autodoc.pl'; push @files, $file; }; @files = sort @files; # so we get consistent results diff --git a/t/re/pat.t b/t/re/pat.t index d7cf718521..447ac8f611 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -23,7 +23,7 @@ BEGIN { } -plan tests => 350; # Update this when adding/deleting tests. +plan tests => 366; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1003,6 +1003,46 @@ sub run_tests { ok $str=~/.*\z/, "implict MBOL check string disable does not break things length=$i"; } } + { + # we are actually testing that we dont die when executing these patterns + use utf8; + my $e = "Böck"; + ok(utf8::is_utf8($e),"got a unicode string - rt75680"); + + ok($e !~ m/.*?[x]$/, "unicode string against /.*?[x]\$/ - rt75680"); + ok($e !~ m/.*?\p{Space}$/i, "unicode string against /.*?\\p{space}\$/i - rt75680"); + ok($e !~ m/.*?[xyz]$/, "unicode string against /.*?[xyz]\$/ - rt75680"); + ok($e !~ m/(.*?)[,\p{isSpace}]+((?:\p{isAlpha}[\p{isSpace}\.]{1,2})+)\p{isSpace}*$/, "unicode string against big pattern - rt75680"); + } + { + # we are actually testing that we dont die when executing these patterns + my $e = "B\x{f6}ck"; + ok(!utf8::is_utf8($e), "got a latin string - rt75680"); + + ok($e !~ m/.*?[x]$/, "latin string against /.*?[x]\$/ - rt75680"); + ok($e !~ m/.*?\p{Space}$/i, "latin string against /.*?\\p{space}\$/i - rt75680"); + ok($e !~ m/.*?[xyz]$/,"latin string against /.*?[xyz]\$/ - rt75680"); + ok($e !~ m/(.*?)[,\p{isSpace}]+((?:\p{isAlpha}[\p{isSpace}\.]{1,2})+)\p{isSpace}*$/,"latin string against big pattern - rt75680"); + } + + { + # + # Tests for bug 77414. + # + + local $Message = '\p property after empty * match'; + { + local $TODO = "Bug 77414"; + ok "1" =~ /\s*\pN/; + ok "-" =~ /\s*\p{Dash}/; + ok " " =~ /\w*\p{Blank}/; + } + + ok "1" =~ /\s*\pN+/; + ok "-" =~ /\s*\p{Dash}{1}/; + ok " " =~ /\w*\p{Blank}{1,4}/; + + } } # End of sub run_tests diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index 881fd9eb24..ff96079296 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -21,7 +21,7 @@ BEGIN { } -plan tests => 1159; # Update this when adding/deleting tests. +plan tests => 1303; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1781,6 +1781,297 @@ sub run_tests { 'IsPunct agrees with [:punct:] with explicit Latin1'; } + + { + # Tests for [#perl 71942] + our $count_a; + our $count_b; + + my $c = 0; + for my $re ( +# [ +# should match?, +# input string, +# re 1, +# re 2, +# expected values of count_a and count_b, +# ] + [ + 0, + "xababz", + qr/a+(?{$count_a++})b?(*COMMIT)(*FAIL)/, + qr/a+(?{$count_b++})b?(*COMMIT)z/, + 1, + ], + [ + 0, + "xababz", + qr/a+(?{$count_a++})b?(*COMMIT)\s*(*FAIL)/, + qr/a+(?{$count_b++})b?(*COMMIT)\s*z/, + 1, + ], + [ + 0, + "xababz", + qr/a+(?{$count_a++})(?:b|)?(*COMMIT)(*FAIL)/, + qr/a+(?{$count_b++})(?:b|)?(*COMMIT)z/, + 1, + ], + [ + 0, + "xababz", + qr/a+(?{$count_a++})b{0,6}(*COMMIT)(*FAIL)/, + qr/a+(?{$count_b++})b{0,6}(*COMMIT)z/, + 1, + ], + [ + 0, + "xabcabcz", + qr/a+(?{$count_a++})(bc){0,6}(*COMMIT)(*FAIL)/, + qr/a+(?{$count_b++})(bc){0,6}(*COMMIT)z/, + 1, + ], + [ + 0, + "xabcabcz", + qr/a+(?{$count_a++})(bc*){0,6}(*COMMIT)(*FAIL)/, + qr/a+(?{$count_b++})(bc*){0,6}(*COMMIT)z/, + 1, + ], + + + [ + 0, + "aaaabtz", + qr/a+(?{$count_a++})b?(*PRUNE)(*FAIL)/, + qr/a+(?{$count_b++})b?(*PRUNE)z/, + 4, + ], + [ + 0, + "aaaabtz", + qr/a+(?{$count_a++})b?(*PRUNE)\s*(*FAIL)/, + qr/a+(?{$count_b++})b?(*PRUNE)\s*z/, + 4, + ], + [ + 0, + "aaaabtz", + qr/a+(?{$count_a++})(?:b|)(*PRUNE)(*FAIL)/, + qr/a+(?{$count_b++})(?:b|)(*PRUNE)z/, + 4, + ], + [ + 0, + "aaaabtz", + qr/a+(?{$count_a++})b{0,6}(*PRUNE)(*FAIL)/, + qr/a+(?{$count_b++})b{0,6}(*PRUNE)z/, + 4, + ], + [ + 0, + "aaaabctz", + qr/a+(?{$count_a++})(bc){0,6}(*PRUNE)(*FAIL)/, + qr/a+(?{$count_b++})(bc){0,6}(*PRUNE)z/, + 4, + ], + [ + 0, + "aaaabctz", + qr/a+(?{$count_a++})(bc*){0,6}(*PRUNE)(*FAIL)/, + qr/a+(?{$count_b++})(bc*){0,6}(*PRUNE)z/, + 4, + ], + + [ + 0, + "aaabaaab", + qr/a+(?{$count_a++;})b?(*SKIP)(*FAIL)/, + qr/a+(?{$count_b++;})b?(*SKIP)z/, + 2, + ], + [ + 0, + "aaabaaab", + qr/a+(?{$count_a++;})b?(*SKIP)\s*(*FAIL)/, + qr/a+(?{$count_b++;})b?(*SKIP)\s*z/, + 2, + ], + [ + 0, + "aaabaaab", + qr/a+(?{$count_a++;})(?:b|)(*SKIP)(*FAIL)/, + qr/a+(?{$count_b++;})(?:b|)(*SKIP)z/, + 2, + ], + [ + 0, + "aaabaaab", + qr/a+(?{$count_a++;})b{0,6}(*SKIP)(*FAIL)/, + qr/a+(?{$count_b++;})b{0,6}(*SKIP)z/, + 2, + ], + [ + 0, + "aaabcaaabc", + qr/a+(?{$count_a++;})(bc){0,6}(*SKIP)(*FAIL)/, + qr/a+(?{$count_b++;})(bc){0,6}(*SKIP)z/, + 2, + ], + [ + 0, + "aaabcaaabc", + qr/a+(?{$count_a++;})(bc*){0,6}(*SKIP)(*FAIL)/, + qr/a+(?{$count_b++;})(bc*){0,6}(*SKIP)z/, + 2, + ], + + + [ + 0, + "aaddbdaabyzc", + qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? b? (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? b? (*SKIP:T1) z \s* c \1 /x, + 4, + ], + [ + 0, + "aaddbdaabyzc", + qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? b? (*SKIP:T1) \s* (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? b? (*SKIP:T1) \s* z \s* c \1 /x, + 4, + ], + [ + 0, + "aaddbdaabyzc", + qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? (?:b|) (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? (?:b|) (*SKIP:T1) z \s* c \1 /x, + 4, + ], + [ + 0, + "aaddbdaabyzc", + qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? b{0,6} (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? b{0,6} (*SKIP:T1) z \s* c \1 /x, + 4, + ], + [ + 0, + "aaddbcdaabcyzc", + qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? (bc){0,6} (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? (bc){0,6} (*SKIP:T1) z \s* c \1 /x, + 4, + ], + [ + 0, + "aaddbcdaabcyzc", + qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? (bc*){0,6} (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? (bc*){0,6} (*SKIP:T1) z \s* c \1 /x, + 4, + ], + + + [ + 0, + "aaaaddbdaabyzc", + qr/a (?{$count_a++;}) (a?) (*MARK:T1) (a*) .*? b? (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (a?) (*MARK:T1) (a*) .*? b? (*MARK:T1) (*SKIP:T1) z \s* c \1 /x, + 2, + ], + [ + 0, + "aaaaddbdaabyzc", + qr/a (?{$count_a++;}) (a?) (*MARK:T1) (a*) .*? b? (*MARK:T1) (*SKIP:T1) \s* (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (a?) (*MARK:T1) (a*) .*? b? (*MARK:T1) (*SKIP:T1) \s* z \s* c \1 /x, + 2, + ], + [ + 0, + "aaaaddbdaabyzc", + qr/a (?{$count_a++;}) (a?) (*MARK:T1) (a*) .*? (?:b|) (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (a?) (*MARK:T1) (a*) .*? (?:b|) (*MARK:T1) (*SKIP:T1) z \s* c \1 /x, + 2, + ], + [ + 0, + "aaaaddbdaabyzc", + qr/a (?{$count_a++;}) (a?) (*MARK:T1) (a*) .*? b{0,6} (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (a?) (*MARK:T1) (a*) .*? b{0,6} (*MARK:T1) (*SKIP:T1) z \s* c \1 /x, + 2, + ], + [ + 0, + "aaaaddbcdaabcyzc", + qr/a (?{$count_a++;}) (a?) (*MARK:T1) (a*) .*? (bc){0,6} (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (a?) (*MARK:T1) (a*) .*? (bc){0,6} (*MARK:T1) (*SKIP:T1) z \s* c \1 /x, + 2, + ], + [ + 0, + "aaaaddbcdaabcyzc", + qr/a (?{$count_a++;}) (a?) (*MARK:T1) (a*) .*? (bc*){0,6} (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x, + qr/a (?{$count_b++;}) (a?) (*MARK:T1) (a*) .*? (bc*){0,6} (*MARK:T1) (*SKIP:T1) z \s* c \1 /x, + 2, + ], + + + [ + 0, + "AbcdCBefgBhiBqz", + qr/(A (.*) (?{ $count_a++ }) C? (*THEN) | A D) (*FAIL)/x, + qr/(A (.*) (?{ $count_b++ }) C? (*THEN) | A D) z/x, + 1, + ], + [ + 0, + "AbcdCBefgBhiBqz", + qr/(A (.*) (?{ $count_a++ }) C? (*THEN) | A D) \s* (*FAIL)/x, + qr/(A (.*) (?{ $count_b++ }) C? (*THEN) | A D) \s* z/x, + 1, + ], + [ + 0, + "AbcdCBefgBhiBqz", + qr/(A (.*) (?{ $count_a++ }) (?:C|) (*THEN) | A D) (*FAIL)/x, + qr/(A (.*) (?{ $count_b++ }) (?:C|) (*THEN) | A D) z/x, + 1, + ], + [ + 0, + "AbcdCBefgBhiBqz", + qr/(A (.*) (?{ $count_a++ }) C{0,6} (*THEN) | A D) (*FAIL)/x, + qr/(A (.*) (?{ $count_b++ }) C{0,6} (*THEN) | A D) z/x, + 1, + ], + [ + 0, + "AbcdCEBefgBhiBqz", + qr/(A (.*) (?{ $count_a++ }) (CE){0,6} (*THEN) | A D) (*FAIL)/x, + qr/(A (.*) (?{ $count_b++ }) (CE){0,6} (*THEN) | A D) z/x, + 1, + ], + [ + 0, + "AbcdCBefgBhiBqz", + qr/(A (.*) (?{ $count_a++ }) (CE*){0,6} (*THEN) | A D) (*FAIL)/x, + qr/(A (.*) (?{ $count_b++ }) (CE*){0,6} (*THEN) | A D) z/x, + 1, + ], + ) { + $c++; + $count_a = 0; + $count_b = 0; + + my $match_a = ($re->[1] =~ $re->[2]) || 0; + my $match_b = ($re->[1] =~ $re->[3]) || 0; + + iseq($match_a, $re->[0], "match a " . ($re->[0] ? "succeeded" : "failed") . " ($c)"); + iseq($match_b, $re->[0], "match b " . ($re->[0] ? "succeeded" : "failed") . " ($c)"); + iseq($count_a, $re->[4], "count a ($c)"); + iseq($count_b, $re->[4], "count b ($c)"); + } + } + # # Keep the following tests last -- they may crash perl # @@ -6489,12 +6489,15 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv) { dVAR; SV * const dbsv = GvSVn(PL_DBsub); + const bool save_taint = PL_tainted; + /* We do not care about using sv to call CV; * it's for informational purposes only. */ PERL_ARGS_ASSERT_GET_DB_SUB; + PL_tainted = FALSE; save_item(dbsv); if (!PERLDB_SUB_NN) { GV * const gv = CvGV(cv); @@ -6521,6 +6524,7 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv) (void)SvIOK_on(dbsv); SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */ } + TAINT_IF(save_taint); } int diff --git a/win32/config.gc64 b/win32/config.gc64 index cf6d4649ec..f1dbea6f8b 100644 --- a/win32/config.gc64 +++ b/win32/config.gc64 @@ -51,6 +51,7 @@ ccversion='' cf_by='nobody' cf_email='nobody@no.where.net' cf_time='' +charbits='8' chgrp='' chmod='' chown='' @@ -344,6 +345,8 @@ d_phostname='undef' d_pipe='define' d_poll='undef' d_portable='define' +d_prctl='undef' +d_prctl_set_name='undef' d_printf_format_null='undef' d_procselfexe='undef' d_pseudofork='undef' @@ -444,6 +447,7 @@ d_srandom_r='undef' d_sresgproto='undef' d_sresuproto='undef' d_statblks='undef' +d_static_inline='undef' d_statfs_f_flags='undef' d_statfs_s='undef' d_statvfs='undef' @@ -848,6 +852,7 @@ perl_patchlevel='~PERL_PATCHLEVEL~' perladmin='' perllibs='~libs~' perlpath='~INST_TOP~~INST_VER~\bin~INST_ARCH~\perl.exe' +perl_static_inline='' pg='' phostname='hostname' pidtype='int' @@ -1038,6 +1043,7 @@ uvsize='8' uvtype='unsigned long long' uvuformat='"I64u"' uvxformat='"I64x"' +vaproto='undef' vendorarch='' vendorarchexp='' vendorbin='' diff --git a/win32/config.gc64nox b/win32/config.gc64nox index f33fba531c..6d2ca7f5bd 100644 --- a/win32/config.gc64nox +++ b/win32/config.gc64nox @@ -51,6 +51,7 @@ ccversion='' cf_by='nobody' cf_email='nobody@no.where.net' cf_time='' +charbits='8' chgrp='' chmod='' chown='' @@ -344,6 +345,8 @@ d_phostname='undef' d_pipe='define' d_poll='undef' d_portable='define' +d_prctl='undef' +d_prctl_set_name='undef' d_printf_format_null='undef' d_procselfexe='undef' d_pseudofork='undef' @@ -444,6 +447,7 @@ d_srandom_r='undef' d_sresgproto='undef' d_sresuproto='undef' d_statblks='undef' +d_static_inline='undef' d_statfs_f_flags='undef' d_statfs_s='undef' d_statvfs='undef' @@ -848,6 +852,7 @@ perl_patchlevel='~PERL_PATCHLEVEL~' perladmin='' perllibs='~libs~' perlpath='~INST_TOP~~INST_VER~\bin~INST_ARCH~\perl.exe' +perl_static_inline='' pg='' phostname='hostname' pidtype='int' @@ -1038,6 +1043,7 @@ uvsize='8' uvtype='unsigned long long' uvuformat='"I64u"' uvxformat='"I64x"' +vaproto='undef' vendorarch='' vendorarchexp='' vendorbin='' |