In perl.git, the branch smoke-me/jkeenan/133771-file-find-t has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/a36898ed101cfe51d17cc661814d32e818605cd7?hp=48e29007b910dd740fd967de95acadd7d522e71a> discards 48e29007b910dd740fd967de95acadd7d522e71a (commit) - Log ----------------------------------------------------------------- commit a36898ed101cfe51d17cc661814d32e818605cd7 Author: James E Keenan <[email protected]> Date: Wed Aug 7 09:39:56 2019 -0400 Run tests in ext/File-Find/t in series For: RT # 133771 ----------------------------------------------------------------------- Summary of changes: MANIFEST | 3 +- Porting/corelist.pl | 1 - dist/Storable/.gitignore | 2 - dist/Storable/ChangeLog | 7 ++ dist/Storable/MANIFEST | 3 +- dist/Storable/Makefile.PL | 37 ++------- dist/Storable/{__Storable__.pm => Storable.pm} | 17 ++-- dist/Storable/Storable.pm.PL | 35 -------- dist/Storable/Storable.xs | 14 +++- ext/PerlIO-via/via.pm | 2 +- ext/PerlIO-via/via.xs | 4 +- handy.h | 106 +++++++++++++------------ intrpvar.h | 95 +++++++++++++++++++++- op.c | 3 +- perl.h | 26 ++++++ pod/perldelta.pod | 19 +++++ pod/perlop.pod | 84 +++++++++++++++----- pod/perlrun.pod | 3 +- pp_ctl.c | 20 +++-- pp_sort.c | 2 + regcomp.c | 4 +- scope.c | 3 + t/lib/croak/pp_ctl | 8 ++ t/op/range.t | 23 +++++- 24 files changed, 355 insertions(+), 166 deletions(-) delete mode 100644 dist/Storable/.gitignore rename dist/Storable/{__Storable__.pm => Storable.pm} (99%) delete mode 100644 dist/Storable/Storable.pm.PL diff --git a/MANIFEST b/MANIFEST index 9b7798e379..e3785eedd6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3630,7 +3630,6 @@ dist/SelfLoader/lib/SelfLoader.pm Load functions only on demand dist/SelfLoader/t/01SelfLoader.t See if SelfLoader works dist/SelfLoader/t/02SelfLoader-buggy.t See if SelfLoader works dist/SelfLoader/t/03taint.t See if SelfLoader works under taint -dist/Storable/__Storable__.pm Template to generate Storable.pm dist/Storable/ChangeLog Storable extension dist/Storable/hints/gnukfreebsd.pl Hint for Storable for named architecture dist/Storable/hints/gnuknetbsd.pl Hint for Storable for named architecture @@ -3640,8 +3639,8 @@ dist/Storable/Makefile.PL Storable extension dist/Storable/MANIFEST Storable MANIFEST file dist/Storable/README Storable extension dist/Storable/stacksize compute stack sizes +dist/Storable/Storable.pm Storable perl module dist/Storable/Storable.xs Storable extension -dist/Storable/Storable.pm.PL perl script to generate Storable.pm from template dist/Storable/t/attach.t Check STORABLE_attach doesn't create objects unnecessarily dist/Storable/t/attach_errors.t Trigger and test STORABLE_attach errors dist/Storable/t/attach_singleton.t Test STORABLE_attach for the Singleton pattern diff --git a/Porting/corelist.pl b/Porting/corelist.pl index ad5a4ad06d..ce74ed42c8 100755 --- a/Porting/corelist.pl +++ b/Porting/corelist.pl @@ -98,7 +98,6 @@ find( sub { /(\.pm|_pm\.PL)$/ or return; /PPPort\.pm$/ and return; - /__Storable__\.pm$/ and return; my $module = $File::Find::name; $module =~ /\b(demo|t|private|corpus)\b/ and return; # demo or test modules my $version = MM->parse_version($_); diff --git a/dist/Storable/.gitignore b/dist/Storable/.gitignore deleted file mode 100644 index de731b9d98..0000000000 --- a/dist/Storable/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -/Storable.pm -/lib diff --git a/dist/Storable/ChangeLog b/dist/Storable/ChangeLog index 4745c74b85..68159a9b65 100644 --- a/dist/Storable/ChangeLog +++ b/dist/Storable/ChangeLog @@ -1,3 +1,10 @@ +2019-08-08 11:48:00 TonyC + version 3.17 + * correct a data type to ensure the check for too large results from + STORABLE_freeze() are detected correctly (detected by Coverity) + * removed remains of stack size detection from the build process. + * moved CAN_FLOCK detection into XS to simplify the build process. + 2019-06-11 10:43:00 TonyC version 3.16 * (perl #134179) fix self-referencing structures that include regexps diff --git a/dist/Storable/MANIFEST b/dist/Storable/MANIFEST index d30b94e133..5e382d9524 100644 --- a/dist/Storable/MANIFEST +++ b/dist/Storable/MANIFEST @@ -1,4 +1,3 @@ -__Storable__.pm ChangeLog hints/gnukfreebsd.pl hints/gnuknetbsd.pl @@ -11,7 +10,7 @@ META.yml Module meta-data (added by MakeMaker) ppport.h README stacksize -Storable.pm.PL +Storable.pm Storable.xs t/attach.t t/attach_errors.t diff --git a/dist/Storable/Makefile.PL b/dist/Storable/Makefile.PL index 4a39125562..cdcc3e0087 100644 --- a/dist/Storable/Makefile.PL +++ b/dist/Storable/Makefile.PL @@ -10,10 +10,6 @@ use strict; use warnings; use ExtUtils::MakeMaker 6.31; use Config; -use File::Copy qw(move copy); -use File::Spec; - -my $pm = { 'Storable.pm' => '$(INST_ARCHLIB)/Storable.pm' }; WriteMakefile( NAME => 'Storable', @@ -22,31 +18,26 @@ WriteMakefile( DISTNAME => "Storable", # We now ship this in t/ # PREREQ_PM => { 'Test::More' => '0.41' }, - PL_FILES => { }, # prevent default behaviour - PM => $pm, PREREQ_PM => { XSLoader => 0 }, INSTALLDIRS => ($] >= 5.007 && $] < 5.012) ? 'perl' : 'site', - VERSION_FROM => '__Storable__.pm', - ABSTRACT_FROM => '__Storable__.pm', + VERSION_FROM => 'Storable.pm', + ABSTRACT_FROM => 'Storable.pm', ($ExtUtils::MakeMaker::VERSION > 6.45 ? (META_MERGE => { resources => { bugtracker => 'http://rt.perl.org/perlbug/' }, provides => { 'Storable' => { - file => '__Storable__.pm', - version => MM->parse_version('__Storable__.pm'), + file => 'Storable.pm', + version => MM->parse_version('Storable.pm'), }, }, }, ) : ()), dist => { SUFFIX => 'gz', COMPRESS => 'gzip -f' }, - clean => { FILES => 'Storable-* Storable.pm lib' }, + clean => { FILES => 'Storable-*' }, ); -# Unlink the .pm file included with the distribution -1 while unlink "Storable.pm"; - my $ivtype = $Config{ivtype}; # I don't know if the VMS folks ever supported long long on 5.6.x @@ -67,16 +58,8 @@ in the Storable documentation for instructions on how to read your data. EOM } -# compute the maximum stacksize, before and after linking package MY; -# FORCE finish of INST_DYNAMIC, avoid loading the old Storable (failed XS_VERSION check) -sub xlinkext { - my $s = shift->SUPER::linkext(@_); - $s =~ s|( :: .*)| $1 FORCE stacksize|; - $s -} - sub depend { " @@ -87,13 +70,3 @@ release : dist git push --tags " } - -sub postamble { -' -all :: Storable.pm - $(NOECHO) $(NOOP) - -Storable.pm :: Storable.pm.PL __Storable__.pm - $(PERLRUN) Storable.pm.PL -' -} diff --git a/dist/Storable/__Storable__.pm b/dist/Storable/Storable.pm similarity index 99% rename from dist/Storable/__Storable__.pm rename to dist/Storable/Storable.pm index 8ed247f96f..cd35e637ca 100644 --- a/dist/Storable/__Storable__.pm +++ b/dist/Storable/Storable.pm @@ -8,7 +8,7 @@ # in the README file that comes with the distribution. # -require XSLoader; +BEGIN { require XSLoader } require Exporter; package Storable; @@ -27,7 +27,9 @@ our @EXPORT_OK = qw( our ($canonical, $forgive_me); -our $VERSION = '3.16'; +BEGIN { + our $VERSION = '3.17'; +} our $recursion_limit; our $recursion_limit_hash; @@ -104,14 +106,12 @@ $Storable::flags = FLAGS_COMPAT; $Storable::downgrade_restricted = 1; $Storable::accept_future_minor = 1; -XSLoader::load('Storable'); +BEGIN { XSLoader::load('Storable') }; # # Determine whether locking is possible, but only when needed. # -sub CAN_FLOCK; # TEMPLATE - replaced by Storable.pm.PL - sub show_file_magic { print <<EOM; # @@ -266,7 +266,7 @@ sub _store { local *FILE; if ($use_locking) { open(FILE, ">>", $file) || logcroak "can't write into $file: $!"; - unless (&CAN_FLOCK) { + unless (CAN_FLOCK) { logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O"; return undef; @@ -410,7 +410,7 @@ sub _retrieve { my $self; my $da = $@; # Could be from exception handler if ($use_locking) { - unless (&CAN_FLOCK) { + unless (CAN_FLOCK) { logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O"; return undef; @@ -986,6 +986,9 @@ modifying C<$Storable::recursion_limit> and C<$Storable::recursion_limit_hash> respectively. Either can be set to C<-1> to prevent any depth checks, though this isn't recommended. +If you want to test what the limits are, the F<stacksize> tool is +included in the C<Storable> distribution. + =item * You can create endless loops if the things you serialize via freeze() diff --git a/dist/Storable/Storable.pm.PL b/dist/Storable/Storable.pm.PL deleted file mode 100644 index df979c09a9..0000000000 --- a/dist/Storable/Storable.pm.PL +++ /dev/null @@ -1,35 +0,0 @@ -use strict; -use warnings; - -use Config; - -my $template; -{ # keep all the code in an external template to keep it easy to update - local $/; - open my $FROM, '<', '__Storable__.pm' or die $!; - $template = <$FROM>; - close $FROM or die $!; -} - -sub CAN_FLOCK { - return - $Config{'d_flock'} || - $Config{'d_fcntl_can_lock'} || - $Config{'d_lockf'} - ? 1 : 0; -} - -my $CAN_FLOCK = CAN_FLOCK(); - -# populate the sub and preserve it if used outside -$template =~ s{^sub CAN_FLOCK;.*$}{sub CAN_FLOCK { ${CAN_FLOCK} } # computed by Storable.pm.PL}m; -# alternatively we could remove the sub -#$template =~ s{^sub CAN_FLOCK;.*$}{}m; -# replace local function calls to hardcoded value -$template =~ s{&CAN_FLOCK}{${CAN_FLOCK}}g; - -{ - open my $OUT, '>', 'Storable.pm' or die $!; - print {$OUT} $template or die $!; - close $OUT or die $!; -} diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 6a45d8adf2..c2335680ab 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -104,6 +104,12 @@ # define strEQc(s,c) memEQ(s, ("" c ""), sizeof(c)) #endif +#if defined(HAS_FLOCK) || defined(FCNTL_CAN_LOCK) && defined(HAS_LOCKF) +#define CAN_FLOCK &PL_sv_yes +#else +#define CAN_FLOCK &PL_sv_no +#endif + #ifdef DEBUGME #ifndef DASSERT @@ -3662,7 +3668,7 @@ static int store_hook( SV *ref; AV *av; SV **ary; - int count; /* really len3 + 1 */ + IV count; /* really len3 + 1 */ unsigned char flags; char *pv; int i; @@ -3752,7 +3758,7 @@ static int store_hook( SvREFCNT_dec(ref); /* Reclaim temporary reference */ count = AvFILLp(av) + 1; - TRACEME(("store_hook, array holds %d items", count)); + TRACEME(("store_hook, array holds %" IVdf " items", count)); /* * If they return an empty list, it means they wish to ignore the @@ -3986,7 +3992,7 @@ static int store_hook( */ TRACEME(("SX_HOOK (recursed=%d) flags=0x%x " - "class=%" IVdf " len=%" IVdf " len2=%" IVdf " len3=%d", + "class=%" IVdf " len=%" IVdf " len2=%" IVdf " len3=%" IVdf, recursed, flags, (IV)classnum, (IV)len, (IV)len2, count-1)); /* SX_HOOK <flags> [<extra>] */ @@ -7794,6 +7800,8 @@ BOOT: newCONSTSUB(stash, "BIN_MINOR", newSViv(STORABLE_BIN_MINOR)); newCONSTSUB(stash, "BIN_WRITE_MINOR", newSViv(STORABLE_BIN_WRITE_MINOR)); + newCONSTSUB(stash, "CAN_FLOCK", CAN_FLOCK); + init_perinterp(aTHX); gv_fetchpv("Storable::drop_utf8", GV_ADDMULTI, SVt_PV); #ifdef DEBUGME diff --git a/ext/PerlIO-via/via.pm b/ext/PerlIO-via/via.pm index 30083feae8..84e54bbd5c 100644 --- a/ext/PerlIO-via/via.pm +++ b/ext/PerlIO-via/via.pm @@ -1,5 +1,5 @@ package PerlIO::via; -our $VERSION = '0.17'; +our $VERSION = '0.18'; require XSLoader; XSLoader::load(); 1; diff --git a/ext/PerlIO-via/via.xs b/ext/PerlIO-via/via.xs index d91c6855fc..8456242bc0 100644 --- a/ext/PerlIO-via/via.xs +++ b/ext/PerlIO-via/via.xs @@ -134,8 +134,8 @@ PerlIOVia_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, { IV code = PerlIOBase_pushed(aTHX_ f, mode, Nullsv, tab); - if (SvTYPE(arg) >= SVt_PVMG - && mg_findext(arg, PERL_MAGIC_ext, &PerlIOVia_tag)) { + if (arg && SvTYPE(arg) >= SVt_PVMG + && mg_findext(arg, PERL_MAGIC_ext, &PerlIOVia_tag)) { return code; } diff --git a/handy.h b/handy.h index 24c028a638..0170773533 100644 --- a/handy.h +++ b/handy.h @@ -569,9 +569,9 @@ each class. (Not all macros have all variants; each item below lists the ones valid for it.) None are affected by C<use bytes>, and only the ones with C<LC> in the name are affected by the current locale. -The base function, e.g., C<isALPHA()>, takes an octet (either a C<char> or a -C<U8>) as input and returns a boolean as to whether or not the character -represented by that octet is (or on non-ASCII platforms, corresponds to) an +The base function, e.g., C<isALPHA()>, takes any signed or unsigned value, +treating it as a code point, and returns a boolean as to whether or not the +character represented by it is (or on non-ASCII platforms, corresponds to) an ASCII character in the named class based on platform, Unicode, and Perl rules. If the input is a number that doesn't fit in an octet, FALSE is returned. @@ -585,16 +585,19 @@ since ASCII is a subset of Latin-1. But the non-ASCII code points are treated as if they are Latin-1 characters. For example, C<isWORDCHAR_L1()> will return true when called with the code point 0xDF, which is a word character in both ASCII and EBCDIC (though it represents different characters in each). +If the input is a number that doesn't fit in an octet, FALSE is returned. +(Perl's documentation uses a colloquial definition of Latin-1, to include all +code points below 256.) -Variant C<isI<FOO>_uvchr> is like the C<isI<FOO>_L1> variant, but accepts any UV code -point as input. If the code point is larger than 255, Unicode rules are used -to determine if it is in the character class. For example, +Variant C<isI<FOO>_uvchr> is exactly like the C<isI<FOO>_L1> variant, for +inputs below 256, but if the code point is larger than 255, Unicode rules are +used to determine if it is in the character class. For example, C<isWORDCHAR_uvchr(0x100)> returns TRUE, since 0x100 is LATIN CAPITAL LETTER A WITH MACRON in Unicode, and is a word character. Variant C<isI<FOO>_utf8_safe> is like C<isI<FOO>_uvchr>, but is used for UTF-8 -encoded strings. Each call classifies one character, even if the string -contains many. This variant takes two parameters. The first, C<p>, is a +encoded strings. Each call classifies the first character of the string. This +variant takes two parameters. The first, C<p>, is a pointer to the first byte of the character to be classified. (Recall that it may take more than one byte to represent a character in UTF-8 strings.) The second parameter, C<e>, points to anywhere in the string beyond the first @@ -609,73 +612,78 @@ future releases. Variant C<isI<FOO>_utf8> is like C<isI<FOO>_utf8_safe>, but takes just a single parameter, C<p>, which has the same meaning as the corresponding parameter does in C<isI<FOO>_utf8_safe>. The function therefore can't check if it is reading -beyond the end of the string. Starting in Perl v5.30, it will take a second +beyond the end of the string. Starting in Perl v5.32, it will take a second parameter, becoming a synonym for C<isI<FOO>_utf8_safe>. At that time every program that uses it will have to be changed to successfully compile. In the meantime, the first runtime call to C<isI<FOO>_utf8> from each call point in the program will raise a deprecation warning, enabled by default. You can convert your program now to use C<isI<FOO>_utf8_safe>, and avoid the warnings, and get an -extra measure of protection, or you can wait until v5.30, when you'll be forced +extra measure of protection, or you can wait until v5.32, when you'll be forced to add the C<e> parameter. -Variant C<isI<FOO>_LC> is like the C<isI<FOO>_A> and C<isI<FOO>_L1> variants, but the -result is based on the current locale, which is what C<LC> in the name stands -for. If Perl can determine that the current locale is a UTF-8 locale, it uses -the published Unicode rules; otherwise, it uses the C library function that -gives the named classification. For example, C<isDIGIT_LC()> when not in a -UTF-8 locale returns the result of calling C<isdigit()>. FALSE is always +Variant C<isI<FOO>_LC> is like the C<isI<FOO>_A> and C<isI<FOO>_L1> variants, +but the result is based on the current locale, which is what C<LC> in the name +stands for. If Perl can determine that the current locale is a UTF-8 locale, +it uses the published Unicode rules; otherwise, it uses the C library function +that gives the named classification. For example, C<isDIGIT_LC()> when not in +a UTF-8 locale returns the result of calling C<isdigit()>. FALSE is always returned if the input won't fit into an octet. On some platforms where the C library function is known to be defective, Perl changes its result to follow the POSIX standard's rules. -Variant C<isI<FOO>_LC_uvchr> is like C<isI<FOO>_LC>, but is defined on any UV. It -returns the same as C<isI<FOO>_LC> for input code points less than 256, and -returns the hard-coded, not-affected-by-locale, Unicode results for larger ones. +Variant C<isI<FOO>_LC_uvchr> acts exactly like C<isI<FOO>_LC> for inputs less +than 256, but for larger ones it returns the Unicode classification of the code +point. Variant C<isI<FOO>_LC_utf8_safe> is like C<isI<FOO>_LC_uvchr>, but is used for UTF-8 -encoded strings. Each call classifies one character, even if the string -contains many. This variant takes two parameters. The first, C<p>, is a -pointer to the first byte of the character to be classified. (Recall that it -may take more than one byte to represent a character in UTF-8 strings.) The -second parameter, C<e>, points to anywhere in the string beyond the first -character, up to one byte past the end of the entire string. The suffix -C<_safe> in the function's name indicates that it will not attempt to read -beyond S<C<e - 1>>, provided that the constraint S<C<s E<lt> e>> is true (this -is asserted for in C<-DDEBUGGING> builds). If the UTF-8 for the input -character is malformed in some way, the program may croak, or the function may -return FALSE, at the discretion of the implementation, and subject to change in -future releases. +encoded strings. Each call classifies the first character of the string. This +variant takes two parameters. The first, C<p>, is a pointer to the first byte +of the character to be classified. (Recall that it may take more than one byte +to represent a character in UTF-8 strings.) The second parameter, C<e>, +points to anywhere in the string beyond the first character, up to one byte +past the end of the entire string. The suffix C<_safe> in the function's name +indicates that it will not attempt to read beyond S<C<e - 1>>, provided that +the constraint S<C<s E<lt> e>> is true (this is asserted for in C<-DDEBUGGING> +builds). If the UTF-8 for the input character is malformed in some way, the +program may croak, or the function may return FALSE, at the discretion of the +implementation, and subject to change in future releases. Variant C<isI<FOO>_LC_utf8> is like C<isI<FOO>_LC_utf8_safe>, but takes just a single parameter, C<p>, which has the same meaning as the corresponding parameter does in C<isI<FOO>_LC_utf8_safe>. The function therefore can't check if it is reading -beyond the end of the string. Starting in Perl v5.30, it will take a second +beyond the end of the string. Starting in Perl v5.32, it will take a second parameter, becoming a synonym for C<isI<FOO>_LC_utf8_safe>. At that time every program that uses it will have to be changed to successfully compile. In the meantime, the first runtime call to C<isI<FOO>_LC_utf8> from each call point in the program will raise a deprecation warning, enabled by default. You can convert your program now to use C<isI<FOO>_LC_utf8_safe>, and avoid the warnings, -and get an extra measure of protection, or you can wait until v5.30, when +and get an extra measure of protection, or you can wait until v5.32, when you'll be forced to add the C<e> parameter. -=for apidoc Am|bool|isALPHA|char ch -Returns a boolean indicating whether the specified character is an -alphabetic character, analogous to C<m/[[:alpha:]]/>. +=for apidoc Am|bool|isALPHA|int ch +Returns a boolean indicating whether the specified input is one of C<[A-Za-z]>, +analogous to C<m/[[:alpha:]]/>. See the L<top of this section|/Character classification> for an explanation of variants C<isALPHA_A>, C<isALPHA_L1>, C<isALPHA_uvchr>, C<isALPHA_utf8_safe>, C<isALPHA_LC>, C<isALPHA_LC_uvchr>, and C<isALPHA_LC_utf8_safe>. -=for apidoc Am|bool|isALPHANUMERIC|char ch -Returns a boolean indicating whether the specified character is a either an -alphabetic character or decimal digit, analogous to C<m/[[:alnum:]]/>. +=for apidoc Am|bool|isALPHANUMERIC|int ch +Returns a boolean indicating whether the specified character is one of +C<[A-Za-z0-9]>, analogous to C<m/[[:alnum:]]/>. See the L<top of this section|/Character classification> for an explanation of variants C<isALPHANUMERIC_A>, C<isALPHANUMERIC_L1>, C<isALPHANUMERIC_uvchr>, C<isALPHANUMERIC_utf8_safe>, C<isALPHANUMERIC_LC>, C<isALPHANUMERIC_LC_uvchr>, and C<isALPHANUMERIC_LC_utf8_safe>. -=for apidoc Am|bool|isASCII|char ch +A (discouraged from use) synonym is C<isALNUMC> (where the C<C> suffix means +this corresponds to the C language alphanumeric definition). Also +there are the variants +C<isALNUMC_A>, C<isALNUMC_L1> +C<isALNUMC_LC>, and C<isALNUMC_LC_uvchr>. + +=for apidoc Am|bool|isASCII|int ch Returns a boolean indicating whether the specified character is one of the 128 characters in the ASCII character set, analogous to C<m/[[:ascii:]]/>. On non-ASCII platforms, it returns TRUE iff this @@ -860,7 +868,7 @@ an API that does allow every possible legal result to be returned.) Likewise no other function that is crippled by not being able to give the correct results for the full range of possible inputs has been implemented here. -=for apidoc Am|U8|toUPPER|U8 ch +=for apidoc Am|U8|toUPPER|int ch Converts the specified character to uppercase. If the input is anything but an ASCII lowercase character, that input character itself is returned. Variant C<toUPPER_A> is equivalent. @@ -897,13 +905,13 @@ implementation, and subject to change in future releases. =for apidoc Am|UV|toUPPER_utf8|U8* p|U8* s|STRLEN* lenp This is like C<L</toUPPER_utf8_safe>>, but doesn't have the C<e> parameter The function therefore can't check if it is reading -beyond the end of the string. Starting in Perl v5.30, it will take the C<e> +beyond the end of the string. Starting in Perl v5.32, it will take the C<e> parameter, becoming a synonym for C<toUPPER_utf8_safe>. At that time every program that uses it will have to be changed to successfully compile. In the meantime, the first runtime call to C<toUPPER_utf8> from each call point in the program will raise a deprecation warning, enabled by default. You can convert your program now to use C<toUPPER_utf8_safe>, and avoid the warnings, and get an -extra measure of protection, or you can wait until v5.30, when you'll be forced +extra measure of protection, or you can wait until v5.32, when you'll be forced to add the C<e> parameter. =for apidoc Am|U8|toFOLD|U8 ch @@ -944,13 +952,13 @@ implementation, and subject to change in future releases. =for apidoc Am|UV|toFOLD_utf8|U8* p|U8* s|STRLEN* lenp This is like C<L</toFOLD_utf8_safe>>, but doesn't have the C<e> parameter The function therefore can't check if it is reading -beyond the end of the string. Starting in Perl v5.30, it will take the C<e> +beyond the end of the string. Starting in Perl v5.32, it will take the C<e> parameter, becoming a synonym for C<toFOLD_utf8_safe>. At that time every program that uses it will have to be changed to successfully compile. In the meantime, the first runtime call to C<toFOLD_utf8> from each call point in the program will raise a deprecation warning, enabled by default. You can convert your program now to use C<toFOLD_utf8_safe>, and avoid the warnings, and get an -extra measure of protection, or you can wait until v5.30, when you'll be forced +extra measure of protection, or you can wait until v5.32, when you'll be forced to add the C<e> parameter. =for apidoc Am|U8|toLOWER|U8 ch @@ -999,13 +1007,13 @@ implementation, and subject to change in future releases. =for apidoc Am|UV|toLOWER_utf8|U8* p|U8* s|STRLEN* lenp This is like C<L</toLOWER_utf8_safe>>, but doesn't have the C<e> parameter The function therefore can't check if it is reading -beyond the end of the string. Starting in Perl v5.30, it will take the C<e> +beyond the end of the string. Starting in Perl v5.32, it will take the C<e> parameter, becoming a synonym for C<toLOWER_utf8_safe>. At that time every program that uses it will have to be changed to successfully compile. In the meantime, the first runtime call to C<toLOWER_utf8> from each call point in the program will raise a deprecation warning, enabled by default. You can convert your program now to use C<toLOWER_utf8_safe>, and avoid the warnings, and get an -extra measure of protection, or you can wait until v5.30, when you'll be forced +extra measure of protection, or you can wait until v5.32, when you'll be forced to add the C<e> parameter. =for apidoc Am|U8|toTITLE|U8 ch @@ -1047,13 +1055,13 @@ implementation, and subject to change in future releases. =for apidoc Am|UV|toTITLE_utf8|U8* p|U8* s|STRLEN* lenp This is like C<L</toLOWER_utf8_safe>>, but doesn't have the C<e> parameter The function therefore can't check if it is reading -beyond the end of the string. Starting in Perl v5.30, it will take the C<e> +beyond the end of the string. Starting in Perl v5.32, it will take the C<e> parameter, becoming a synonym for C<toTITLE_utf8_safe>. At that time every program that uses it will have to be changed to successfully compile. In the meantime, the first runtime call to C<toTITLE_utf8> from each call point in the program will raise a deprecation warning, enabled by default. You can convert your program now to use C<toTITLE_utf8_safe>, and avoid the warnings, and get an -extra measure of protection, or you can wait until v5.30, when you'll be forced +extra measure of protection, or you can wait until v5.32, when you'll be forced to add the C<e> parameter. =cut diff --git a/intrpvar.h b/intrpvar.h index 41aa364329..93357eeadc 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -93,6 +93,14 @@ PERLVARI(I, tainted, bool, FALSE) /* using variables controlled by $< */ */ PERLVAR(I, delaymagic, U16) /* ($<,$>) = ... */ +/* +=for apidoc Amn|GV *|PL_defgv + +The GV representing C<*_>. Useful for access to C<$_>. + +=cut +*/ + PERLVAR(I, localizing, U8) /* are we processing a local() list? */ PERLVAR(I, in_eval, U8) /* trap "fatal" errors? */ PERLVAR(I, defgv, GV *) /* the *_ glob */ @@ -117,11 +125,27 @@ PERLVAR(I, dowarn, U8) PERLVARI(I, utf8cache, I8, PERL___I) /* Is the utf8 caching code enabled? */ #undef PERL___I +/* +=for apidoc Amn|HV*|PL_curstash + +The stash for the package code will be compiled into. + +=cut +*/ /* Stashes */ PERLVAR(I, defstash, HV *) /* main symbol table */ PERLVAR(I, curstash, HV *) /* symbol table for current package */ +/* +=for apidoc Amn|COP*|PL_curcop + +The currently active COP (control op) roughly representing the current +statement in the source. + +=cut +*/ + PERLVAR(I, curcop, COP *) PERLVAR(I, curstack, AV *) /* THE STACK */ PERLVAR(I, curstackinfo, PERL_SI *) /* current stack + context */ @@ -182,6 +206,14 @@ PERLVAR(I, padname_undef, PADNAME) PERLVAR(I, padname_const, PADNAME) PERLVAR(I, Sv, SV *) /* used to hold temporary values */ +/* +=for apidoc Amn|yy_parser*|PL_parser + +The parser state when compiling code. + +=cut +*/ + PERLVAR(I, parser, yy_parser *) /* current parser state */ PERLVAR(I, stashcache, HV *) /* Cache to speed up S_method_common */ @@ -257,6 +289,37 @@ PERLVAR(I, efloatsize, STRLEN) PERLVARI(I, dumpindent, U16, 4) /* number of blanks per dump indentation level */ +/* +=for apidoc Amn|U8|PL_exit_flags + +Contains flags controlling perl's behaviour on exit(): + +=over + +=item * C<PERL_EXIT_DESTRUCT_END> + +If set, END blocks are executed when the interpreter is destroyed. +This is normally set by perl itself after the interpreter is +constructed. + +=item * C<PERL_EXIT_ABORT> + +Call C<abort()> on exit. This is used internally by perl itself to +abort if exit is called while processing exit. + +=item * C<PERL_EXIT_WARN> + +Warn on exit. + +=item * C<PERL_EXIT_EXPECTED> + +Set by the L<perlfunc/exit> operator. + +=back + +=cut +*/ + PERLVAR(I, exit_flags, U8) /* was exit() unexpected, etc. */ PERLVAR(I, utf8locale, bool) /* utf8 locale detected */ @@ -565,6 +628,14 @@ PERLVAR(I, debug, volatile U32) /* flags given to -D switch */ PERLVARI(I, padlist_generation, U32, 1) /* id to identify padlist clones */ +/* +=for apidoc Amn|runops_proc_t|PL_runops + +See L<perlguts/Pluggable runops>. + +=cut +*/ + PERLVARI(I, runops, runops_proc_t, RUNOPS_DEFAULT) PERLVAR(I, subname, SV *) /* name of current subroutine */ @@ -619,8 +690,28 @@ PERLVARI(I, phase, enum perl_phase, PERL_PHASE_CONSTRUCT) PERLVARI(I, in_load_module, bool, FALSE) /* to prevent recursions in PerlIO_find_layer */ -/* This value may be set when embedding for full cleanup */ -/* 0=none, 1=full, 2=full with checks */ +/* +=for apidoc Amn|signed char|PL_perl_destruct_level + +This value may be set when embedding for full cleanup. + +Possible values: + +=over + +=item * 0 - none + +=item * 1 - full + +=item * 2 or greater - full with checks. + +=back + +If C<$ENV{PERL_DESTRUCT_LEVEL}> is set to an integer greater than the +value of C<PL_perl_destruct_level> its value is used instead. + +=cut +*/ /* mod_perl is special, and also assigns a meaning -1 */ PERLVARI(I, perl_destruct_level, signed char, 0) diff --git a/op.c b/op.c index 5d0b1dae3a..86251047b6 100644 --- a/op.c +++ b/op.c @@ -9287,7 +9287,8 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) /* upgrade loop from a LISTOP to a LOOPOP; * keep it in-place if there's space */ if (loop->op_slabbed - && OpSLOT(loop)->opslot_size < SIZE_TO_PSIZE(sizeof(LOOP))) + && OpSLOT(loop)->opslot_size + < SIZE_TO_PSIZE(sizeof(LOOP)) + OPSLOT_HEADER_P) { /* no space; allocate new op */ LOOP *tmp; diff --git a/perl.h b/perl.h index b47587cf2a..746ce980a4 100644 --- a/perl.h +++ b/perl.h @@ -1380,6 +1380,13 @@ Clear the contents of C<$@>, setting it to the empty string. This replaces any read-only SV with a fresh SV and removes any magic. +=for apidoc Am|void|SANE_ERRSV + +Clean up ERRSV so we can safely set it. + +This replaces any read-only SV with a fresh writable copy and removes +any magic. + =cut */ @@ -1403,6 +1410,23 @@ This replaces any read-only SV with a fresh SV and removes any magic. } \ } STMT_END +/* contains inlined gv_add_by_type */ +#define SANE_ERRSV() STMT_START { \ + SV ** const svp = &GvSV(PL_errgv); \ + if (!*svp) { \ + *svp = newSVpvs(""); \ + } else if (SvREADONLY(*svp)) { \ + SV *dupsv = newSVsv(*svp); \ + SvREFCNT_dec_NN(*svp); \ + *svp = dupsv; \ + } else { \ + SV *const errsv = *svp; \ + if (SvMAGICAL(errsv)) { \ + mg_free(errsv); \ + } \ + } \ + } STMT_END + #ifdef PERL_CORE # define DEFSV (0 + GvSVn(PL_defgv)) @@ -1630,6 +1654,8 @@ This replaces any read-only SV with a fresh SV and removes any magic. * longer need that. XS modules can (and do) use this name, so it must remain * a part of the API that's visible to modules. +=head1 Miscellaneous Functions + =for apidoc ATmD|int|my_sprintf|NN char *buffer|NN const char *pat|... Do NOT use this due to the possibility of overflowing C<buffer>. Instead use diff --git a/pod/perldelta.pod b/pod/perldelta.pod index c988864969..87fac1a1b8 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -45,6 +45,18 @@ XXX For a release on a stable branch, this section aspires to be: [ List each incompatible change as a =head2 entry ] +=head2 Plain "0" string now treated as a number for range operator + +Previously a range C< "0" .. "-1" > would produce a range of numeric +strings from "0" through "99", this now produces an empty list, just +as C< 0 .. -1 > does. + +This was due to a special case that treated strings starting with "0" +as strings so ranges like C< "00" .. "03" > produced C< "00", "01", +"02", "03" >, but didn't specially handle the string C<"0">. + +[perl #133695] + =head1 Deprecations XXX Any deprecated features, syntax, modules etc. should be listed here. @@ -401,6 +413,13 @@ instead of ignoring it. [perl #134291] C<< 0 0x@ >> no longer asserts in S_no_op(). [perl #134310] +=item * + +Exceptions thrown while C<$@> is read-only could result in infinite +recursion as perl tried to update C<$@>, which throws another +exception, resulting in a stack overflow. Perl now replaces C<$@> +with a copy if it's not a simple writable SV. [perl #134266] + =back =head1 Known Problems diff --git a/pod/perlop.pod b/pod/perlop.pod index dd658bf5fb..58127e8bc8 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1081,26 +1081,81 @@ And now some examples as a list operator: @foo = @foo[0 .. $#foo]; # an expensive no-op @foo = @foo[$#foo-4 .. $#foo]; # slice last 5 items -The range operator (in list context) makes use of the magical -auto-increment algorithm if the operands are strings. You -can say +Because each operand is evaluated in integer form, S<C<2.18 .. 3.14>> will +return two elements in list context. - @alphabet = ("A" .. "Z"); + @list = (2.18 .. 3.14); # same as @list = (2 .. 3); -to get all normal letters of the English alphabet, or +The range operator in list context can make use of the magical +auto-increment algorithm if both operands are strings, subject to the +following rules: - $hexdigit = (0 .. 9, "a" .. "f")[$num & 15]; +=over + +=item * + +With one exception (below), if both strings look like numbers to Perl, +the magic increment will not be applied, and the strings will be treated +as numbers (more specifically, integers) instead. + +For example, C<"-2".."2"> is the same as C<-2..2>, and +C<"2.18".."3.14"> produces C<2, 3>. -to get a hexadecimal digit, or +=item * + +The exception to the above rule is when the left-hand string begins with +C<0> and is longer than one character, in this case the magic increment +I<will> be applied, even though strings like C<"01"> would normally look +like a number to Perl. + +For example, C<"01".."04"> produces C<"01", "02", "03", "04">, and +C<"00".."-1"> produces C<"00"> through C<"99"> - this may seem +surprising, but see the following rules for why it works this way. +To get dates with leading zeros, you can say: @z2 = ("01" .. "31"); print $z2[$mday]; -to get dates with leading zeros. +If you want to force strings to be interpreted as numbers, you could say + + @numbers = ( 0+$first .. 0+$last ); + +=item * + +If the initial value specified isn't part of a magical increment +sequence (that is, a non-empty string matching C</^[a-zA-Z]*[0-9]*\z/>), +only the initial value will be returned. + +For example, C<"ax".."az"> produces C<"ax", "ay", "az">, but +C<"*x".."az"> produces only C<"*x">. + +=item * + +For other initial values that are strings that do follow the rules of the +magical increment, the corresponding sequence will be returned. + +For example, you can say + + @alphabet = ("A" .. "Z"); + +to get all normal letters of the English alphabet, or + + $hexdigit = (0 .. 9, "a" .. "f")[$num & 15]; + +to get a hexadecimal digit. + +=item * If the final value specified is not in the sequence that the magical increment would produce, the sequence goes until the next value would -be longer than the final value specified. +be longer than the final value specified. If the length of the final +string is shorter than the first, the empty list is returned. + +For example, C<"a".."--"> is the same as C<"a".."zz">, C<"0".."xx"> +produces C<"0"> through C<"99">, and C<"aaa".."--"> returns the empty +list. + +=back As of Perl 5.26, the list-context range operator on strings works as expected in the scope of L<< S<C<"use feature 'unicode_strings">>|feature/The @@ -1108,10 +1163,8 @@ in the scope of L<< S<C<"use feature 'unicode_strings">>|feature/The that feature, it exhibits L<perlunicode/The "Unicode Bug">: its behavior depends on the internal encoding of the range endpoint. -If the initial value specified isn't part of a magical increment -sequence (that is, a non-empty string matching C</^[a-zA-Z]*[0-9]*\z/>), -only the initial value will be returned. So the following will only -return an alpha: +Because the magical increment only works on non-empty strings matching +C</^[a-zA-Z]*[0-9]*\z/>, the following will only return an alpha: use charnames "greek"; my @greek_small = ("\N{alpha}" .. "\N{omega}"); @@ -1131,11 +1184,6 @@ you could use the pattern C</(?:(?=\p{Greek})\p{Lower})+/> (or the L<experimental feature|perlrecharclass/Extended Bracketed Character Classes> C<S</(?[ \p{Greek} & \p{Lower} ])+/>>). -Because each operand is evaluated in integer form, S<C<2.18 .. 3.14>> will -return two elements in list context. - - @list = (2.18 .. 3.14); # same as @list = (2 .. 3); - =head2 Conditional Operator X<operator, conditional> X<operator, ternary> X<ternary> X<?:> diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 9a27fac655..2a32976c01 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -1257,8 +1257,7 @@ after compilation. =item PERL_DESTRUCT_LEVEL X<PERL_DESTRUCT_LEVEL> -Relevant only if your Perl executable was built with B<-DDEBUGGING>, -this controls the behaviour of global destruction of objects and other +Controls the behaviour of global destruction of objects and other references. See L<perlhacktips/PERL_DESTRUCT_LEVEL> for more information. =item PERL_DL_NONLAZY diff --git a/pp_ctl.c b/pp_ctl.c index a38b9c19b2..8d3097b67a 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1178,14 +1178,18 @@ PP(pp_flip) } /* This code tries to decide if "$left .. $right" should use the - magical string increment, or if the range is numeric (we make - an exception for .."0" [#18165]). AMS 20021031. */ + magical string increment, or if the range is numeric. Initially, + an exception was made for *any* string beginning with "0" (see + [#18165], AMS 20021031), but now that is only applied when the + string's length is also >1 - see the rules now documented in + perlop [#133695] */ #define RANGE_IS_NUMERIC(left,right) ( \ SvNIOKp(left) || (SvOK(left) && !SvPOKp(left)) || \ SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \ (((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \ - looks_like_number(left)) && SvPOKp(left) && *SvPVX_const(left) != '0')) \ + looks_like_number(left)) && SvPOKp(left) \ + && !(*SvPVX_const(left) == '0' && SvCUR(left)>1 ) )) \ && (!SvOK(right) || looks_like_number(right)))) PP(pp_flop) @@ -1720,9 +1724,13 @@ Perl_die_unwind(pTHX_ SV *msv) * perls 5.13.{1..7} which had late setting of $@ without this * early-setting hack. */ - if (!(in_eval & EVAL_KEEPERR)) + if (!(in_eval & EVAL_KEEPERR)) { + /* remove any read-only/magic from the SV, so we don't + get infinite recursion when setting ERRSV */ + SANE_ERRSV(); sv_setsv_flags(ERRSV, exceptsv, (SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL)); + } if (in_eval & EVAL_KEEPERR) { Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf, @@ -1784,8 +1792,10 @@ Perl_die_unwind(pTHX_ SV *msv) */ S_pop_eval_context_maybe_croak(aTHX_ cx, exceptsv, 2); - if (!(in_eval & EVAL_KEEPERR)) + if (!(in_eval & EVAL_KEEPERR)) { + SANE_ERRSV(); sv_setsv(ERRSV, exceptsv); + } PL_restartjmpenv = restartjmpenv; PL_restartop = restartop; JMPENV_JUMP(3); diff --git a/pp_sort.c b/pp_sort.c index 899b1138ec..0c5efb0869 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -346,6 +346,8 @@ cmp_desc(pTHX_ gptr const a, gptr const b) } /* +=head1 SV Manipulation Functions + =for apidoc sortsv_flags In-place sort an array of SV pointers with the given comparison routine, diff --git a/regcomp.c b/regcomp.c index 1117998fc8..cf9246473f 100644 --- a/regcomp.c +++ b/regcomp.c @@ -23092,7 +23092,9 @@ Perl_parse_uniprop_string(pTHX_ } /* Store the first real character in the denominator */ - lookup_name[j++] = name[i]; + if (i < name_len) { + lookup_name[j++] = name[i]; + } } } diff --git a/scope.c b/scope.c index 3e4ee4344b..9b1393c69d 100644 --- a/scope.c +++ b/scope.c @@ -313,6 +313,9 @@ Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val) } /* + +=head1 GV Functions + =for apidoc save_gp Saves the current GP of gv on the save stack to be restored on scope exit. diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl index b1e754c356..de0221b57d 100644 --- a/t/lib/croak/pp_ctl +++ b/t/lib/croak/pp_ctl @@ -51,3 +51,11 @@ use 5.01; default{} EXPECT Can't "default" outside a topicalizer at - line 2. +######## +# NAME croak with read only $@ +eval '"a" =~ /${*@=\_})/'; +die; +# this would previously recurse infinitely in the eval +EXPECT +Unmatched ) in regex; marked by <-- HERE in m/_) <-- HERE / at (eval 1) line 1. + ...propagated at - line 2. diff --git a/t/op/range.t b/t/op/range.t index 19ae1269ca..2deefc61cf 100644 --- a/t/op/range.t +++ b/t/op/range.t @@ -9,7 +9,7 @@ BEGIN { use Config; -plan (146); +plan (162); is(join(':',1..5), '1:2:3:4:5'); @@ -112,6 +112,27 @@ is(join(":","-4".."-0") , "-4:-3:-2:-1:0"); is(join(":","-4\n".."0\n") , "-4:-3:-2:-1:0"); is(join(":","-4\n".."-0\n"), "-4:-3:-2:-1:0"); +# [#133695] "0".."-1" should be the same as 0..-1 +is(join(":","-2".."-1") , "-2:-1"); +is(join(":","-1".."-1") , "-1"); +is(join(":","0".."-1") , ""); +is(join(":","1".."-1") , ""); + +# these test the statements made in the documentation +# regarding the rules of string ranges +is(join(":","-2".."2"), join(":",-2..2)); +is(join(":","2.18".."3.14"), "2:3"); +is(join(":","01".."04"), "01:02:03:04"); +is(join(":","00".."-1"), "00:01:02:03:04:05:06:07:08:09:10:11:12:13:14:15:16:17:18:19:20:21:22:23:24:25:26:27:28:29:30:31:32:33:34:35:36:37:38:39:40:41:42:43:44:45:46:47:48:49:50:51:52:53:54:55:56:57:58:59:60:61:62:63:64:65:66:67:68:69:70:71:72:73:74:75:76:77:78:79:80:81:82:83:84:85:86:87:88:89:90:91:92:93:94:95:96:97:98:99"); +is(join(":","00".."31"), "00:01:02:03:04:05:06:07:08:09:10:11:12:13:14:15:16:17:18:19:20:21:22:23:24:25:26:27:28:29:30:31"); +is(join(":","ax".."az"), "ax:ay:az"); +is(join(":","*x".."az"), "*x"); +is(join(":","A".."Z"), "A:B:C:D:E:F:G:H:I:J:K:L:M:N:O:P:Q:R:S:T:U:V:W:X:Y:Z"); +is(join(":", 0..9,"a".."f"), "0:1:2:3:4:5:6:7:8:9:a:b:c:d:e:f"); +is(join(":","a".."--"), join(":","a".."zz")); +is(join(":","0".."xx"), "0:1:2:3:4:5:6:7:8:9:10:11:12:13:14:15:16:17:18:19:20:21:22:23:24:25:26:27:28:29:30:31:32:33:34:35:36:37:38:39:40:41:42:43:44:45:46:47:48:49:50:51:52:53:54:55:56:57:58:59:60:61:62:63:64:65:66:67:68:69:70:71:72:73:74:75:76:77:78:79:80:81:82:83:84:85:86:87:88:89:90:91:92:93:94:95:96:97:98:99"); +is(join(":","aaa".."--"), ""); + # undef should be treated as 0 for numerical range is(join(":",undef..2), '0:1:2'); is(join(":",-2..undef), '-2:-1:0'); -- Perl5 Master Repository
