diff options
Diffstat (limited to 'gnu/usr.bin/perl/ext')
54 files changed, 356 insertions, 1453 deletions
diff --git a/gnu/usr.bin/perl/ext/B/B.pm b/gnu/usr.bin/perl/ext/B/B.pm index ce061e49101..2d9b2d064d0 100644 --- a/gnu/usr.bin/perl/ext/B/B.pm +++ b/gnu/usr.bin/perl/ext/B/B.pm @@ -20,7 +20,7 @@ sub import { # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.74'; + $B::VERSION = '1.76'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. @@ -1194,8 +1194,6 @@ The C<B::COP> class is used for "nextstate" and "dbstate" ops. As of Perl =item cop_seq -=item arybase - =item line =item warnings diff --git a/gnu/usr.bin/perl/ext/B/B.xs b/gnu/usr.bin/perl/ext/B/B.xs index d9d77157c67..d8fc22a1fac 100644 --- a/gnu/usr.bin/perl/ext/B/B.xs +++ b/gnu/usr.bin/perl/ext/B/B.xs @@ -635,11 +635,7 @@ BOOT: cv = newXS("B::diehook", intrpvar_sv_common, file); ASSIGN_COMMON_ALIAS(I, diehook); sv = get_sv("B::OP::does_parent", GV_ADDMULTI); -#ifdef PERL_OP_PARENT sv_setsv(sv, &PL_sv_yes); -#else - sv_setsv(sv, &PL_sv_no); -#endif } void diff --git a/gnu/usr.bin/perl/ext/B/B/Concise.pm b/gnu/usr.bin/perl/ext/B/B/Concise.pm index 9032e9b082b..729fcd95f48 100644 --- a/gnu/usr.bin/perl/ext/B/B/Concise.pm +++ b/gnu/usr.bin/perl/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "1.003"; +our $VERSION = "1.004"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -1284,7 +1284,7 @@ This is mainly a joke. =item B<-debug> -Use formatting conventions reminiscent of B<B::Debug>; these aren't +Use formatting conventions reminiscent of CPAN module B<B::Debug>; these aren't very concise at all. =item B<-env> diff --git a/gnu/usr.bin/perl/ext/B/t/b.t b/gnu/usr.bin/perl/ext/B/t/b.t index 09dba39b1dd..e1279ff9355 100644 --- a/gnu/usr.bin/perl/ext/B/t/b.t +++ b/gnu/usr.bin/perl/ext/B/t/b.t @@ -460,9 +460,7 @@ is $regexp->precomp, 'fit', 'pmregexp returns the right regexp'; # test op_parent SKIP: { - unless ($B::OP::does_parent) { - skip "op_parent only present with -DPERL_OP_PARENT builds", 6; - } + ok($B::OP::does_parent, "does_parent always set"); my $lineseq = B::svref_2object(sub{my $x = 1})->ROOT->first; is ($lineseq->type, B::opnumber('lineseq'), 'op_parent: top op is lineseq'); diff --git a/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm b/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm index 3d790e763ad..bd56b86a60c 100644 --- a/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm +++ b/gnu/usr.bin/perl/ext/Devel-Peek/Peek.pm @@ -3,7 +3,7 @@ package Devel::Peek; -$VERSION = '1.27'; +$VERSION = '1.28'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -411,28 +411,25 @@ The following shows the raw form of a reference to a hash. The output: - SV = IV(0x8177858) at 0x816a618 - REFCNT = 1 - FLAGS = (ROK) - RV = 0x814fc10 - SV = PVHV(0x8167768) at 0x814fc10 - REFCNT = 1 - FLAGS = (SHAREKEYS) - ARRAY = 0x816c5b8 (0:7, 1:1) - hash quality = 100.0% - KEYS = 1 - FILL = 1 - MAX = 7 - RITER = -1 - EITER = 0x0 - Elt "hello" HASH = 0xc8fd181b - SV = IV(0x816c030) at 0x814fcf4 - REFCNT = 1 - FLAGS = (IOK,pIOK) - IV = 42 - -This shows C<$a> is a reference pointing to an SV. That SV is a PVHV, a -hash. Fields RITER and EITER are used by C<L<perlfunc/each>>. + SV = IV(0x55cb50b50fb0) at 0x55cb50b50fc0 + REFCNT = 1 + FLAGS = (ROK) + RV = 0x55cb50b2b758 + SV = PVHV(0x55cb50b319c0) at 0x55cb50b2b758 + REFCNT = 1 + FLAGS = (SHAREKEYS) + ARRAY = 0x55cb50b941a0 (0:7, 1:1) + hash quality = 100.0% + KEYS = 1 + FILL = 1 + MAX = 7 + Elt "hello" HASH = 0x3128ece4 + SV = IV(0x55cb50b464f8) at 0x55cb50b46508 + REFCNT = 1 + FLAGS = (IOK,pIOK) + IV = 42 + +This shows C<$a> is a reference pointing to an SV. That SV is a PVHV, a hash. The "quality" of a hash is defined as the total number of comparisons needed to access every element once, relative to the expected number needed for a diff --git a/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t b/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t index 2c0c849cf6b..f3f781ac6bb 100755 --- a/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t +++ b/gnu/usr.bin/perl/ext/Devel-Peek/t/Peek.t @@ -286,8 +286,7 @@ do_test('reference to hash', MAX = 7 Elt "123" HASH = $ADDR' . $c_pattern, '', - $] < 5.015 - && 'The hash iterator used in dump.c sets the OOK flag'); + ($] < 5.015) ? 'The hash iterator used in dump.c sets the OOK flag' : undef); do_test('reference to anon sub with empty prototype', sub(){@_}, @@ -457,7 +456,7 @@ do_test('reference to blessed hash', FILL = 0 MAX = 7', '', $] >= 5.015 - ? 0 + ? undef : 'The hash iterator used in dump.c sets the OOK flag'); do_test('typeglob', @@ -535,7 +534,7 @@ do_test('reference to hash containing Unicode', COW_REFCNT = 1 # $] < 5.019007 ', '', $] >= 5.015 - ? 0 + ? undef : 'The hash iterator used in dump.c sets the OOK flag'); } else { do_test('reference to hash containing Unicode', @@ -562,7 +561,7 @@ do_test('reference to hash containing Unicode', COW_REFCNT = 1 # $] < 5.019007 ', '', $] >= 5.015 - ? 0 + ? undef : 'The hash iterator used in dump.c sets the OOK flag'); } @@ -767,7 +766,7 @@ do_test('blessing to a class with embedded NUL characters', FILL = 0 MAX = 7', '', $] >= 5.015 - ? 0 + ? undef : 'The hash iterator used in dump.c sets the OOK flag'); do_test('ENAME on a stash', @@ -928,7 +927,7 @@ do_test('small hash after keys and scalar', # Dump with arrays, hashes, and operator return values @array = 1..3; -do_test('Dump @array', '@array', <<'ARRAY', '', '', 1); +do_test('Dump @array', '@array', <<'ARRAY', '', undef, 1); SV = PVAV\($ADDR\) at $ADDR REFCNT = 1 FLAGS = \(\) @@ -953,7 +952,7 @@ SV = PVAV\($ADDR\) at $ADDR IV = 3 ARRAY -do_test('Dump @array,1', '@array,1', <<'ARRAY', '', '', 1); +do_test('Dump @array,1', '@array,1', <<'ARRAY', '', undef, 1); SV = PVAV\($ADDR\) at $ADDR REFCNT = 1 FLAGS = \(\) @@ -969,7 +968,7 @@ SV = PVAV\($ADDR\) at $ADDR ARRAY %hash = 1..2; -do_test('Dump %hash', '%hash', <<'HASH', '', '', 1); +do_test('Dump %hash', '%hash', <<'HASH', '', undef, 1); SV = PVHV\($ADDR\) at $ADDR REFCNT = 1 FLAGS = \(SHAREKEYS\) @@ -986,7 +985,7 @@ SV = PVHV\($ADDR\) at $ADDR HASH $_ = "hello"; -do_test('rvalue substr', 'substr $_, 1, 2', <<'SUBSTR', '', '', 1); +do_test('rvalue substr', 'substr $_, 1, 2', <<'SUBSTR', '', undef, 1); SV = PV\($ADDR\) at $ADDR REFCNT = 1 FLAGS = \(PADTMP,POK,pPOK\) diff --git a/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL b/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL index 81bd54665a7..864af3ed8e2 100644 --- a/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL +++ b/gnu/usr.bin/perl/ext/DynaLoader/Makefile.PL @@ -65,8 +65,8 @@ sub MY::static { return " $object : \$(FIRST_MAKEFILE) \$(OBJECT) - #\$(RM_RF) $object - #\$(CP) \$(OBJECT) $object + \$(RM_RF) $object + \$(CP) \$(OBJECT) $object static :: $object "; diff --git a/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL b/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL index d565f31b2fe..84fd151d276 100644 --- a/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL +++ b/gnu/usr.bin/perl/ext/Errno/Errno_pm.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; use Config; use strict; -our $VERSION = "1.29"; +our $VERSION = "1.30"; my %err = (); @@ -111,6 +111,17 @@ sub default_cpp { sub get_files { my %file = (); + # When cross-compiling we may store a path for gcc's "sysroot" option: + my $sysroot = $Config{sysroot} || ''; + my $linux_errno_h; + if ($^O eq 'linux') { + # Some Linuxes have weird errno.hs which generate + # no #file or #line directives + ($linux_errno_h) = grep { -e $_ } map { "$_/errno.h" } + "$sysroot/usr/include", "$sysroot/usr/local/include", + split / / => $Config{locincpth}; + } + # VMS keeps its include files in system libraries if ($^O eq 'VMS') { $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1; @@ -125,17 +136,10 @@ sub get_files { } } elsif ($^O eq 'linux' && $Config{gccversion} ne '' && - $Config{gccversion} !~ /intel/i + $Config{gccversion} !~ /intel/i && # might be using, say, Intel's icc + $linux_errno_h ) { - # When cross-compiling we may store a path for gcc's "sysroot" option: - my $sysroot = $Config{sysroot} || ''; - # Some Linuxes have weird errno.hs which generate - # no #file or #line directives - my ($linux_errno_h) = grep { -e $_ } map { "$_/errno.h" } - "$sysroot/usr/include", "$sysroot/usr/local/include", - split / / => $Config{locincpth} or - die "Cannot find errno.h"; $file{$linux_errno_h} = 1; } elsif ($^O eq 'haiku') { # hidden in a special place diff --git a/gnu/usr.bin/perl/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm b/gnu/usr.bin/perl/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm index 6090970adc9..46af2a60739 100644 --- a/gnu/usr.bin/perl/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm +++ b/gnu/usr.bin/perl/ext/ExtUtils-Miniperl/lib/ExtUtils/Miniperl.pm @@ -6,7 +6,7 @@ use ExtUtils::Embed 1.31, qw(xsi_header xsi_protos xsi_body); our @ISA = qw(Exporter); our @EXPORT = qw(writemain); -our $VERSION = '1.08'; +our $VERSION = '1.09'; # blead will run this with miniperl, hence we can't use autodie or File::Temp my $temp; @@ -63,7 +63,7 @@ sub writemain{ * * The content of the body of this generated file is mostly contained * in Miniperl.pm - edit that file if you want to change anything. - * miniperlmain.c is generated by running regen/miniperlmain.pl.pl, while + * miniperlmain.c is generated by running regen/miniperlmain.pl, while * perlmain.c is built automatically by Makefile (so the former is * included in the tarball while the latter isn't). */ @@ -78,6 +78,11 @@ sub writemain{ #endif #define PERL_IN_MINIPERLMAIN_C + +/* work round bug in MakeMaker which doesn't currently (2019) supply this + * flag when making a statically linked perl */ +#define PERL_CORE 1 + %s static void xs_init (pTHX); static PerlInterpreter *my_perl; diff --git a/gnu/usr.bin/perl/ext/File-Find/lib/File/Find.pm b/gnu/usr.bin/perl/ext/File-Find/lib/File/Find.pm index 03dac9fbda7..5fb9ee02fe4 100644 --- a/gnu/usr.bin/perl/ext/File-Find/lib/File/Find.pm +++ b/gnu/usr.bin/perl/ext/File-Find/lib/File/Find.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; use warnings::register; -our $VERSION = '1.34'; +our $VERSION = '1.36'; require Exporter; require Cwd; @@ -12,8 +12,8 @@ our @EXPORT = qw(find finddepth); use strict; -my $Is_VMS; -my $Is_Win32; +my $Is_VMS = $^O eq 'VMS'; +my $Is_Win32 = $^O eq 'MSWin32'; require File::Basename; require File::Spec; @@ -770,31 +770,11 @@ sub finddepth { $File::Find::skip_pattern = qr/^\.{1,2}\z/; $File::Find::untaint_pattern = qr|^([-+@\w./]+)$|; -# These are hard-coded for now, but may move to hint files. -if ($^O eq 'VMS') { - $Is_VMS = 1; - $File::Find::dont_use_nlink = 1; -} -elsif ($^O eq 'MSWin32') { - $Is_Win32 = 1; -} - # this _should_ work properly on all platforms # where File::Find can be expected to work $File::Find::current_dir = File::Spec->curdir || '.'; -$File::Find::dont_use_nlink = 1 - if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $Is_Win32 || - $^O eq 'interix' || $^O eq 'cygwin' || $^O eq 'qnx' || $^O eq 'nto'; - -# Set dont_use_nlink in your hint file if your system's stat doesn't -# report the number of links in a directory as an indication -# of the number of files. -# See e.g. hints/haiku.sh for Haiku. -unless ($File::Find::dont_use_nlink) { - require Config; - $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); -} +$File::Find::dont_use_nlink = 1; # We need a function that checks if a scalar is tainted. Either use the # Scalar::Util module's tainted() function or our (slower) pure Perl @@ -1106,17 +1086,15 @@ warnings. =item $dont_use_nlink -You can set the variable C<$File::Find::dont_use_nlink> to 1 if you want to -force File::Find to always stat directories. This was used for file systems -that do not have an C<nlink> count matching the number of sub-directories. -Examples are ISO-9660 (CD-ROM), AFS, HPFS (OS/2 file system), FAT (DOS file -system) and a couple of others. +You can set the variable C<$File::Find::dont_use_nlink> to 0 if you +are sure the filesystem you are scanning reflects the number of +subdirectories in the parent directory's C<nlink> count. -You shouldn't need to set this variable, since File::Find should now detect -such file systems on-the-fly and switch itself to using stat. This works even -for parts of your file system, like a mounted CD-ROM. +If you do set C<$File::Find::dont_use_nlink> to 0, you may notice an +improvement in speed at the risk of not recursing into subdirectories +if a filesystem doesn't populate C<nlink> as expected. -If you do set C<$File::Find::dont_use_nlink> to 1, you will notice slow-downs. +C<$File::Find::dont_use_nlink> now defaults to 1 on all platforms. =item symlinks diff --git a/gnu/usr.bin/perl/ext/File-Find/t/find.t b/gnu/usr.bin/perl/ext/File-Find/t/find.t index b532752a5a2..b0e30eb4782 100644 --- a/gnu/usr.bin/perl/ext/File-Find/t/find.t +++ b/gnu/usr.bin/perl/ext/File-Find/t/find.t @@ -90,46 +90,6 @@ finddepth({wanted => sub { ++$::count_taint if $_ eq 'taint.t'; } }, File::Spec->curdir); is($::count_taint, 1, "'finddepth' found exactly 1 file named 'taint.t'"); -##### RT #122547 ##### -# Do find() and finddepth() correctly warn on invalid options? -{ - my $bad_option = 'foobar'; - my $second_bad_option = 'really_foobar'; - - $::count_taint = 0; - local $SIG{__WARN__} = sub { $warn_msg = $_[0]; }; - { - find( - { - wanted => sub { ++$::count_taint if $_ eq 'taint.t'; }, - $bad_option => undef, - }, - File::Spec->curdir - ); - }; - like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); - like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); - is($::count_taint, 1, "count_taint incremented"); - undef $warn_msg; - - $::count_taint = 0; - { - finddepth( - { - wanted => sub { ++$::count_taint if $_ eq 'taint.t'; }, - $bad_option => undef, - $second_bad_option => undef, - }, - File::Spec->curdir - ); - }; - like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); - like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); - like($warn_msg, qr/$second_bad_option/s, "Got warning for $second_bad_option"); - is($::count_taint, 1, "count_taint incremented"); - undef $warn_msg; -} - my $FastFileTests_OK = 0; sub cleanup { @@ -283,22 +243,72 @@ sub my_postprocess { mkdir_ok( dir_path('for_find'), 0770 ); ok( chdir( dir_path('for_find')), "Able to chdir to 'for_find'") or die("Unable to chdir to 'for_find'"); + +my @testing_basenames = ( qw| fb_ord fba_ord fa_ord faa_ord fab_ord faba_ord | ); + mkdir_ok( dir_path('fa'), 0770 ); mkdir_ok( dir_path('fb'), 0770 ); -create_file_ok( file_path('fb', 'fb_ord') ); +create_file_ok( file_path('fb', $testing_basenames[0]) ); mkdir_ok( dir_path('fb', 'fba'), 0770 ); -create_file_ok( file_path('fb', 'fba', 'fba_ord') ); +create_file_ok( file_path('fb', 'fba', $testing_basenames[1]) ); if ($symlink_exists) { symlink_ok('../fb','fa/fsl'); } -create_file_ok( file_path('fa', 'fa_ord') ); +create_file_ok( file_path('fa', $testing_basenames[2]) ); mkdir_ok( dir_path('fa', 'faa'), 0770 ); -create_file_ok( file_path('fa', 'faa', 'faa_ord') ); +create_file_ok( file_path('fa', 'faa', $testing_basenames[3]) ); mkdir_ok( dir_path('fa', 'fab'), 0770 ); -create_file_ok( file_path('fa', 'fab', 'fab_ord') ); +create_file_ok( file_path('fa', 'fab', $testing_basenames[4]) ); mkdir_ok( dir_path('fa', 'fab', 'faba'), 0770 ); -create_file_ok( file_path('fa', 'fab', 'faba', 'faba_ord') ); +create_file_ok( file_path('fa', 'fab', 'faba', $testing_basenames[5]) ); + +##### RT #122547 ##### +# Do find() and finddepth() correctly warn on invalid options? +##### RT #133771 ##### +# When running tests in parallel, avoid clash with tests in +# ext/File-Find/t/taint by moving into the temporary testing directory +# before testing for warnings on invalid options. + +my %tb = map { $_ => 1 } @testing_basenames; + +{ + my $bad_option = 'foobar'; + my $second_bad_option = 'really_foobar'; + + $::count_tb = 0; + local $SIG{__WARN__} = sub { $warn_msg = $_[0]; }; + { + find( + { + wanted => sub { ++$::count_tb if $tb{$_}; }, + $bad_option => undef, + }, + File::Spec->curdir + ); + }; + like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); + like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); + is($::count_tb, scalar(@testing_basenames), "count_tb incremented"); + undef $warn_msg; + + $::count_tb = 0; + { + finddepth( + { + wanted => sub { ++$::count_tb if $tb{$_}; }, + $bad_option => undef, + $second_bad_option => undef, + }, + File::Spec->curdir + ); + }; + like($warn_msg, qr/Invalid option/s, "Got warning for invalid option"); + like($warn_msg, qr/$bad_option/s, "Got warning for $bad_option"); + like($warn_msg, qr/$second_bad_option/s, "Got warning for $second_bad_option"); + is($::count_tb, scalar(@testing_basenames), "count_tb incremented"); + undef $warn_msg; +} ##### Basic tests for find() ##### # Set up list of files we expect to find. diff --git a/gnu/usr.bin/perl/ext/File-Glob/Glob.pm b/gnu/usr.bin/perl/ext/File-Glob/Glob.pm index 07df4941a10..368a755f509 100644 --- a/gnu/usr.bin/perl/ext/File-Glob/Glob.pm +++ b/gnu/usr.bin/perl/ext/File-Glob/Glob.pm @@ -13,7 +13,7 @@ require XSLoader; %EXPORT_TAGS = ( 'glob' => [ qw( GLOB_ABEND - GLOB_ALPHASORT + GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_CSH @@ -29,15 +29,13 @@ require XSLoader; GLOB_QUOTE GLOB_TILDE bsd_glob - glob ) ], ); $EXPORT_TAGS{bsd_glob} = [@{$EXPORT_TAGS{glob}}]; -pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob" @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.31'; +$VERSION = '1.32'; sub import { require Exporter; @@ -72,17 +70,11 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) { $DEFAULT_FLAGS |= GLOB_NOCASE(); } -# File::Glob::glob() is deprecated because its prototype is different from -# CORE::glob() (use bsd_glob() instead) +# File::Glob::glob() removed in perl-5.30 because its prototype is different +# from CORE::glob() (use bsd_glob() instead) sub glob { - use 5.024; - use warnings (); - warnings::warnif (deprecated => - "File::Glob::glob() will disappear in perl 5.30. " . - "Use File::Glob::bsd_glob() instead.") unless state $warned ++; - - splice @_, 1; # no flags - goto &bsd_glob; + die "File::Glob::glob() was removed in perl 5.30. " . + "Use File::Glob::bsd_glob() instead. $!"; } 1; diff --git a/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm index a33b8b59b12..b4fc49f42e8 100644 --- a/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm +++ b/gnu/usr.bin/perl/ext/GDBM_File/GDBM_File.pm @@ -31,6 +31,18 @@ C<ftp.gnu.org>, but you are strongly urged to use one of the many mirrors. You can obtain a list of mirror sites from L<http://www.gnu.org/order/ftp.html>. +=head1 SECURITY AND PORTABILITY + +B<Do not accept GDBM files from untrusted sources.> + +GDBM files are not portable across platforms. + +The GDBM documentation doesn't imply that files from untrusted sources +can be safely used with C<libgdbm>. + +A maliciously crafted file might cause perl to crash or even expose a +security vulnerability. + =head1 BUGS The available functions and the gdbm/perl interface need to be documented. @@ -73,7 +85,7 @@ require XSLoader; ); # This module isn't dual life, so no need for dev version numbers. -$VERSION = '1.17'; +$VERSION = '1.18'; XSLoader::load(); diff --git a/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm b/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm index 8ba76f2d512..a0fc52a9f33 100644 --- a/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm +++ b/gnu/usr.bin/perl/ext/I18N-Langinfo/Langinfo.pm @@ -72,7 +72,7 @@ our @EXPORT_OK = qw( YESSTR ); -our $VERSION = '0.17'; +our $VERSION = '0.18'; XSLoader::load(); @@ -92,7 +92,7 @@ I18N::Langinfo - query locale information The langinfo() function queries various locale information that can be used to localize output and user interfaces. It uses the current underlying locale, regardless of whether or not it was called from within the scope of -S<C<use locale>>. The langinfo() requires +S<C<use locale>>. The langinfo() function requires one numeric argument that identifies the locale constant to query: if no argument is supplied, C<$_> is used. The numeric constants appropriate to be used as arguments are exportable from I18N::Langinfo. @@ -273,7 +273,7 @@ workaround for this; patches welcome: see L<perlapi/switch_to_global_locale>. L<perllocale>, L<POSIX/localeconv>, L<POSIX/setlocale>, L<nl_langinfo(3)>. -The langinfo() is just a wrapper for the C nl_langinfo() interface. +The langinfo() function is just a wrapper for the C nl_langinfo() interface. =head1 AUTHOR diff --git a/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL index 539a377488f..fe2cb407f57 100644 --- a/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL +++ b/gnu/usr.bin/perl/ext/NDBM_File/Makefile.PL @@ -1,7 +1,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'NDBM_File', - #LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"], + LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"], XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'NDBM_File.pm', ); diff --git a/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm index fc250ec840b..ead745da24b 100644 --- a/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm +++ b/gnu/usr.bin/perl/ext/NDBM_File/NDBM_File.pm @@ -7,7 +7,7 @@ require Tie::Hash; require XSLoader; our @ISA = qw(Tie::Hash); -our $VERSION = "1.14"; +our $VERSION = "1.15"; XSLoader::load(); @@ -104,6 +104,23 @@ This warning is emitted when you try to store a key or a value that is too long. It means that the change was not recorded in the database. See BUGS AND WARNINGS below. +=head1 SECURITY AND PORTABILITY + +B<Do not accept NDBM files from untrusted sources.> + +On modern Linux systems these are typically GDBM files, which are not +portable across platforms. + +The GDBM documentation doesn't imply that files from untrusted sources +can be safely used with C<libgdbm>. + +Systems that don't use GDBM compatibilty for ndbm support will be +using a platform specific library, possibly inherited from BSD +systems, where it may or may not be safe to use an untrusted file. + +A maliciously crafted file might cause perl to crash or even expose a +security vulnerability. + =head1 BUGS AND WARNINGS There are a number of limits on the size of the data that you can diff --git a/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.pm b/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.pm index 99799bc5209..7bdbecc73cc 100644 --- a/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.pm +++ b/gnu/usr.bin/perl/ext/ODBM_File/ODBM_File.pm @@ -7,7 +7,7 @@ require Tie::Hash; require XSLoader; our @ISA = qw(Tie::Hash); -our $VERSION = "1.15"; +our $VERSION = "1.16"; XSLoader::load(); @@ -101,6 +101,23 @@ This warning is emitted when you try to store a key or a value that is too long. It means that the change was not recorded in the database. See BUGS AND WARNINGS below. +=head1 SECURITY AND PORTABILITY + +B<Do not accept ODBM files from untrusted sources.> + +On modern Linux systems these are typically GDBM files, which are not +portable across platforms. + +The GDBM documentation doesn't imply that files from untrusted sources +can be safely used with C<libgdbm>. + +Systems that don't use GDBM compatibilty for old dbm support will be +using a platform specific library, possibly inherited from BSD +systems, where it may or may not be safe to use an untrusted file. + +A maliciously crafted file might cause perl to crash or even expose a +security vulnerability. + =head1 BUGS AND WARNINGS There are a number of limits on the size of the data that you can diff --git a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs index 74973058417..5b9bbc429b9 100644 --- a/gnu/usr.bin/perl/ext/POSIX/POSIX.xs +++ b/gnu/usr.bin/perl/ext/POSIX/POSIX.xs @@ -64,6 +64,13 @@ static int not_here(const char *s); # include <sys/resource.h> #endif +/* Cygwin's stdio.h doesn't make cuserid() visible with -D_GNU_SOURCE, + unlike Linux. +*/ +#ifdef __CYGWIN__ +# undef HAS_CUSERID +#endif + #if defined(USE_QUADMATH) && defined(I_QUADMATH) # undef M_E @@ -565,7 +572,7 @@ static int not_here(const char *s); # undef c99_trunc #endif -#ifdef WIN32 +#ifdef _MSC_VER /* Some APIs exist under Win32 with "underbar" names. */ # undef c99_hypot @@ -2416,7 +2423,7 @@ acos(x) #endif break; case 17: - RETVAL = log10(x); /* C89 math */ + RETVAL = Perl_log10(x); /* C89 math */ break; case 18: #ifdef c99_log1p @@ -2828,6 +2835,10 @@ NV ldexp(x,exp) NV x int exp + CODE: + RETVAL = Perl_ldexp(x, exp); + OUTPUT: + RETVAL void modf(x) @@ -3318,10 +3329,15 @@ mblen(s, n) #endif CODE: #if defined(USE_ITHREADS) && defined(HAS_MBRLEN) - PERL_UNUSED_RESULT(mbrlen(NULL, 0, &ps)); /* Initialize state */ + memset(&ps, 0, sizeof(ps)); /* Initialize state */ RETVAL = mbrlen(s, n, &ps); /* Prefer reentrant version */ #else + /* This might prevent some races, but locales can be switched out + * without locking, so this isn't a cure all */ + LOCALE_LOCK; + RETVAL = mblen(s, n); + LOCALE_UNLOCK; #endif OUTPUT: RETVAL @@ -3421,7 +3437,7 @@ strtol(str, base = 0) long num; char *unparsed; PPCODE: - if (base == 0 || (base >= 2 && base <= 36)) { + if (base == 0 || inRANGE(base, 2, 36)) { num = strtol(str, &unparsed, base); #if IVSIZE < LONGSIZE if (num < IV_MIN || num > IV_MAX) @@ -3455,7 +3471,7 @@ strtoul(str, base = 0) PPCODE: PERL_UNUSED_VAR(str); PERL_UNUSED_VAR(base); - if (base == 0 || (base >= 2 && base <= 36)) { + if (base == 0 || inRANGE(base, 2, 36)) { num = strtoul(str, &unparsed, base); #if IVSIZE <= LONGSIZE if (num > IV_MAX) @@ -3658,7 +3674,8 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) #else /* If can't check directly, at least can see if script is consistent, under UTF-8, which gives us an extra measure of confidence. */ - && isSCRIPT_RUN((const U8 *) buf, buf + len, + && isSCRIPT_RUN((const U8 *) buf, + (const U8 *) buf + len, TRUE) /* Means assume UTF-8 */ #endif )) { diff --git a/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pm b/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pm index ae33cad9924..4de039410f4 100644 --- a/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pm +++ b/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.84'; +our $VERSION = '1.88'; require XSLoader; diff --git a/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pod b/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pod index a319b0df3a3..e4f9a3d18fb 100644 --- a/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pod +++ b/gnu/usr.bin/perl/ext/POSIX/lib/POSIX.pod @@ -235,6 +235,9 @@ the exception that C<POSIX::chmod()> can only change one file at a time $c = POSIX::chmod 0664, $file1, $file2; # throws exception +As with the built-in C<chmod()>, C<$file> may be a filename or a file +handle. + =item C<chown> This is identical to Perl's builtin C<chown()> function, allowing one @@ -307,12 +310,15 @@ Generates the path name for the controlling terminal. This is identical to the C function C<ctime()> and equivalent to C<asctime(localtime(...))>, see L</asctime> and L</localtime>. -=item C<cuserid> +=item C<cuserid> [POSIX.1-1988] Get the login name of the owner of the current process. $name = POSIX::cuserid(); +Note: this function has not been specified by POSIX since 1990 and is included +only for backwards compatibility. New code should use L<C<getlogin()>|perlfunc/getlogin> instead. + =item C<difftime> This is identical to the C function C<difftime()>, for returning @@ -1377,8 +1383,8 @@ See also L</remquo>. =item C<remove> -This is identical to Perl's builtin C<unlink()> function -for removing files, see L<perlfunc/unlink>. +Deletes a name from the filesystem. Calls L<perlfunc/unlink> for +files and L<perlfunc/rmdir> for directories. =item C<remquo> diff --git a/gnu/usr.bin/perl/ext/POSIX/t/math.t b/gnu/usr.bin/perl/ext/POSIX/t/math.t index 0426e03ae18..abcdb3d2409 100644 --- a/gnu/usr.bin/perl/ext/POSIX/t/math.t +++ b/gnu/usr.bin/perl/ext/POSIX/t/math.t @@ -76,12 +76,17 @@ sub near { } SKIP: { + unless ($Config{d_acosh}) { skip "no acosh, suspecting no C99 math"; } - if ($^O =~ /Win32|VMS/) { + if ($^O =~ /VMS/) { skip "running in $^O, C99 math support uneven"; } + if ($Config{cc} =~ /\b(?:cl|icl)/) { + skip "Microsoft compiler - C99 math support uneven"; + } + near(M_SQRT2, 1.4142135623731, "M_SQRT2", 1e-9); near(M_E, 2.71828182845905, "M_E", 1e-9); near(M_PI, 3.14159265358979, "M_PI", 1e-9); diff --git a/gnu/usr.bin/perl/ext/POSIX/t/posix.t b/gnu/usr.bin/perl/ext/POSIX/t/posix.t index 1b2dd4010b8..25099ea54a9 100644 --- a/gnu/usr.bin/perl/ext/POSIX/t/posix.t +++ b/gnu/usr.bin/perl/ext/POSIX/t/posix.t @@ -10,7 +10,7 @@ BEGIN { require 'loc_tools.pl'; } -use Test::More tests => 93; +use Test::More tests => 96; use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write errno localeconv dup dup2 lseek access); @@ -155,9 +155,10 @@ else { like( getcwd(), qr/$pat/, 'getcwd' ); # Check string conversion functions. +my $weasel_words = "(though differences may be beyond the displayed digits)"; SKIP: { - skip("strtod() not present", 2) unless $Config{d_strtod}; + skip("strtod() not present", 3) unless $Config{d_strtod}; if (locales_enabled('LC_NUMERIC')) { $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC); @@ -169,11 +170,25 @@ SKIP: { cmp_ok(abs("3.14159" - $n), '<', 1e-6, 'strtod works'); is($x, 6, 'strtod works'); + # If $Config{nvtype} is 'double' we check that strtod assigns the same value as + # perl for the input 8.87359152e-6. + # We check that value as it is known to have produced discrepancies in the past. + # If this check fails then perl's buggy atof has probably assigned the value, + # instead of the preferred Perl_strtod function. + + $n = &POSIX::strtod('8.87359152e-6'); + if($Config{nvtype} eq 'double' || ($Config{nvtype} eq 'long double' && $Config{longdblkind} == 0)) { + cmp_ok($n, '==', 8.87359152e-6, "strtod and perl agree $weasel_words"); + } + else { + cmp_ok($n, '!=', 8.87359152e-6, "strtod and perl should differ $weasel_words"); + } + &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if locales_enabled('LC_NUMERIC'); } SKIP: { - skip("strtold() not present", 2) unless $Config{d_strtold}; + skip("strtold() not present", 3) unless $Config{d_strtold}; if (locales_enabled('LC_NUMERIC')) { $lc = &POSIX::setlocale(&POSIX::LC_NUMERIC); @@ -181,14 +196,49 @@ SKIP: { } # we're just checking that strtold works, not how accurate it is - ($n, $x) = &POSIX::strtod('2.718_ISH'); + ($n, $x) = &POSIX::strtold('2.718_ISH'); cmp_ok(abs("2.718" - $n), '<', 1e-6, 'strtold works'); is($x, 4, 'strtold works'); + # If $Config{nvtype} is 'long double' we check that strtold assigns the same value as + # perl for the input 9.81256119e4. + # We check that value as it is known to have produced discrepancies in the past. + # If this check fails then perl's buggy atof has probably assigned the value, + # instead of the preferred Perl_strtod function. + + if($Config{nvtype} eq 'long double') { + $n = &POSIX::strtold('9.81256119e4820'); + cmp_ok($n, '==', 9.81256119e4820, "strtold and perl agree $weasel_words"); + } + elsif($Config{nvtype} eq '__float128') { + $n = &POSIX::strtold('9.81256119e4820'); + if($Config{longdblkind} == 1 || $Config{longdblkind} == 2) { + cmp_ok($n, '==', 9.81256119e4820, "strtold and perl agree $weasel_words"); + } + else { + cmp_ok($n, '!=', 9.81256119e4820, "strtold and perl should differ $weasel_words"); + } + } + else { # nvtype is double ... don't try and make this into a meaningful test + cmp_ok(1, '==', 1, 'skipping comparison between strtold amd perl'); + } + &POSIX::setlocale(&POSIX::LC_NUMERIC, $lc) if locales_enabled('LC_NUMERIC'); } SKIP: { + # We don't yet have a POSIX::strtoflt128 - but let's at least check that + # Perl_strtod, not perl's atof, is assigning the values on quadmath builds. + # Do this by checking that 3329232e296 (which is known to be assigned + # incorrectly by perl's atof) is assigned to its correct value. + + skip("not a -Dusequadmath build", 1) unless $Config{nvtype} eq '__float128'; + cmp_ok(scalar(reverse(unpack("h*", pack("F<", 3329232e296)))), + 'eq','43ebf120d02ce967d48e180409b3f958', + '3329232e296 is assigned correctly'); +} + +SKIP: { skip("strtol() not present", 2) unless $Config{d_strtol}; ($n, $x) = &POSIX::strtol('21_PENGUINS'); @@ -307,7 +357,7 @@ SKIP: { skip("locales not available", 26) unless locales_enabled(qw(NUMERIC MONETARY)); skip("localeconv() not available", 26) unless $Config{d_locconv}; my $conv = localeconv; - is(ref $conv, 'HASH', 'localconv returns a hash reference'); + is(ref $conv, 'HASH', 'localeconv returns a hash reference'); foreach (qw(decimal_point thousands_sep grouping int_curr_symbol currency_symbol mon_decimal_point mon_thousands_sep diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm index 3d740b181a9..35ad712d0a1 100644 --- a/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm +++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/encoding.pm @@ -1,7 +1,7 @@ package PerlIO::encoding; use strict; -our $VERSION = '0.26'; +our $VERSION = '0.27'; our $DEBUG = 0; $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; @@ -14,7 +14,7 @@ require XSLoader; XSLoader::load(); our $fallback = - Encode::PERLQQ()|Encode::WARN_ON_ERR()|Encode::STOP_AT_PARTIAL(); + Encode::PERLQQ()|Encode::WARN_ON_ERR()|Encode::ONLY_PRAGMA_WARNINGS()|Encode::STOP_AT_PARTIAL(); 1; __END__ diff --git a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t index 3abdfd3f37c..686b164236a 100755 --- a/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t +++ b/gnu/usr.bin/perl/ext/PerlIO-encoding/t/fallback.t @@ -23,6 +23,7 @@ use Test::More tests => 10; my $file = "fallback$$.txt"; { + use warnings; my $message = ''; local $SIG{__WARN__} = sub { $message = $_[0] }; $PerlIO::encoding::fallback = Encode::PERLQQ; diff --git a/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.pm b/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.pm index 5df90857606..30e380a6bb8 100644 --- a/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.pm +++ b/gnu/usr.bin/perl/ext/SDBM_File/SDBM_File.pm @@ -7,7 +7,7 @@ require Tie::Hash; require XSLoader; our @ISA = qw(Tie::Hash); -our $VERSION = "1.14"; +our $VERSION = "1.15"; our @EXPORT_OK = qw(PAGFEXT DIRFEXT PAIRMAX); use Exporter "import"; @@ -119,6 +119,14 @@ This warning is emitted when you try to store a key or a value that is too long. It means that the change was not recorded in the database. See BUGS AND WARNINGS below. +=head1 SECURITY WARNING + +B<Do not accept SDBM files from untrusted sources!> + +The sdbm file format was designed for speed and convenience, not for +portability or security. A maliciously crafted file might cause perl to +crash or even expose a security vulnerability. + =head1 BUGS AND WARNINGS There are a number of limits on the size of the data that you can diff --git a/gnu/usr.bin/perl/ext/SDBM_File/pair.c b/gnu/usr.bin/perl/ext/SDBM_File/pair.c index 2e4d8074e5a..c12ad334e66 100644 --- a/gnu/usr.bin/perl/ext/SDBM_File/pair.c +++ b/gnu/usr.bin/perl/ext/SDBM_File/pair.c @@ -269,6 +269,20 @@ splpage(char *pag, char *New, long int sbit) * reasonable, and all offsets in the index should be in order. * this could be made more rigorous. */ +/* + Layout of a page is: + Top of block: + number of keys/values (short) + Array of (number of keys/values) offsets, alternating between key offsets + and value offsets (shorts) + End of block: + - value/key data, last key ends at end of block (bytes) + + So: + N key0off val0off key1off val1off ... val1 key1 val0 key0 + + Be careful to note N is the number of offsets, *not* the number of keys. + */ int chkpage(char *pag) { @@ -283,11 +297,17 @@ chkpage(char *pag) off = PBLKSIZ; for (ino++; n > 0; ino += 2) { if (ino[0] > off || ino[1] > off || - ino[1] > ino[0]) + ino[1] > ino[0] || ino[1] <= 0) return 0; off = ino[1]; n -= 2; } + /* there must be an even number of offsets */ + if (n != 0) + return 0; + /* check the key/value offsets don't overlap the key/value data */ + if ((char *)ino > pag + off) + return 0; } return 1; } diff --git a/gnu/usr.bin/perl/ext/SDBM_File/pair.h b/gnu/usr.bin/perl/ext/SDBM_File/pair.h index 7191556a70c..1cb24fe3c3b 100644 --- a/gnu/usr.bin/perl/ext/SDBM_File/pair.h +++ b/gnu/usr.bin/perl/ext/SDBM_File/pair.h @@ -1,4 +1,7 @@ /* Mini EMBED (pair.c) */ +#ifndef PERL_SDBM_FILE_PAIR_H_ +#define PERL_SDBM_FILE_PAIR_H_ + #define chkpage sdbm__chkpage #define delpair sdbm__delpair #define duppair sdbm__duppair @@ -20,3 +23,5 @@ extern void splpage(char *, char *, long); #ifdef SEEDUPS extern int duppair(char *, datum); #endif + +#endif /* PERL_SDBM_FILE_PAIR_H_ */ diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm.c index 2099857fb84..d7839aa8c20 100644 --- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm.c +++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm.c @@ -7,7 +7,6 @@ * core routines */ -#include "INTERN.h" #include "config.h" #ifdef WIN32 #include "io.h" @@ -398,6 +397,12 @@ sdbm_firstkey(DBM *db) if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0 || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) return ioerr(db), nullitem; + if (!chkpage(db->pagbuf)) { + errno = EINVAL; + ioerr(db); + db->pagbno = -1; + return nullitem; + } db->pagbno = 0; db->blkptr = 0; db->keyptr = 0; @@ -446,8 +451,12 @@ getpage(DBM *db, long int hash) if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0 || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) return 0; - if (!chkpage(db->pagbuf)) - return 0; + if (!chkpage(db->pagbuf)) { + errno = EINVAL; + db->pagbno = -1; + ioerr(db); + return 0; + } db->pagbno = pagb; debug(("pag read: %d\n", pagb)); @@ -543,8 +552,12 @@ getnext(DBM *db) db->pagbno = db->blkptr; if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0) break; - if (!chkpage(db->pagbuf)) - break; + if (!chkpage(db->pagbuf)) { + errno = EINVAL; + db->pagbno = -1; + ioerr(db); + break; + } } return ioerr(db), nullitem; diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm.h b/gnu/usr.bin/perl/ext/SDBM_File/sdbm.h index e3535697089..428303d3072 100644 --- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm.h +++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm.h @@ -4,6 +4,9 @@ * author: oz@nexus.yorku.ca * status: public domain. */ +#ifndef PERL_SDBM_FILE_SDBM_H_ +#define PERL_SDBM_FILE_SDBM_H_ + #define DBLKSIZ 4096 #define PBLKSIZ 1024 #define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ @@ -199,3 +202,4 @@ Free_t Perl_mfree(Malloc_t where); #endif /* Include guard */ +#endif /* PERL_SDBM_FILE_SDBM_H_ */ diff --git a/gnu/usr.bin/perl/ext/Win32CORE/Win32CORE.c b/gnu/usr.bin/perl/ext/Win32CORE/Win32CORE.c index 5024642b071..6e5e1cec013 100644 --- a/gnu/usr.bin/perl/ext/Win32CORE/Win32CORE.c +++ b/gnu/usr.bin/perl/ext/Win32CORE/Win32CORE.c @@ -40,6 +40,9 @@ XS(w32_CORE_all){ call_pv(function, GIMME_V); } +#ifdef __cplusplus +extern "C" +#endif XS_EXTERNAL(boot_Win32CORE) { /* This function only exists because writemain.SH, lib/ExtUtils/Embed.pm diff --git a/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm b/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm index 07ff377dcfc..ba76d8f4da8 100644 --- a/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm +++ b/gnu/usr.bin/perl/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.98'; +our $VERSION = '1.00'; require XSLoader; diff --git a/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs b/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs index a30659f14f9..e77ff44f330 100644 --- a/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs +++ b/gnu/usr.bin/perl/ext/XS-APItest/APItest.xs @@ -4197,7 +4197,6 @@ CODE: /* The slab allocator does not like CvROOT being set. */ CvROOT(PL_compcv) = (OP *)1; o = newFOROP(0, 0, newOP(OP_PUSHMARK, 0), 0, 0); -#ifdef PERL_OP_PARENT if (cLOOPx(cUNOPo->op_first)->op_last->op_sibparent != cUNOPo->op_first) { @@ -4205,7 +4204,6 @@ CODE: RETVAL = FALSE; } else -#endif /* If we do not crash before returning, the test passes. */ RETVAL = TRUE; op_free(o); diff --git a/gnu/usr.bin/perl/ext/XS-APItest/numeric.xs b/gnu/usr.bin/perl/ext/XS-APItest/numeric.xs index fac81ba3e0d..847eb75d7cd 100644 --- a/gnu/usr.bin/perl/ext/XS-APItest/numeric.xs +++ b/gnu/usr.bin/perl/ext/XS-APItest/numeric.xs @@ -40,7 +40,7 @@ grok_atoUV(number, endsv) const char *pv = SvPV(number, len); UV value = 0xdeadbeef; bool result; - const char* endptr = NULL; + const char* endptr = pv + len; PPCODE: EXTEND(SP,2); if (endsv == &PL_sv_undef) { diff --git a/gnu/usr.bin/perl/ext/XS-APItest/t/call_checker.t b/gnu/usr.bin/perl/ext/XS-APItest/t/call_checker.t index 9367096b160..d39a059c227 100644 --- a/gnu/usr.bin/perl/ext/XS-APItest/t/call_checker.t +++ b/gnu/usr.bin/perl/ext/XS-APItest/t/call_checker.t @@ -5,9 +5,11 @@ use Test::More tests => 78; use XS::APItest; { - local $TODO = $^O eq "cygwin" ? "[perl #78502] function pointers don't match on cygwin" : ""; - ok( eval { XS::APItest::test_cv_getset_call_checker(); 1 }) - or diag $@; + local $TODO = "[perl #78502] function pointers don't match on cygwin" + if $^O eq "cygwin"; + ok( eval { XS::APItest::test_cv_getset_call_checker(); 1 }, + "test_cv_getset_call_checker() works as expected") + or diag $@; } my @z = (); diff --git a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm index 9871415319b..320e9b89419 100644 --- a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm +++ b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.pm @@ -34,7 +34,7 @@ to the test script. use parent qw/ Exporter /; require XSLoader; -our $VERSION = '0.16'; +our $VERSION = '0.17'; our @EXPORT = (qw/ T_SV diff --git a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs index 16731b1a01e..1c54d1ad1b4 100644 --- a/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs +++ b/gnu/usr.bin/perl/ext/XS-Typemap/Typemap.xs @@ -203,9 +203,9 @@ XS_unpack_anotherstructPtrPtr(SV *in) void XS_release_anotherstructPtrPtr(anotherstruct **in) { - unsigned int i = 0; - while (in[i] != NULL) - Safefree(in[i++]); + unsigned int i; + for (i = 0; in[i] != NULL; i++) + Safefree(in[i]); Safefree(in); } diff --git a/gnu/usr.bin/perl/ext/arybase/arybase.pm b/gnu/usr.bin/perl/ext/arybase/arybase.pm deleted file mode 100644 index 5e34e29e8d8..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/arybase.pm +++ /dev/null @@ -1,98 +0,0 @@ -package arybase; - -our $VERSION = "0.15"; - -require XSLoader; -XSLoader::load(); # This returns true, which makes require happy. - -__END__ - -=head1 NAME - -arybase - Set indexing base via $[ - -=head1 SYNOPSIS - - $[ = 1; - - @a = qw(Sun Mon Tue Wed Thu Fri Sat); - print $a[3], "\n"; # prints Tue - -=head1 DESCRIPTION - -This module implements Perl's C<$[> variable. You should not use it -directly. - -Assigning to C<$[> has the I<compile-time> effect of making the assigned -value, converted to an integer, the index of the first element in an array -and the first character in a substring, within the enclosing lexical scope. - -It can be written with or without C<local>: - - $[ = 1; - local $[ = 1; - -It only works if the assignment can be detected at compile time and the -value assigned is constant. - -It affects the following operations: - - $array[$element] - @array[@slice] - $#array - (list())[$slice] - splice @array, $index, ... - each @array - keys @array - - index $string, $substring # return value is affected - pos $string - substr $string, $offset, ... - -As with the default base of 0, negative bases count from the end of the -array or string, starting with -1. If C<$[> is a positive integer, indices -from C<$[-1> to 0 also count from the end. If C<$[> is negative (why would -you do that, though?), indices from C<$[> to 0 count from the beginning of -the string, but indices below C<$[> count from the end of the string as -though the base were 0. - -Prior to Perl 5.16, indices from 0 to C<$[-1> inclusive, for positive -values of C<$[>, behaved differently for different operations; negative -indices equal to or greater than a negative C<$[> likewise behaved -inconsistently. - -=head1 HISTORY - -Before Perl 5, C<$[> was a global variable that affected all array indices -and string offsets. - -Starting with Perl 5, it became a file-scoped compile-time directive, which -could be made lexically-scoped with C<local>. "File-scoped" means that the -C<$[> assignment could leak out of the block in which occurred: - - { - $[ = 1; - # ... array base is 1 here ... - } - # ... still 1, but not in other files ... - -In Perl 5.10, it became strictly lexical. The file-scoped behaviour was -removed (perhaps inadvertently, but what's done is done). - -In Perl 5.16, the implementation was moved into this module, and out of the -Perl core. The erratic behaviour that occurred with indices between -1 and -C<$[> was made consistent between operations, and, for negative bases, -indices from C<$[> to -1 inclusive were made consistent between operations. - -=head1 BUGS - -Error messages that mention array indices use the 0-based index. - -C<keys $arrayref> and C<each $arrayref> do not respect the current value of -C<$[>. - -=head1 SEE ALSO - -L<perlvar/"$[">, L<Array::Base> and L<String::Base>. - -=cut diff --git a/gnu/usr.bin/perl/ext/arybase/arybase.xs b/gnu/usr.bin/perl/ext/arybase/arybase.xs deleted file mode 100644 index 6c12d0515fa..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/arybase.xs +++ /dev/null @@ -1,496 +0,0 @@ -#define PERL_NO_GET_CONTEXT /* we want efficiency */ -#define PERL_EXT -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "feature.h" - -/* ... op => info map ................................................. */ - -typedef struct { - OP *(*old_pp)(pTHX); - IV base; -} ab_op_info; - -#define PTABLE_NAME ptable_map -#define PTABLE_VAL_FREE(V) PerlMemShared_free(V) -#include "ptable.h" -#define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V)) - -STATIC ptable *ab_op_map = NULL; - -#ifdef USE_ITHREADS -STATIC perl_mutex ab_op_map_mutex; -#endif - -STATIC const ab_op_info *ab_map_fetch(const OP *o, ab_op_info *oi) { - const ab_op_info *val; - - MUTEX_LOCK(&ab_op_map_mutex); - - val = (ab_op_info *)ptable_fetch(ab_op_map, o); - if (val) { - *oi = *val; - val = oi; - } - - MUTEX_UNLOCK(&ab_op_map_mutex); - - return val; -} - -STATIC const ab_op_info *ab_map_store_locked( - pPTBLMS_ const OP *o, OP *(*old_pp)(pTHX), IV base -) { -#define ab_map_store_locked(O, PP, B) \ - ab_map_store_locked(aPTBLMS_ (O), (PP), (B)) - ab_op_info *oi; - - if (!(oi = (ab_op_info *)ptable_fetch(ab_op_map, o))) { - oi = (ab_op_info *)PerlMemShared_malloc(sizeof *oi); - ptable_map_store(ab_op_map, o, oi); - } - - oi->old_pp = old_pp; - oi->base = base; - return oi; -} - -STATIC void ab_map_store( - pPTBLMS_ const OP *o, OP *(*old_pp)(pTHX), IV base) -{ -#define ab_map_store(O, PP, B) ab_map_store(aPTBLMS_ (O),(PP),(B)) - - MUTEX_LOCK(&ab_op_map_mutex); - - ab_map_store_locked(o, old_pp, base); - - MUTEX_UNLOCK(&ab_op_map_mutex); -} - -STATIC void ab_map_delete(pTHX_ const OP *o) { -#define ab_map_delete(O) ab_map_delete(aTHX_ (O)) - MUTEX_LOCK(&ab_op_map_mutex); - - ptable_map_store(ab_op_map, o, NULL); - - MUTEX_UNLOCK(&ab_op_map_mutex); -} - -/* ... $[ Implementation .............................................. */ - -#define hintkey "$[" -#define hintkey_len (sizeof(hintkey)-1) - -STATIC SV * ab_hint(pTHX_ const bool create) { -#define ab_hint(c) ab_hint(aTHX_ c) - dVAR; - SV **val - = hv_fetch(GvHV(PL_hintgv), hintkey, hintkey_len, create); - if (!val) - return 0; - return *val; -} - -/* current base at compile time */ -STATIC IV current_base(pTHX) { -#define current_base() current_base(aTHX) - SV *hsv = ab_hint(0); - assert(FEATURE_ARYBASE_IS_ENABLED); - if (!hsv || !SvOK(hsv)) return 0; - return SvIV(hsv); -} - -STATIC void set_arybase_to(pTHX_ IV base) { -#define set_arybase_to(base) set_arybase_to(aTHX_ (base)) - dVAR; - SV *hsv = ab_hint(1); - sv_setiv_mg(hsv, base); -} - -#define old_ck(opname) STATIC OP *(*ab_old_ck_##opname)(pTHX_ OP *) = 0 -old_ck(sassign); -old_ck(aassign); -old_ck(aelem); -old_ck(aslice); -old_ck(lslice); -old_ck(av2arylen); -old_ck(splice); -old_ck(keys); -old_ck(each); -old_ck(substr); -old_ck(rindex); -old_ck(index); -old_ck(pos); - -STATIC bool ab_op_is_dollar_bracket(pTHX_ OP *o) { -#define ab_op_is_dollar_bracket(o) ab_op_is_dollar_bracket(aTHX_ (o)) - OP *c; - return o->op_type == OP_RV2SV && (o->op_flags & OPf_KIDS) - && (c = cUNOPx(o)->op_first) - && c->op_type == OP_GV - && GvSTASH(cGVOPx_gv(c)) == PL_defstash - && strEQ(GvNAME(cGVOPx_gv(c)), "["); -} - -STATIC void ab_neuter_dollar_bracket(pTHX_ OP *o) { -#define ab_neuter_dollar_bracket(o) ab_neuter_dollar_bracket(aTHX_ (o)) - OP *oldc, *newc; - /* - * Must replace the core's $[ with something that can accept assignment - * of non-zero value and can be local()ised. Simplest thing is a - * different global variable. - */ - oldc = cUNOPx(o)->op_first; - newc = newGVOP(OP_GV, 0, - gv_fetchpvs("arybase::leftbrack", GV_ADDMULTI, SVt_PVGV)); - /* replace oldc with newc */ - op_sibling_splice(o, NULL, 1, newc); - op_free(oldc); -} - -STATIC void ab_process_assignment(pTHX_ OP *left, OP *right) { -#define ab_process_assignment(l, r) \ - ab_process_assignment(aTHX_ (l), (r)) - if (ab_op_is_dollar_bracket(left) && right->op_type == OP_CONST) { - IV base = SvIV(cSVOPx_sv(right)); - set_arybase_to(base); - ab_neuter_dollar_bracket(left); - if (base) { - Perl_ck_warner_d(aTHX_ - packWARN(WARN_DEPRECATED), "Use of assignment to $[ is deprecated" - ", and will be fatal in Perl 5.30" - ); - } - } -} - -STATIC OP *ab_ck_sassign(pTHX_ OP *o) { - o = (*ab_old_ck_sassign)(aTHX_ o); - if (o->op_type == OP_SASSIGN && FEATURE_ARYBASE_IS_ENABLED) { - OP *right = cBINOPx(o)->op_first; - OP *left = OpSIBLING(right); - if (left) ab_process_assignment(left, right); - } - return o; -} - -STATIC OP *ab_ck_aassign(pTHX_ OP *o) { - o = (*ab_old_ck_aassign)(aTHX_ o); - if (o->op_type == OP_AASSIGN && FEATURE_ARYBASE_IS_ENABLED) { - OP *right = cBINOPx(o)->op_first; - OP *left = OpSIBLING(right); - left = OpSIBLING(cBINOPx(left)->op_first); - right = OpSIBLING(cBINOPx(right)->op_first); - ab_process_assignment(left, right); - } - return o; -} - -STATIC void -tie(pTHX_ SV * const sv, SV * const obj, HV *const stash) -{ - SV *rv = newSV_type(SVt_RV); - - SvRV_set(rv, obj ? SvREFCNT_inc_simple_NN(obj) : newSV(0)); - SvROK_on(rv); - sv_bless(rv, stash); - - sv_unmagic((SV *)sv, PERL_MAGIC_tiedscalar); - sv_magic((SV *)sv, rv, PERL_MAGIC_tiedscalar, NULL, 0); - SvREFCNT_dec(rv); /* As sv_magic increased it by one. */ -} - -/* This function converts from base-based to 0-based an index to be passed - as an argument. */ -static IV -adjust_index(IV index, IV base) -{ - if (index >= base || index > -1) return index-base; - return index; -} -/* This function converts from 0-based to base-based an index to - be returned. */ -static IV -adjust_index_r(IV index, IV base) -{ - return index + base; -} - -#define replace_sv(sv,base) \ - ((sv) = sv_2mortal(newSViv(adjust_index(SvIV(sv),base)))) -#define replace_sv_r(sv,base) \ - ((sv) = sv_2mortal(newSViv(adjust_index_r(SvIV(sv),base)))) - -static OP *ab_pp_basearg(pTHX) { - dVAR; dSP; - SV **firstp = NULL; - SV **svp; - UV count = 1; - ab_op_info oi; - Zero(&oi, 1, ab_op_info); - ab_map_fetch(PL_op, &oi); - - switch (PL_op->op_type) { - case OP_AELEM: - firstp = SP; - break; - case OP_ASLICE: - firstp = PL_stack_base + TOPMARK + 1; - count = SP-firstp; - break; - case OP_LSLICE: - firstp = PL_stack_base + *(PL_markstack_ptr-1)+1; - count = TOPMARK - *(PL_markstack_ptr-1); - if (GIMME_V != G_ARRAY) { - firstp += count-1; - count = 1; - } - break; - case OP_SPLICE: - if (SP - PL_stack_base - TOPMARK >= 2) - firstp = PL_stack_base + TOPMARK + 2; - else count = 0; - break; - case OP_SUBSTR: - firstp = SP-(PL_op->op_private & 7)+2; - break; - default: - DIE(aTHX_ - "panic: invalid op type for arybase.xs:ab_pp_basearg: %d", - PL_op->op_type); - } - svp = firstp; - while (count--) replace_sv(*svp,oi.base), svp++; - return (*oi.old_pp)(aTHX); -} - -static OP *ab_pp_av2arylen(pTHX) { - dSP; dVAR; - SV *sv; - ab_op_info oi; - OP *ret; - Zero(&oi, 1, ab_op_info); - ab_map_fetch(PL_op, &oi); - ret = (*oi.old_pp)(aTHX); - if (PL_op->op_flags & OPf_MOD || LVRET) { - sv = newSV(0); - tie(aTHX_ sv, TOPs, gv_stashpv("arybase::mg",1)); - SETs(sv); - } - else { - SvGETMAGIC(TOPs); - if (SvOK(TOPs)) replace_sv_r(TOPs, oi.base); - } - return ret; -} - -static OP *ab_pp_keys(pTHX) { - dVAR; dSP; - ab_op_info oi; - OP *retval; - const I32 offset = SP - PL_stack_base; - SV **svp; - Zero(&oi, 1, ab_op_info); - ab_map_fetch(PL_op, &oi); - retval = (*oi.old_pp)(aTHX); - if (GIMME_V == G_SCALAR) return retval; - SPAGAIN; - svp = PL_stack_base + offset; - while (svp <= SP) replace_sv_r(*svp,oi.base), ++svp; - return retval; -} - -static OP *ab_pp_each(pTHX) { - dVAR; dSP; - ab_op_info oi; - OP *retval; - const I32 offset = SP - PL_stack_base; - Zero(&oi, 1, ab_op_info); - ab_map_fetch(PL_op, &oi); - retval = (*oi.old_pp)(aTHX); - SPAGAIN; - if (GIMME_V == G_SCALAR) { - if (SvOK(TOPs)) replace_sv_r(TOPs,oi.base); - } - else if (offset < SP - PL_stack_base) replace_sv_r(TOPm1s,oi.base); - return retval; -} - -static OP *ab_pp_index(pTHX) { - dVAR; dSP; - ab_op_info oi; - OP *retval; - Zero(&oi, 1, ab_op_info); - ab_map_fetch(PL_op, &oi); - if (MAXARG == 3 && TOPs) replace_sv(TOPs,oi.base); - retval = (*oi.old_pp)(aTHX); - SPAGAIN; - replace_sv_r(TOPs,oi.base); - return retval; -} - -static OP *ab_ck_base(pTHX_ OP *o) -{ - OP * (*old_ck)(pTHX_ OP *o) = 0; - OP * (*new_pp)(pTHX) = ab_pp_basearg; - switch (o->op_type) { - case OP_AELEM : old_ck = ab_old_ck_aelem ; break; - case OP_ASLICE : old_ck = ab_old_ck_aslice ; break; - case OP_LSLICE : old_ck = ab_old_ck_lslice ; break; - case OP_AV2ARYLEN: old_ck = ab_old_ck_av2arylen; break; - case OP_SPLICE : old_ck = ab_old_ck_splice ; break; - case OP_KEYS : old_ck = ab_old_ck_keys ; break; - case OP_EACH : old_ck = ab_old_ck_each ; break; - case OP_SUBSTR : old_ck = ab_old_ck_substr ; break; - case OP_RINDEX : old_ck = ab_old_ck_rindex ; break; - case OP_INDEX : old_ck = ab_old_ck_index ; break; - case OP_POS : old_ck = ab_old_ck_pos ; break; - default: - DIE(aTHX_ - "panic: invalid op type for arybase.xs:ab_ck_base: %d", - PL_op->op_type); - } - o = (*old_ck)(aTHX_ o); - if (!FEATURE_ARYBASE_IS_ENABLED) return o; - /* We need two switch blocks, as the type may have changed. */ - switch (o->op_type) { - case OP_AELEM : - case OP_ASLICE : - case OP_LSLICE : - case OP_SPLICE : - case OP_SUBSTR : break; - case OP_POS : - case OP_AV2ARYLEN: new_pp = ab_pp_av2arylen ; break; - case OP_AKEYS : new_pp = ab_pp_keys ; break; - case OP_AEACH : new_pp = ab_pp_each ; break; - case OP_RINDEX : - case OP_INDEX : new_pp = ab_pp_index ; break; - default: return o; - } - { - IV const base = current_base(); - if (base) { - ab_map_store(o, o->op_ppaddr, base); - o->op_ppaddr = new_pp; - /* Break the aelemfast optimisation */ - if (o->op_type == OP_AELEM) { - OP *const first = cBINOPo->op_first; - OP *second = OpSIBLING(first); - OP *newop; - if (second->op_type == OP_CONST) { - /* cut out second arg and replace it with a new unop which is - * the parent of that arg */ - op_sibling_splice(o, first, 1, NULL); - newop = newUNOP(OP_NULL,0,second); - op_sibling_splice(o, first, 0, newop); - } - } - } - else ab_map_delete(o); - } - return o; -} - - -STATIC U32 ab_initialized = 0; - -/* --- XS ------------------------------------------------------------- */ - -MODULE = arybase PACKAGE = arybase -PROTOTYPES: DISABLE - -BOOT: -{ - if (!ab_initialized++) { - ab_op_map = ptable_new(); - MUTEX_INIT(&ab_op_map_mutex); -#define check(uc,lc,ck) \ - wrap_op_checker(OP_##uc, ab_ck_##ck, &ab_old_ck_##lc) - check(SASSIGN, sassign, sassign); - check(AASSIGN, aassign, aassign); - check(AELEM, aelem, base); - check(ASLICE, aslice, base); - check(LSLICE, lslice, base); - check(AV2ARYLEN,av2arylen,base); - check(SPLICE, splice, base); - check(KEYS, keys, base); - check(EACH, each, base); - check(SUBSTR, substr, base); - check(RINDEX, rindex, base); - check(INDEX, index, base); - check(POS, pos, base); - } -} - -void -_tie_it(SV *sv) - INIT: - GV * const gv = (GV *)sv; - CODE: - if (GvSV(gv)) - /* This is *our* scalar now! */ - sv_unmagic(GvSV(gv), PERL_MAGIC_sv); - tie(aTHX_ GvSVn(gv), NULL, GvSTASH(CvGV(cv))); - -void -FETCH(...) - PREINIT: - SV *ret = FEATURE_ARYBASE_IS_ENABLED - ? cop_hints_fetch_pvs(PL_curcop, "$[", 0) - : 0; - PPCODE: - if (!ret || !SvOK(ret)) mXPUSHi(0); - else XPUSHs(ret); - -void -STORE(SV *sv, IV newbase) - CODE: - PERL_UNUSED_VAR(sv); - if (FEATURE_ARYBASE_IS_ENABLED) { - SV *base = cop_hints_fetch_pvs(PL_curcop, "$[", 0); - if (SvOK(base) ? SvIV(base) == newbase : !newbase) XSRETURN_EMPTY; - Perl_croak(aTHX_ "That use of $[ is unsupported"); - } - else if (newbase) - Perl_croak(aTHX_ "Assigning non-zero to $[ is no longer possible"); - - -MODULE = arybase PACKAGE = arybase::mg -PROTOTYPES: DISABLE - -void -FETCH(SV *sv) - PPCODE: - if (!SvROK(sv) || SvTYPE(SvRV(sv)) >= SVt_PVAV) - Perl_croak(aTHX_ "Not a SCALAR reference"); - { - SV *base = FEATURE_ARYBASE_IS_ENABLED - ? cop_hints_fetch_pvs(PL_curcop, "$[", 0) - : 0; - SvGETMAGIC(SvRV(sv)); - if (!SvOK(SvRV(sv))) XSRETURN_UNDEF; - mXPUSHi(adjust_index_r( - SvIV_nomg(SvRV(sv)), base&&SvOK(base)?SvIV(base):0 - )); - } - -void -STORE(SV *sv, SV *newbase) - CODE: - if (!SvROK(sv) || SvTYPE(SvRV(sv)) >= SVt_PVAV) - Perl_croak(aTHX_ "Not a SCALAR reference"); - { - SV *base = FEATURE_ARYBASE_IS_ENABLED - ? cop_hints_fetch_pvs(PL_curcop, "$[", 0) - : 0; - SvGETMAGIC(newbase); - if (!SvOK(newbase)) SvSetMagicSV(SvRV(sv),&PL_sv_undef); - else - sv_setiv_mg( - SvRV(sv), - adjust_index( - SvIV_nomg(newbase), base&&SvOK(base)?SvIV(base):0 - ) - ); - } diff --git a/gnu/usr.bin/perl/ext/arybase/ptable.h b/gnu/usr.bin/perl/ext/arybase/ptable.h deleted file mode 100644 index f7919befdf6..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/ptable.h +++ /dev/null @@ -1,226 +0,0 @@ -/* This is a pointer table implementation essentially copied from the ptr_table - * implementation in perl's sv.c, except that it has been modified to use memory - * shared across threads. */ - -/* This header is designed to be included several times with different - * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */ - -#undef pPTBLMS -#undef pPTBLMS_ -#undef aPTBLMS -#undef aPTBLMS_ - -/* Context for PerlMemShared_* functions */ - -#ifdef PERL_IMPLICIT_SYS -# define pPTBLMS pTHX -# define pPTBLMS_ pTHX_ -# define aPTBLMS aTHX -# define aPTBLMS_ aTHX_ -#else -# define pPTBLMS -# define pPTBLMS_ -# define aPTBLMS -# define aPTBLMS_ -#endif - -#ifndef pPTBL -# define pPTBL pPTBLMS -#endif -#ifndef pPTBL_ -# define pPTBL_ pPTBLMS_ -#endif -#ifndef aPTBL -# define aPTBL aPTBLMS -#endif -#ifndef aPTBL_ -# define aPTBL_ aPTBLMS_ -#endif - -#ifndef PTABLE_NAME -# define PTABLE_NAME ptable -#endif - -#ifndef PTABLE_VAL_FREE -# define PTABLE_VAL_FREE(V) -#endif - -#ifndef PTABLE_JOIN -# define PTABLE_PASTE(A, B) A ## B -# define PTABLE_JOIN(A, B) PTABLE_PASTE(A, B) -#endif - -#ifndef PTABLE_PREFIX -# define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X) -#endif - -#ifndef ptable_ent -typedef struct ptable_ent { - struct ptable_ent *next; - const void * key; - void * val; -} ptable_ent; -#define ptable_ent ptable_ent -#endif /* !ptable_ent */ - -#ifndef ptable -typedef struct ptable { - ptable_ent **ary; - UV max; - UV items; -} ptable; -#define ptable ptable -#endif /* !ptable */ - -#ifndef ptable_new -STATIC ptable *ptable_new(pPTBLMS) { -#define ptable_new() ptable_new(aPTBLMS) - ptable *t = (ptable *)PerlMemShared_malloc(sizeof *t); - t->max = 63; - t->items = 0; - t->ary = (ptable_ent **)PerlMemShared_calloc(t->max + 1, sizeof *t->ary); - return t; -} -#endif /* !ptable_new */ - -#ifndef PTABLE_HASH -# define PTABLE_HASH(ptr) \ - ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17))) -#endif - -#ifndef ptable_find -STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) { -#define ptable_find ptable_find - ptable_ent *ent; - const UV hash = PTABLE_HASH(key); - - ent = t->ary[hash & t->max]; - for (; ent; ent = ent->next) { - if (ent->key == key) - return ent; - } - - return NULL; -} -#endif /* !ptable_find */ - -#ifndef ptable_fetch -STATIC void *ptable_fetch(const ptable * const t, const void * const key) { -#define ptable_fetch ptable_fetch - const ptable_ent *const ent = ptable_find(t, key); - - return ent ? ent->val : NULL; -} -#endif /* !ptable_fetch */ - -#ifndef ptable_split -STATIC void ptable_split(pPTBLMS_ ptable * const t) { -#define ptable_split(T) ptable_split(aPTBLMS_ (T)) - ptable_ent **ary = t->ary; - const UV oldsize = t->max + 1; - UV newsize = oldsize * 2; - UV i; - - ary = (ptable_ent **)PerlMemShared_realloc(ary, newsize * sizeof(*ary)); - Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary)); - t->max = --newsize; - t->ary = ary; - - for (i = 0; i < oldsize; i++, ary++) { - ptable_ent **currentp, **entp, *ent; - if (!*ary) - continue; - currentp = ary + oldsize; - for (entp = ary, ent = *ary; ent; ent = *entp) { - if ((newsize & PTABLE_HASH(ent->key)) != i) { - *entp = ent->next; - ent->next = *currentp; - *currentp = ent; - continue; - } else - entp = &ent->next; - } - } -} -#endif /* !ptable_split */ - -STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) { - ptable_ent *ent = ptable_find(t, key); - - if (ent) { - void *oldval = ent->val; - PTABLE_VAL_FREE(oldval); - ent->val = val; - } else if (val) { - const UV i = PTABLE_HASH(key) & t->max; - ent = (ptable_ent *)PerlMemShared_malloc(sizeof *ent); - ent->key = key; - ent->val = val; - ent->next = t->ary[i]; - t->ary[i] = ent; - t->items++; - if (ent->next && t->items > t->max) - ptable_split(t); - } -} - -/* this function appears to be unused */ -#if 0 -#ifndef ptable_walk -STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) { -#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD)) - if (t && t->items) { - ptable_ent ** const array = t->ary; - UV i = t->max; - do { - ptable_ent *entry; - for (entry = array[i]; entry; entry = entry->next) - cb(aTHX_ entry, userdata); - } while (i--); - } -} -#endif /* !ptable_walk */ -#endif - -/* this function appears to be unused */ -#if 0 -STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) { - if (t && t->items) { - ptable_ent ** const array = t->ary; - UV i = t->max; - - do { - ptable_ent *entry = array[i]; - while (entry) { - ptable_ent * const oentry = entry; - void *val = oentry->val; - entry = entry->next; - PTABLE_VAL_FREE(val); - PerlMemShared_free(oentry); - } - array[i] = NULL; - } while (i--); - - t->items = 0; - } -} -#endif - -/* this function appears to be unused */ -#if 0 -STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) { - if (!t) - return; - PTABLE_PREFIX(_clear)(aPTBL_ t); - PerlMemShared_free(t->ary); - PerlMemShared_free(t); -} -#endif - -#undef pPTBL -#undef pPTBL_ -#undef aPTBL -#undef aPTBL_ - -#undef PTABLE_NAME -#undef PTABLE_VAL_FREE diff --git a/gnu/usr.bin/perl/ext/arybase/t/aeach.t b/gnu/usr.bin/perl/ext/arybase/t/aeach.t deleted file mode 100644 index 241677acb07..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/aeach.t +++ /dev/null @@ -1,45 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -BEGIN { - if("$]" < 5.011) { - require Test::More; - Test::More::plan(skip_all => "no array each on this Perl"); - } -} - -use Test::More tests => 2; - -our @activity; - -$[ = 3; - -our @t0 = qw(a b c); -@activity = (); -foreach(0..5) { - push @activity, [ each(@t0) ]; -} -is_deeply \@activity, [ - [ 3, "a" ], - [ 4, "b" ], - [ 5, "c" ], - [], - [ 3, "a" ], - [ 4, "b" ], -]; - -our @t1 = qw(a b c); -@activity = (); -foreach(0..5) { - push @activity, [ scalar each(@t1) ]; -} -is_deeply \@activity, [ - [ 3 ], - [ 4 ], - [ 5 ], - [ undef ], - [ 3 ], - [ 4 ], -]; - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/aelem.t b/gnu/usr.bin/perl/ext/arybase/t/aelem.t deleted file mode 100644 index c26a2a80c37..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/aelem.t +++ /dev/null @@ -1,56 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 33; - -our @t = qw(a b c d e f); -our $r = \@t; -our($i3, $i4, $i8, $i9) = (3, 4, 8, 9); -our @i4 = (3, 3, 3, 3); - -$[ = 3; - -is $t[3], "a"; -is $t[4], "b"; -is $t[8], "f"; -is $t[9], undef; -is_deeply [ scalar $t[4] ], [ "b" ]; -is_deeply [ $t[4] ], [ "b" ]; - -is $t[2], 'f'; -is $t[-1], 'f'; -is $t[1], 'e'; -is $t[-2], 'e'; - -{ - $[ = -3; - is $t[-3], 'a'; -} - -is $r->[3], "a"; -is $r->[4], "b"; -is $r->[8], "f"; -is $r->[9], undef; -is_deeply [ scalar $r->[4] ], [ "b" ]; -is_deeply [ $r->[4] ], [ "b" ]; - -is $t[$i3], "a"; -is $t[$i4], "b"; -is $t[$i8], "f"; -is $t[$i9], undef; -is_deeply [ scalar $t[$i4] ], [ "b" ]; -is_deeply [ $t[$i4] ], [ "b" ]; -is_deeply [ scalar $t[@i4] ], [ "b" ]; -is_deeply [ $t[@i4] ], [ "b" ]; - -is $r->[$i3], "a"; -is $r->[$i4], "b"; -is $r->[$i8], "f"; -is $r->[$i9], undef; -is_deeply [ scalar $r->[$i4] ], [ "b" ]; -is_deeply [ $r->[$i4] ], [ "b" ]; -is_deeply [ scalar $r->[@i4] ], [ "b" ]; -is_deeply [ $r->[@i4] ], [ "b" ]; - - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/akeys.t b/gnu/usr.bin/perl/ext/arybase/t/akeys.t deleted file mode 100644 index a76fade9dbc..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/akeys.t +++ /dev/null @@ -1,25 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -BEGIN { - if("$]" < 5.011) { - require Test::More; - Test::More::plan(skip_all => "no array keys on this Perl"); - } -} - -use Test::More tests => 4; - -our @t; - -$[ = 3; - -@t = (); -is_deeply [ scalar keys @t ], [ 0 ]; -is_deeply [ keys @t ], []; - -@t = qw(a b c d e f); -is_deeply [ scalar keys @t ], [ 6 ]; -is_deeply [ keys @t ], [ 3, 4, 5, 6, 7, 8 ]; - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/arybase.t b/gnu/usr.bin/perl/ext/arybase/t/arybase.t deleted file mode 100644 index f3d32874e25..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/arybase.t +++ /dev/null @@ -1,37 +0,0 @@ -#!perl - -# Basic tests for $[ as a variable -# plus miscellaneous bug fix tests - -no warnings 'deprecated'; -use Test::More tests => 7; - -sub outside_base_scope { return "${'['}" } - -$[ = 3; -my $base = \$[; -is "$$base", 3, 'retval of $['; -is outside_base_scope, 0, 'retval of $[ outside its scope'; - -${'['} = 3; -pass('run-time $[ = 3 assignment (in $[ = 3 scope)'); -{ - $[ = 0; - ${'['} = 0; - pass('run-time $[ = 0 assignment (in $[ = 3 scope)'); -} - -eval { ${'['} = 1 }; my $f = __FILE__; my $l = __LINE__; -is $@, "That use of \$[ is unsupported at $f line $l.\n", - "error when setting $[ to integer other than current base at run-time"; - -$[ = 6.7; -is "$[", 6, '$[ is an integer'; - -eval { my $x = 45; $[ = \$x }; $l = __LINE__; -is $@, "That use of \$[ is unsupported at $f line $l.\n", - 'error when setting $[ to ref'; - -sub foo { my $x; $x = wait } # compilation of this routine used to crash - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/aslice.t b/gnu/usr.bin/perl/ext/arybase/t/aslice.t deleted file mode 100644 index 20782e59a53..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/aslice.t +++ /dev/null @@ -1,27 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 10; - -our @t = qw(a b c d e f); -our $r = \@t; -our @i4 = (3, 5, 3, 5); - -$[ = 3; - -is_deeply [ scalar @t[3,4] ], [ qw(b) ]; -is_deeply [ @t[3,4,8,9] ], [ qw(a b f), undef ]; -is_deeply [ scalar @t[@i4] ], [ qw(c) ]; -is_deeply [ @t[@i4] ], [ qw(a c a c) ]; -is_deeply [ scalar @{$r}[3,4] ], [ qw(b) ]; -is_deeply [ @{$r}[3,4,8,9] ], [ qw(a b f), undef ]; -is_deeply [ scalar @{$r}[@i4] ], [ qw(c) ]; -is_deeply [ @{$r}[@i4] ], [ qw(a c a c) ]; - -is_deeply [ @t[2,-1,1,-2] ], [ qw(f f e e) ]; -{ - $[ = -3; - is_deeply [@t[-3,()]], ['a']; -} - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/av2arylen.t b/gnu/usr.bin/perl/ext/arybase/t/av2arylen.t deleted file mode 100644 index 6c1deb2de4f..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/av2arylen.t +++ /dev/null @@ -1,26 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 8; - -our @t = qw(a b c d e f); -our $r = \@t; - -$[ = 3; - -is_deeply [ scalar $#t ], [ 8 ]; -is_deeply [ $#t ], [ 8 ]; -is_deeply [ scalar $#$r ], [ 8 ]; -is_deeply [ $#$r ], [ 8 ]; - -my $arylen=\$#t; -push @t, 'g'; -is 0+$$arylen, 9; -$[ = 4; -is 0+$$arylen, 10; ---$$arylen; -$[ = 3; -is 0+$$arylen, 8; -is 0+$#t, 8; - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/index.t b/gnu/usr.bin/perl/ext/arybase/t/index.t deleted file mode 100644 index 86dde888654..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/index.t +++ /dev/null @@ -1,23 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 12; - -our $t = "abcdefghijkl"; - -$[ = 3; - -is index($t, "cdef"), 5; -is index($t, "cdef", 3), 5; -is index($t, "cdef", 4), 5; -is index($t, "cdef", 5), 5; -is index($t, "cdef", 6), 2; -is index($t, "cdef", 7), 2; -is rindex($t, "cdef"), 5; -is rindex($t, "cdef", 7), 5; -is rindex($t, "cdef", 6), 5; -is rindex($t, "cdef", 5), 5; -is rindex($t, "cdef", 4), 2; -is rindex($t, "cdef", 3), 2; - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/lslice.t b/gnu/usr.bin/perl/ext/arybase/t/lslice.t deleted file mode 100644 index 08aabe9ce5a..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/lslice.t +++ /dev/null @@ -1,23 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 8; - -our @i4 = (3, 5, 3, 5); - -$[ = 3; - -is_deeply [ scalar qw(a b c d e f)[3,4] ], [ qw(b) ]; -is_deeply [ qw(a b c d e f)[3,4,8,9] ], [ qw(a b f), undef ]; -is_deeply [ scalar qw(a b c d e f)[@i4] ], [ qw(c) ]; -is_deeply [ qw(a b c d e f)[@i4] ], [ qw(a c a c) ]; -is_deeply [ 3, 4, qw(a b c d e f)[@i4] ], [ 3, 4, qw(a c a c) ]; - -is_deeply [ qw(a b c d e f)[-1,-2] ], [ qw(f e) ]; -is_deeply [ qw(a b c d e f)[2,1] ], [ qw(f e) ]; -{ - $[ = -3; - is_deeply [qw(a b c d e f)[-3]], ['a']; -} - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/pos.t b/gnu/usr.bin/perl/ext/arybase/t/pos.t deleted file mode 100644 index 970e17eaa02..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/pos.t +++ /dev/null @@ -1,35 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 12; - -our $t = "abcdefghi"; -scalar($t =~ /abcde/g); -our $r = \$t; - -$[ = 3; - -is_deeply [ scalar pos($t) ], [ 8 ]; -is_deeply [ pos($t) ], [ 8 ]; -is_deeply [ scalar pos($$r) ], [ 8 ]; -is_deeply [ pos($$r) ], [ 8 ]; - -scalar($t =~ /x/g); - -is_deeply [ scalar pos($t) ], [ undef ]; -is_deeply [ pos($t) ], [ undef ]; -is_deeply [ scalar pos($$r) ], [ undef ]; -is_deeply [ pos($$r) ], [ undef ]; - -is pos($t), undef; -pos($t) = 5; -is 0+pos($t), 5; -is pos($t), 2; -my $posr =\ pos($t); -$$posr = 4; -{ - $[ = 0; - is 0+$$posr, 1; -} - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/scope.t b/gnu/usr.bin/perl/ext/arybase/t/scope.t deleted file mode 100644 index 5fca19610c3..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/scope.t +++ /dev/null @@ -1,44 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 14; - -our @t = qw(a b c d e f); - -is $t[3], "d"; -$[ = 3; -is $t[3], "a"; -{ - is $t[3], "a"; - $[ = -1; - is $t[3], "e"; - $[ = +0; - is $t[3], "d"; - $[ = +1; - is $t[3], "c"; - $[ = 0; - is $t[3], "d"; -} -is $t[3], "a"; -{ - local $[ = -1; - is $t[3], "e"; -} -is $t[3], "a"; -{ - ($[) = -1; - is $t[3], "e"; -} -is $t[3], "a"; -BEGIN { push @INC, '.' } -use t::scope_0; -is scope0_test(), "d"; - - -is eval(q{ - $[ = 3; - BEGIN { my $x = "foo\x{666}"; $x =~ /foo\p{Alnum}/; } - $t[3]; -}), "a"; - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/scope_0.pm b/gnu/usr.bin/perl/ext/arybase/t/scope_0.pm deleted file mode 100644 index 9f6c7838a60..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/scope_0.pm +++ /dev/null @@ -1,6 +0,0 @@ -use warnings; -use strict; - -sub main::scope0_test { $main::t[3] } - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/splice.t b/gnu/usr.bin/perl/ext/arybase/t/splice.t deleted file mode 100644 index 9fd618a6356..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/splice.t +++ /dev/null @@ -1,65 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 23; - -our @t; -our @i5 = (3, 3, 3, 3, 3); - -$[ = 3; - -@t = qw(a b c d e f); -is_deeply [ scalar splice @t ], [qw(f)]; -is_deeply \@t, []; - -@t = qw(a b c d e f); -is_deeply [ splice @t ], [qw(a b c d e f)]; -is_deeply \@t, []; - -@t = qw(a b c d e f); -is_deeply [ scalar splice @t, 5 ], [qw(f)]; -is_deeply \@t, [qw(a b)]; - -@t = qw(a b c d e f); -is_deeply [ splice @t, 5 ], [qw(c d e f)]; -is_deeply \@t, [qw(a b)]; - -@t = qw(a b c d e f); -is_deeply [ scalar splice @t, @i5 ], [qw(f)]; -is_deeply \@t, [qw(a b)]; - -@t = qw(a b c d e f); -is_deeply [ splice @t, @i5 ], [qw(c d e f)]; -is_deeply \@t, [qw(a b)]; - -@t = qw(a b c d e f); -is_deeply [ scalar splice @t, 5, 2 ], [qw(d)]; -is_deeply \@t, [qw(a b e f)]; - -@t = qw(a b c d e f); -is_deeply [ splice @t, 5, 2 ], [qw(c d)]; -is_deeply \@t, [qw(a b e f)]; - -@t = qw(a b c d e f); -is_deeply [ scalar splice @t, 5, 2, qw(x y z) ], [qw(d)]; -is_deeply \@t, [qw(a b x y z e f)]; - -@t = qw(a b c d e f); -is_deeply [ splice @t, 5, 2, qw(x y z) ], [qw(c d)]; -is_deeply \@t, [qw(a b x y z e f)]; - -@t = qw(a b c d e f); -splice @t, -4, 1; -is_deeply \@t, [qw(a b d e f)]; - -@t = qw(a b c d e f); -splice @t, 1, 1; -is_deeply \@t, [qw(a b c d f)]; - -$[ = -3; - -@t = qw(a b c d e f); -splice @t, -3, 1; -is_deeply \@t, [qw(b c d e f)]; - -1; diff --git a/gnu/usr.bin/perl/ext/arybase/t/substr.t b/gnu/usr.bin/perl/ext/arybase/t/substr.t deleted file mode 100644 index ecfba48bae4..00000000000 --- a/gnu/usr.bin/perl/ext/arybase/t/substr.t +++ /dev/null @@ -1,22 +0,0 @@ -use warnings; no warnings 'deprecated'; -use strict; - -use Test::More tests => 6; - -our $t; - -$[ = 3; - -$t = "abcdef"; -is substr($t, 5), "cdef"; -is $t, "abcdef"; - -$t = "abcdef"; -is substr($t, 5, 2), "cd"; -is $t, "abcdef"; - -$t = "abcdef"; -is substr($t, 5, 2, "xyz"), "cd"; -is $t, "abxyzef"; - -1; diff --git a/gnu/usr.bin/perl/ext/re/re.pm b/gnu/usr.bin/perl/ext/re/re.pm index 0b52e1d7d7e..817b522c280 100644 --- a/gnu/usr.bin/perl/ext/re/re.pm +++ b/gnu/usr.bin/perl/ext/re/re.pm @@ -4,7 +4,7 @@ package re; use strict; use warnings; -our $VERSION = "0.36"; +our $VERSION = "0.37"; our @ISA = qw(Exporter); our @EXPORT_OK = ('regmust', qw(is_regexp regexp_pattern @@ -629,7 +629,9 @@ These are useful shortcuts to save on the typing. =item ALL Enable all options at once except OFFSETS, OFFSETSDBG and BUFFERS. -(To get every single option without exception, use both ALL and EXTRA.) +(To get every single option without exception, use both ALL and EXTRA, or +starting in 5.30 on a C<-DDEBUGGING>-enabled perl interpreter, use +the B<-Drv> command-line switches.) =item All diff --git a/gnu/usr.bin/perl/ext/re/t/regop.t b/gnu/usr.bin/perl/ext/re/t/regop.t index 54a197b3a1d..cf35d71fb09 100644 --- a/gnu/usr.bin/perl/ext/re/t/regop.t +++ b/gnu/usr.bin/perl/ext/re/t/regop.t @@ -241,7 +241,7 @@ floating ""$ at 3..4 (checking floating) #Matching stclass EXACTF <.> against ".exe" --- #Compiling REx "[q]" -#size 3 nodes Got 28 bytes for offset annotations. +#size 3 nodes Got 7 bytes for offset annotations. #first at 1 #Final program: # 1: EXACT <q>(3) @@ -254,7 +254,7 @@ floating ""$ at 3..4 (checking floating) #Guessed: match at offset 0 #%MATCHED% #Freeing REx: "[q]" -Got 28 bytes for offset annotations. +Got 7 bytes for offset annotations. Offsets: [3] 1:1[3] 3:4[0] %MATCHED% |