In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0d7b125b0c3d6ada9b99e6cdd424e39fbc3aa5f1?hp=34213185c286738af0d6c7a97ef3ef00228d3a43>
- Log ----------------------------------------------------------------- commit 0d7b125b0c3d6ada9b99e6cdd424e39fbc3aa5f1 Author: Father Chrysostomos <[email protected]> Date: Sat Dec 8 18:38:46 2012 -0800 Suppress deprec. warning from Devel::PPPortâs tests This has already been submitted to <https://rt.cpan.org/Ticket/Display.html?id=81796>. M cpan/Devel-PPPort/t/misc.t commit 632738b310c2e93b22764bee8a0078084af3aa1a Author: Father Chrysostomos <[email protected]> Date: Sat Dec 8 06:45:18 2012 -0800 leakfinder.pl: Skip push/unshift after { or ( M Porting/leakfinder.pl commit fe04edcba80d57bb8922cd72c6c84e158645f656 Author: Father Chrysostomos <[email protected]> Date: Sat Dec 8 06:40:52 2012 -0800 leakfinder.pl: Fix select skip It wasnât skipping select without parentheses, which was the purpose of that (?:...) group. M Porting/leakfinder.pl commit b6407c49d7cf6dff28149bbe7950b512b8ebd25d Author: Father Chrysostomos <[email protected]> Date: Sat Dec 8 06:36:59 2012 -0800 Stop invalid charnames from leaking The tests I added earlier were failing for a different reason than the test names suggested. Invalid charnames are not leaking because of the âtoo many errorsâ that yyerror croakingly utters, but are leaking even when yyerror doesnât croak. S_get_and_check_backslash_N_name just needs to free the returned SV before returning if it is undefined. M t/op/svleak.t M toke.c commit ae5c22c148afc309380cbb328865a9fd64142cd9 Author: Father Chrysostomos <[email protected]> Date: Sat Dec 8 05:49:13 2012 -0800 toke.c:S_new_constant: Use NN SvREFCNT_inc in 2 places The sv argument passed to new_constant is never null. If the function it calls is naughty enough to push a null on the stack, new_constantâs callers will crash anyway. So we can assume res is not null. This eliminates needless null checks. M toke.c commit 5f7f7af517bf32a891a7a891c738ddbe40051b53 Author: Father Chrysostomos <[email protected]> Date: Sat Dec 8 05:44:44 2012 -0800 Stop Constant(%s) errors from leaking This error message uses yyerror, so it doesnât abort immediately, but adds it to the queue of error messages. If there are ten accumulated errors, however, yyerror croaks with a âtoo many errorsâ message. In that circumstance these messages were leaking scalars. Instead of creating an SV especially to hold the message to pass to yyerror and then freeing it afterwards, we can instead use Perl_form, which reuses the same SV every time (PL_mess_sv), eliminating that leak. In doing so, we can also combine this with another yyerror/ return in the vicinity, avoiding duplicate code. The sv passed to S_new_constant was also leaking. When there is no error, it is currently mortalised. When there is an error, it also needs to be mortalised, in case it is a fatal error. So this commit changes it to mortalise it unconditionally. This means we have to SvREFCNT_inc the return value on error. M t/op/svleak.t M toke.c commit bb4784f001b7eefaf06670e2ee209e9ea942d5af Author: Father Chrysostomos <[email protected]> Date: Fri Dec 7 09:25:49 2012 -0800 Change Constant(undef) error to something meaningful Look at these errors: $ perl5.16.0 -e 'use overload; BEGIN{overload::constant q => sub{}; } "aaa"' Constant(q): Call to &{$^H{q}} did not return a defined value at -e line 1, near "} "aaa"" Execution of -e aborted due to compilation errors. $ perl5.16.0 -e 'BEGIN{++$_ for @INC{<charnames.pm _charnames.pm>}} "\N{a}"' Constant(\N{a}) unknown at -e line 1, within string Execution of -e aborted due to compilation errors. $ perl5.16.0 -e 'use overload; BEGIN{overload::constant q => sub{}; } tr"aaa""' Constant(tr): Call to &{$^H{q}} did not return a defined value at -e line 1, within string Execution of -e aborted due to compilation errors. The (q) and (tr) might seem a bit odd, but are not completely meaning- less. They match the third argument passed to the overload handler. Now look at this: $ perl5.16.0 -e 'use overload; BEGIN{overload::constant integer => sub{}; } 123' Constant(undef): Call to &{$^H{integer}} did not return a defined value at -e line 1, at end of line Execution of -e aborted due to compilation errors. $ perl5.16.0 -e 'use overload; BEGIN{overload::constant float => sub{}; } 1.23' Constant(undef): Call to &{$^H{float}} did not return a defined value at -e line 1, at end of line Execution of -e aborted due to compilation errors. $ perl5.16.0 -e 'use overload; BEGIN{overload::constant binary => sub{}; } 0x123' Constant(undef): Call to &{$^H{binary}} did not return a defined value at -e line 1, at end of line Execution of -e aborted due to compilation errors. That Constant(undef) is not helpful. This commit changes it to show the number itself, making these cases similar to \N{}. M t/lib/croak/toke M toke.c commit 247a7f40cd18f049b85ee008433addbd3069717a Author: Father Chrysostomos <[email protected]> Date: Fri Dec 7 06:25:24 2012 -0800 Test âConstant(%s) unknownâ error This only happens if someone accidentally (or intentionally :-) unde- fines %^H or *^H or stops charnames from loading. M t/lib/croak/toke commit b2e3d01a1a3d82b7b763c5fc9fc5b4213638d41f Author: Father Chrysostomos <[email protected]> Date: Fri Dec 7 06:09:45 2012 -0800 Test error when constant overload handler returns undef M t/lib/croak/toke commit e21e7c6ab6af8471392d97efd339f2bd51a74b45 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 6 20:24:34 2012 -0800 perldiag: Make Constant(%s) messages match reality We no longer have an âin regexâ variant (if we ever did). The Constant(%s)%s: %s represents three specific warnings, one of which doesnât have the colon any more. Itâs clearer if we list all three, especially since the one about returning undef can acciden- tally happen with ânormalâ code (as opposed to code that fiddles with %^H entries it shouldnât be touching). M pod/perldiag.pod commit 9e3ec65c53bb454ad2eda11175b694251f64f980 Author: Father Chrysostomos <[email protected]> Date: Thu Dec 6 13:26:01 2012 -0800 perldiag: s/about where/whereabouts/ Every time I see that âabout whereâ I wonder why it sounds so funny. It just dawned on me that we should just use the word âwhereaboutsâ, which fits perfectly in this context, and doesnât sound as though it needs a rewrite. M pod/perldiag.pod commit 67a057d6d88eb9aafa609d47fefa412673b99ff5 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 5 23:10:25 2012 -0800 toke.c: Make _charnames check more robust Assuming that $^H{charnames} exists and contains a code ref can result in crashes. See the tests in the diff. Itâs not a good idea to do $INC{"_charnames.pm"}++, but perl still shouldnât crash. M t/op/lex.t M toke.c commit e3fdfe77a69de5c9746593dc75431d53cef4c9f4 Author: Father Chrysostomos <[email protected]> Date: Wed Dec 5 21:49:02 2012 -0800 MANIFEST typo M MANIFEST commit f374c70f2f466935df480e5b2a9b1853fd86aa9d Author: Father Chrysostomos <[email protected]> Date: Wed Dec 5 18:27:18 2012 -0800 Fewer strEQ calls in toke.c:S_new_constant There is a small fixed number of keys that can be passed to this static function: charnames binary float integer q qr In a few places, we check whether the key is "charnames". It would be quicker just to check the first character, since, if it is 'c', the key must be "charnames". (Under debugging builds, assert that that assumption is true.) M toke.c ----------------------------------------------------------------------- Summary of changes: MANIFEST | 2 +- Porting/leakfinder.pl | 9 +--- cpan/Devel-PPPort/t/misc.t | 1 + pod/perldiag.pod | 107 +++++++++++++++++++++++-------------------- t/lib/croak/toke | 95 +++++++++++++++++++++++++++++++++++++++ t/op/lex.t | 25 ++++++++++- t/op/svleak.t | 23 +++++++--- toke.c | 46 ++++++++++--------- 8 files changed, 221 insertions(+), 87 deletions(-) diff --git a/MANIFEST b/MANIFEST index 49eede9..587f9cc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5265,7 +5265,7 @@ t/op/concat2.t Tests too complex for concat.t t/op/cond.t See if conditional expressions work t/op/context.t See if context propagation works t/op/coreamp.t Test &foo() calls for CORE subs -t/op/coresubs.t Generics tests for CORE subs +t/op/coresubs.t Generic tests for CORE subs t/op/cproto.t Check builtin prototypes t/op/crypt.t See if crypt works t/op/current_sub.t __SUB__ tests diff --git a/Porting/leakfinder.pl b/Porting/leakfinder.pl index db93a17..760a4d3 100644 --- a/Porting/leakfinder.pl +++ b/Porting/leakfinder.pl @@ -24,8 +24,8 @@ for(`find .`) { next if /rm -rf/; # Could be an example from perlsec, e.g. # Creating one of these special blocks creates SVs, obviously next if /(?:END|CHECK|INIT)\s*\{/; - next if /^\s*(?:push|unshift|(?:\@r = )?splice|binmode|sleep)/; - next if /\bselect(?:\s*\()[^()]+,/; # 4-arg select hangs + next if /^[{(]?\s*(?:push|unshift|(?:\@r = )?splice|binmode|sleep)/; + next if /\bselect(?:\s*|\()[^()]+,/; # 4-arg select hangs next if /use parent/; my $q = s/[\\']/sprintf "\\%02x", ord $&/gore =~ s/\0/'."\\0".'/grid; @@ -127,11 +127,6 @@ print "LA LA LA\n" while 1; # loops forever prog => 'use Config; CHECK { $Config{awk} }', $p->{share_dir} = { dist => [ $p->{share_dir} ] }; $p->{share_dir} = { dist => $p->{share_dir} }; -{ push (@Bad, $key) } -( push @hard, $file ), next -{ push @keep, $_ } -{ push @$output, $x->{buff} } -{ push (@values, $value) } $resp = [$resp] s/a|/push @bar, 1/e; $self->{DIR} = [grep $_, split ":", $self->{DIR}]; diff --git a/cpan/Devel-PPPort/t/misc.t b/cpan/Devel-PPPort/t/misc.t index 9dcc565..f74a9df 100644 --- a/cpan/Devel-PPPort/t/misc.t +++ b/cpan/Devel-PPPort/t/misc.t @@ -59,6 +59,7 @@ ok(&Devel::PPPort::UNDERBAR(), "Fred"); if ($] >= 5.009002) { eval q{ + no warnings "deprecated"; my $_ = "Tony"; ok(&Devel::PPPort::DEFSV(), "Fred"); ok(&Devel::PPPort::UNDERBAR(), "Tony"); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 2a0e838..6589ca8 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1504,18 +1504,25 @@ thread has entered cond_wait() and thus relinquished the lock. to check the return value of your socket() call? See L<perlfunc/connect>. -=item Constant(%s)%s: %s +=item Constant(%s): Call to &{$^H{%s}} did not return a defined value + +(F) The subroutine registered to handle constant overloading +(see L<overload>) or a custom charnames handler (see +L<charnames/CUSTOM TRANSLATORS>) returned an undefined value. + +=item Constant(%s): $^H{%s} is not defined + +(F) The parser found inconsistencies while attempting to define an +overloaded constant. Perhaps you forgot to load the corresponding +L<overload> pragma?. + +=item Constant(%s) unknown (F) The parser found inconsistencies either while attempting to define an overloaded constant, or when trying to find the character name specified in the C<\N{...}> escape. Perhaps you forgot to load the corresponding L<overload> pragma?. -=item Constant(%s)%s: %s in regex; marked by <-- HERE in m/%s/ - -(F) The parser found inconsistencies while attempting to find -the character name specified in the C<\N{...}> escape. - =item Constant is not %s reference (F) A constant value (perhaps declared using the C<use constant> pragma) @@ -1622,7 +1629,7 @@ it's loaded, etc. most likely cause of this error is that you left out a parenthesis inside of the C<....> part. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item %s defines neither package nor VERSION--version check failed @@ -1807,7 +1814,7 @@ pragma is in effect. See L<perlre/(?{ code })>. (F) You used a pattern that nested too many EVAL calls without consuming any text. Restructure the pattern so that text is consumed. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item Excessively long <> operator @@ -1883,7 +1890,7 @@ queue of such routines has been prematurely ended. (W regexp) A character class range must start and end at a literal character, not another character class like C<\d> or C<[:alpha:]>. The "-" in your false range is interpreted as a literal "-". Consider quoting the -"-", "\-". The <-- HERE shows in the regular expression about where the +"-", "\-". The <-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Fatal VMS error (status=%d) at %s, line %d @@ -2242,7 +2249,7 @@ encoding is limited to code points no larger than 2147483647 (0x7FFFFFFF). text. You should check the pattern to ensure that recursive patterns either consume text or fail. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item Initialization of state variables in list context currently forbidden @@ -2325,7 +2332,7 @@ to use some odd mathematical operation as a version, like 100/9. =item Internal disaster in regex; marked by <-- HERE in m/%s/ (P) Something went badly wrong in the regular expression parser. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item Internal inconsistency in tracking vforks @@ -2340,7 +2347,7 @@ terminate the Perl script and execute the specified command. =item Internal urp in regex; marked by <-- HERE in m/%s/ (P) Something went badly awry in the regular expression parser. The -<-- HERE shows in the regular expression about where the problem was +<-- HERE shows whereabouts in the regular expression the problem was discovered. =item %s (...) interpreted as function @@ -2382,7 +2389,7 @@ L<perlfunc/sprintf>. didn't correspond to a single character through the conversion from the encoding specified by the encoding pragma. The escape was replaced with REPLACEMENT CHARACTER (U+FFFD) instead. -The <-- HERE shows in the regular expression about where the +The <-- HERE shows whereabouts in the regular expression the escape was discovered. =item Invalid hexadecimal number in \N{U+...} @@ -2424,7 +2431,7 @@ See also L<perlrun/B<-D>I<letters>>. (F) The range specified in a character class had a minimum character greater than the maximum character. One possibility is that you forgot the C<{}> from your ending C<\x{}> - C<\x> without the curly braces can go only -up to C<ff>. The <-- HERE shows in the regular expression about where the +up to C<ff>. The <-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Invalid range "%s" in transliteration operator @@ -2738,7 +2745,7 @@ doing it Perl met a malformed Unicode surrogate. (W regexp) The pattern you've specified would be an infinite loop if the regular expression engine didn't specifically check for that. The <-- HERE -shows in the regular expression about where the problem was discovered. +shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Maximal count of pending signals (%u) exceeded @@ -3020,8 +3027,8 @@ greater than or equal to zero. =item Nested quantifiers in regex; marked by <-- HERE in m/%s/ (F) You can't quantify a quantifier without intervening parentheses. -So things like ** or +* or ?* are illegal. The <-- HERE shows in the -regular expression about where the problem was discovered. +So things like ** or +* or ?* are illegal. The <-- HERE shows +whereabouts in the regular expression the problem was discovered. Note that the minimal matching quantifiers, C<*?>, C<+?>, and C<??> appear to be nested quantifiers, but aren't. See L<perlre>. @@ -3772,7 +3779,7 @@ a detectable way. consuming any text. Restructure the pattern so text is consumed before the nesting limit is exceeded. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item Parentheses missing around "%s" list @@ -3881,7 +3888,7 @@ fine from VMS' perspective, it's probably not what you intended. =item POSIX class [:%s:] unknown in regex; marked by <-- HERE in m/%s/ (F) The class in the character class [: :] syntax is unknown. The <-- HERE -shows in the regular expression about where the problem was discovered. +shows whereabouts in the regular expression the problem was discovered. Note that the POSIX character classes do B<not> have the C<is> prefix the corresponding C interfaces have: in other words, it's C<[[:print:]]>, not C<isprint>. See L<perlre>. @@ -3896,9 +3903,9 @@ the BSD version, which takes a pid. (W regexp) The character class constructs [: :], [= =], and [. .] go I<inside> character classes, the [] are part of the construct, for example: /[012[:alpha:]345]/. Note that [= =] and [. .] are not currently -implemented; they are simply placeholders for future extensions and will -cause fatal errors. The <-- HERE shows in the regular expression about -where the problem was discovered. See L<perlre>. +implemented; they are simply placeholders for future extensions and +will cause fatal errors. The <-- HERE shows whereabouts in the regular +expression the problem was discovered. See L<perlre>. =item POSIX syntax [. .] is reserved for future extensions in regex; marked by <-- HERE in m/%s/ @@ -3906,7 +3913,7 @@ where the problem was discovered. See L<perlre>. with "[." and ending with ".]" is reserved for future extensions. If you need to represent those character sequences inside a regular expression character class, just quote the square brackets with the backslash: "\[." -and ".\]". The <-- HERE shows in the regular expression about where the +and ".\]". The <-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item POSIX syntax [= =] is reserved for future extensions in regex; marked by <-- HERE in m/%s/ @@ -3915,7 +3922,7 @@ problem was discovered. See L<perlre>. with "[=" and ending with "=]" is reserved for future extensions. If you need to represent those character sequences inside a regular expression character class, just quote the square brackets with the backslash: "\[=" -and "=\]". The <-- HERE shows in the regular expression about where the +and "=\]". The <-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Possible attempt to put comments in qw() list @@ -4082,14 +4089,14 @@ change when upper cased. =item Quantifier follows nothing in regex; marked by <-- HERE in m/%s/ (F) You started a regular expression with a quantifier. Backslash it if -you meant it literally. The <-- HERE shows in the regular expression -about where the problem was discovered. See L<perlre>. +you meant it literally. The <-- HERE shows whereabouts in the regular +expression the problem was discovered. See L<perlre>. =item Quantifier in {,} bigger than %d in regex; marked by <-- HERE in m/%s/ (F) There is currently a limit to the size of the min and max values of -the {min,max} construct. The <-- HERE shows in the regular expression -about where the problem was discovered. See L<perlre>. +the {min,max} construct. The <-- HERE shows whereabouts in the regular +expression the problem was discovered. See L<perlre>. =item Quantifier unexpected on zero-length expression; marked by <-- HERE in m/%s/ @@ -4099,7 +4106,7 @@ quantifier inside the assertion instead. For example, the way to match "abc" provided that it is followed by three repetitions of "xyz" is C</abc(?=(?:xyz){3})/>, not C</abc(?=xyz){3}/>. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item Quantifier {n,m} with n > m can't match in regex @@ -4200,7 +4207,7 @@ not at least seven sets of capturing parentheses in the expression. If you wanted to have the character with ordinal 7 inserted into the regular expression, prepend zeroes to make it three digits long: C<\007> -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item Reference to nonexistent named group in regex; marked by <-- HERE in m/%s/ @@ -4210,7 +4217,7 @@ expression, but there is no corresponding named capturing parentheses such as C<(?'NAME'...)> or C<< (?<NAME>...) >>. Check if the name has been spelled correctly both in the backreference and the declaration. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item Reference to nonexistent or unclosed group in regex; marked by <-- HERE in m/%s/ @@ -4219,7 +4226,7 @@ discovered. are not at least seven sets of closed capturing parentheses in the expression before where the C<\g{-7}> was located. -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. =item regexp memory corruption @@ -4374,19 +4381,19 @@ before now. Check your control flow. =item Sequence (? incomplete in regex; marked by <-- HERE in m/%s/ (F) A regular expression ended with an incomplete extension (?. The -<-- HERE shows in the regular expression about where the problem was +<-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Sequence (?%s...) not implemented in regex; marked by <-- HERE in m/%s/ (F) A proposed regular expression extension has the character reserved -but has not yet been written. The <-- HERE shows in the regular -expression about where the problem was discovered. See L<perlre>. +but has not yet been written. The <-- HERE shows whereabouts in the +regular expression the problem was discovered. See L<perlre>. =item Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ (F) You used a regular expression extension that doesn't make sense. The -<-- HERE shows in the regular expression about where the problem was +<-- HERE shows whereabouts in the regular expression the problem was discovered. This happens when using the C<(?^...)> construct to tell Perl to use the default regular expression modifiers, and you redundantly specify a default modifier. For other @@ -4674,14 +4681,14 @@ it in clustering parentheses: (?(condition)(?:this|that|other)|else-clause) -The <-- HERE shows in the regular expression about where the problem +The <-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Switch condition not recognized in regex; marked by <-- HERE in m/%s/ (F) If the argument to the (?(...)if-clause|else-clause) construct is -a number, it can be only a number. The <-- HERE shows in the regular -expression about where the problem was discovered. See L<perlre>. +a number, it can be only a number. The <-- HERE shows whereabouts in +the regular expression the problem was discovered. See L<perlre>. =item switching effective %s is not implemented @@ -5142,7 +5149,7 @@ is not known. The condition must be one of the following: (R&NAME) true if directly inside named capture (DEFINE) always false; for defining named subpatterns -The <-- HERE shows in the regular expression about where the problem was +The <-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Unknown Unicode option letter '%c' @@ -5174,7 +5181,7 @@ module first. (F) The brackets around a character class must match. If you wish to include a closing bracket in a character class, backslash it or put it -first. The <-- HERE shows in the regular expression about where the +first. The <-- HERE shows whereabouts in the regular expression the problem was discovered. See L<perlre>. =item Unmatched ( in regex; marked by <-- HERE in m/%s/ @@ -5183,8 +5190,8 @@ problem was discovered. See L<perlre>. (F) Unbackslashed parentheses must always be balanced in regular expressions. If you're a vi user, the % key is valuable for finding -the matching parenthesis. The <-- HERE shows in the regular expression -about where the problem was discovered. See L<perlre>. +the matching parenthesis. The <-- HERE shows whereabouts in the +regular expression the problem was discovered. See L<perlre>. =item Unmatched right %s bracket @@ -5211,7 +5218,7 @@ to run a compressed script, a binary program, or a directory as a Perl program. (W regexp) You used a backslash-character combination which is not recognized by Perl inside character classes. The character was understood literally, but this may change in a future version of Perl. -The <-- HERE shows in the regular expression about where the +The <-- HERE shows whereabouts in the regular expression the escape was discovered. =item Unrecognized escape \%c passed through @@ -5224,8 +5231,8 @@ change in a future version of Perl. (W regexp) You used a backslash-character combination which is not recognized by Perl. The character(s) were understood literally, but -this may change in a future version of Perl. The <-- HERE shows in -the regular expression about where the escape was discovered. +this may change in a future version of Perl. The <-- HERE shows +whereabouts in the regular expression the escape was discovered. =item Unrecognized signal name "%s" @@ -5369,8 +5376,8 @@ must be written as if ($string =~ /$pattern/) { ... } -The <-- HERE shows in the regular expression about -where the problem was discovered. See L<perlre>. +The <-- HERE shows whereabouts in the regular expression the problem was +discovered. See L<perlre>. =item Useless localization of %s @@ -5389,8 +5396,8 @@ must be written as if ($string =~ /$pattern/o) { ... } -The <-- HERE shows in the regular expression about -where the problem was discovered. See L<perlre>. +The <-- HERE shows whereabouts in the regular expression the problem was +discovered. See L<perlre>. =item Useless use of /d modifier in transliteration operator diff --git a/t/lib/croak/toke b/t/lib/croak/toke index acfab57..329e12c 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -28,6 +28,101 @@ EXPECT The lexical_subs feature is experimental at - line 2. Missing name in "state sub" at - line 2. ######## +# NAME Integer constant overloading returning undef +use overload; +BEGIN { overload::constant integer => sub {}; undef *^H } +1 +EXPECT +Constant(1) unknown at - line 3, at end of line +Execution of - aborted due to compilation errors. +######## +# NAME Float constant overloading returning undef +use overload; +BEGIN { overload::constant float => sub {}; undef *^H } +1.1 +EXPECT +Constant(1.1) unknown at - line 3, at end of line +Execution of - aborted due to compilation errors. +######## +# NAME Binary constant overloading returning undef +use overload; +BEGIN { overload::constant binary => sub {}; undef *^H } +0x1 +EXPECT +Constant(0x1) unknown at - line 3, at end of line +Execution of - aborted due to compilation errors. +######## +# NAME String constant overloading returning undef +use overload; +BEGIN { overload::constant q => sub {}; undef *^H } +'1', "1$_", tr"a"", s""a" +EXPECT +Constant(q) unknown at - line 3, near "'1'" +Constant(qq) unknown at - line 3, within string +Constant(tr) unknown at - line 3, within string +Constant(s) unknown at - line 3, within string +Execution of - aborted due to compilation errors. +######## +# NAME Regexp constant overloading when *^H is undefined +use overload; +BEGIN { overload::constant qr => sub {}; undef *^H } +/a/, m'a' +EXPECT +Constant(qq) unknown at - line 3, within pattern +Constant(q) unknown at - line 3, within pattern +Execution of - aborted due to compilation errors. +######## +# NAME \N{...} when charnames fails to load but without an error +BEGIN { ++$_ for @INC{"charnames.pm","_charnames.pm"} } +"\N{a}" +EXPECT +Constant(\N{a}) unknown at - line 2, within string +Execution of - aborted due to compilation errors. +######## +# NAME Integer constant overloading returning undef +use overload; +BEGIN { overload::constant integer => sub {} } +1 +EXPECT +Constant(1): Call to &{$^H{integer}} did not return a defined value at - line 3, at end of line +Execution of - aborted due to compilation errors. +######## +# NAME Float constant overloading returning undef +use overload; +BEGIN { overload::constant float => sub {} } +1.1 +EXPECT +Constant(1.1): Call to &{$^H{float}} did not return a defined value at - line 3, at end of line +Execution of - aborted due to compilation errors. +######## +# NAME Binary constant overloading returning undef +use overload; +BEGIN { overload::constant binary => sub {} } +0x1 +EXPECT +Constant(0x1): Call to &{$^H{binary}} did not return a defined value at - line 3, at end of line +Execution of - aborted due to compilation errors. +######## +# NAME String constant overloading returning undef +use overload; +BEGIN { overload::constant q => sub {} } +'1', "1$_", tr"a"", s""a" +EXPECT +Constant(q): Call to &{$^H{q}} did not return a defined value at - line 3, near "'1'" +Constant(qq): Call to &{$^H{q}} did not return a defined value at - line 3, within string +Constant(tr): Call to &{$^H{q}} did not return a defined value at - line 3, within string +Constant(s): Call to &{$^H{q}} did not return a defined value at - line 3, within string +Execution of - aborted due to compilation errors. +######## +# NAME Regexp constant overloading returning undef +use overload; +BEGIN { overload::constant qr => sub {} } +/a/, m'a' +EXPECT +Constant(qq): Call to &{$^H{qr}} did not return a defined value at - line 3, within pattern +Constant(q): Call to &{$^H{qr}} did not return a defined value at - line 3, within pattern +Execution of - aborted due to compilation errors. +######## # NAME Unterminated delimiter for here document <<"foo EXPECT diff --git a/t/op/lex.t b/t/op/lex.t index 0789077..c009f2d 100644 --- a/t/op/lex.t +++ b/t/op/lex.t @@ -4,7 +4,7 @@ use warnings; require './test.pl'; -plan(tests => 4); +plan(tests => 7); { no warnings 'deprecated'; @@ -45,3 +45,26 @@ curr_test(3); } +fresh_perl_is( + 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"} } "\N{a}"', + 'Constant(\N{a}) unknown at - line 1, within string' . "\n" + ."Execution of - aborted due to compilation errors.\n", + { stderr => 1 }, + 'correct output (and no crash) when charnames cannot load for \N{...}' +); +fresh_perl_is( + 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"}; + $^H{charnames} = "foo" } "\N{a}"', + "Undefined subroutine &main::foo called at - line 2.\n" + ."Propagated at - line 2, within string\n" + ."Execution of - aborted due to compilation errors.\n", + { stderr => 1 }, + 'no crash when charnames cannot load and %^H holds string' +); +fresh_perl_is( + 'BEGIN{ ++$_ for @INC{"charnames.pm","_charnames.pm"} } "\N{a}"', + 'Constant(\N{a}) unknown at - line 1, within string' . "\n" + ."Execution of - aborted due to compilation errors.\n", + { stderr => 1 }, + 'no crash when charnames cannot load and %^H holds string reference' +); diff --git a/t/op/svleak.t b/t/op/svleak.t index 75067b1..13c800f 100644 --- a/t/op/svleak.t +++ b/t/op/svleak.t @@ -15,7 +15,7 @@ BEGIN { use Config; -plan tests => 108; +plan tests => 111; # run some code N times. If the number of SVs at the end of loop N is # greater than (N-1)*delta at the end of loop 1, we've got a leak @@ -122,6 +122,19 @@ sub STORE { $_[0]->[$_[1]] = $_[2] } leak(5, 0, sub {local $a[0]}, "local \$tied[0]"); } +# Overloading +require overload; +eleak(2, 0, "BEGIN{overload::constant integer=>sub{}} 1,1,1,1,1,1,1,1,1,1", + '"too many errors" from constant overloading returning undef'); +# getting this one to leak was complicated; we have to unset LOCALIZE_HH: +eleak(2, 0, 'BEGIN{overload::constant integer=>sub{}; $^H &= ~ 0x00020000} + 1,1,1,1,1,1,1,1,1,1', + '"too many errors" from constant overloading with $^H sabotaged'); +eleak(2, 0, "BEGIN{overload::constant integer=>sub{}; undef %^H} + 1,1,1,1,1,1,1,1,1,1", + '"too many errors" from constant overloading with %^H undefined'); + + # [perl #74484] repeated tries leaked SVs on the tmps stack leak_expr(5, 0, q{"YYYYYa" =~ /.+?(a(.+?)|b)/ }, "trie leak"); @@ -271,18 +284,14 @@ eleak(2, 0, 'no warnings; 2 2;BEGIN{}', eleak(2, 0, "\"\$\0\356\"", 'qq containing $ <null> something'); eleak(2, 0, 'END OF TERMS AND CONDITIONS', 'END followed by words'); eleak(2, 0, "+ + +;qq|\\N{a}|"x10,'qq"\N{a}" after errors'); +eleak(2, 0, "qq|\\N{%}|", 'qq"\N{%}" (invalid charname)'); +eleak(2, 0, "qq|\\N{au}|;", 'qq"\N{invalid}"'); eleak(2, 0, "qq|\\c|;"x10, '"too many errors" from qq"\c"'); -$::TODO = 'still leaks'; -eleak(2, 0, "qq|\\N{%}|"x10, '"too many errors" from qq"\N{%}"'); -undef $::TODO; eleak(2, 0, "qq|\\o|;"x10, '"too many errors" from qq"\o"'); eleak(2, 0, "qq|\\x{|;"x10, '"too many errors" from qq"\x{"'); eleak(2, 0, "qq|\\N|;"x10, '"too many errors" from qq"\N"'); eleak(2, 0, "qq|\\N{|;"x10, '"too many errors" from qq"\N{"'); eleak(2, 0, "qq|\\N{U+GETG}|;"x10,'"too many errors" from qq"\N{U+JUNK}"'); -$::TODO = 'still leaks'; -eleak(2, 0, "qq|\\N{au}|;"x10, '"too many errors" from qq"\N{invalid}"'); -undef $::TODO; # [perl #114764] Attributes leak scalars diff --git a/toke.c b/toke.c index 86bb994..16f359e 100644 --- a/toke.c +++ b/toke.c @@ -2689,6 +2689,7 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) /* include the <}> */ e - backslash_ptr + 1); if (! SvPOK(res)) { + SvREFCNT_dec_NN(res); return NULL; } @@ -2697,9 +2698,8 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) * validation. */ table = GvHV(PL_hintgv); /* ^H */ cvp = hv_fetchs(table, "charnames", FALSE); - cv = *cvp; - if (((rv = SvRV(cv)) != NULL) - && ((stash = CvSTASH(rv)) != NULL)) + if (cvp && (cv = *cvp) && SvROK(cv) && ((rv = SvRV(cv)) != NULL) + && SvTYPE(rv) == SVt_PVCV && ((stash = CvSTASH(rv)) != NULL)) { const char * const name = HvNAME(stash); if strEQ(name, "_charnames") { @@ -9030,24 +9030,28 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, const char *why1 = "", *why2 = "", *why3 = ""; PERL_ARGS_ASSERT_NEW_CONSTANT; + /* We assume that this is true: */ + if (*key == 'c') { assert (strEQ(key, "charnames")); } + assert(type || s); /* charnames doesn't work well if there have been errors found */ - if (PL_error_count > 0 && strEQ(key,"charnames")) + if (PL_error_count > 0 && *key == 'c') { SvREFCNT_dec_NN(sv); return &PL_sv_undef; } + sv_2mortal(sv); /* Parent created it permanently */ if (!table || ! (PL_hints & HINT_LOCALIZE_HH) || ! (cvp = hv_fetch(table, key, keylen, FALSE)) || ! SvOK(*cvp)) { - SV *msg; + char *msg; /* Here haven't found what we're looking for. If it is charnames, * perhaps it needs to be loaded. Try doing that before giving up */ - if (strEQ(key,"charnames")) { + if (*key == 'c') { Perl_load_module(aTHX_ 0, newSVpvs("_charnames"), @@ -9069,33 +9073,32 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, } } if (!table || !(PL_hints & HINT_LOCALIZE_HH)) { - msg = Perl_newSVpvf(aTHX_ - "Constant(%s) unknown", (type ? type: "undef")); + msg = Perl_form(aTHX_ + "Constant(%.*s) unknown", + (int)(type ? typelen : len), + (type ? type: s)); } else { why1 = "$^H{"; why2 = key; why3 = "} is not defined"; report: - if (strEQ(key,"charnames")) { - yyerror_pv(Perl_form(aTHX_ + if (*key == 'c') { + msg = Perl_form(aTHX_ /* The +3 is for '\N{'; -4 for that, plus '}' */ "Unknown charname '%.*s'", (int)typelen - 4, type + 3 - ), - UTF ? SVf_UTF8 : 0); - return sv; + ); } else { - msg = Perl_newSVpvf(aTHX_ "Constant(%s): %s%s%s", - (type ? type: "undef"), why1, why2, why3); + msg = Perl_form(aTHX_ "Constant(%.*s): %s%s%s", + (int)(type ? typelen : len), + (type ? type: s), why1, why2, why3); } } - yyerror(SvPVX_const(msg)); - SvREFCNT_dec(msg); - return sv; + yyerror_pv(msg, UTF ? SVf_UTF8 : 0); + return SvREFCNT_inc_simple_NN(sv); } now_ok: - sv_2mortal(sv); /* Parent created it permanently */ cv = *cvp; if (!pv && s) pv = newSVpvn_flags(s, len, SVs_TEMP); @@ -9128,11 +9131,11 @@ now_ok: errstr = SvPV_const(errsv, errlen); yyerror_pvn(errstr, errlen, 0); /* Duplicates the message inside eval */ (void)POPs; - res = SvREFCNT_inc_simple(sv); + res = SvREFCNT_inc_simple_NN(sv); } else { res = POPs; - SvREFCNT_inc_simple_void(res); + SvREFCNT_inc_simple_void_NN(res); } PUTBACK ; @@ -9145,6 +9148,7 @@ now_ok: why2 = key; why3 = "}} did not return a defined value"; sv = res; + (void)sv_2mortal(sv); goto report; } -- Perl5 Master Repository
