In perl.git, the branch smoke-me/nicholas/doublestar-minitrue has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/2e3898d16bcc4bbb379ec10dcacb2bf439afa7e3?hp=657d1e609c0896b75625a0275d2b5c978675cb04> - Log ----------------------------------------------------------------- commit 2e3898d16bcc4bbb379ec10dcacb2bf439afa7e3 Author: Nicholas Clark <[email protected]> Date: Tue Apr 9 15:54:25 2013 +0200 Add a deprecation warning when parsing @*, %*, &* and **. Forms such as @{*}, @{"*"} are not deprecated, nor are runtime references to the variables, such as symbolic references or symbol table manipulation. M embed.fnc M embed.h M pod/perldiag.pod M proto.h M t/lib/warnings/gv M toke.c commit 67de9eea8942d6ccebde223ac91854323ff60ebf Author: Nicholas Clark <[email protected]> Date: Mon Apr 8 17:05:11 2013 +0200 Revert "Change the warning for $* to add ", and will become a syntax error"." This reverts commit 53213d38f22e9356f489162e494d2ffa46ec2ca2. Conflicts: pod/perldelta.pod M gv.c M pod/perldiag.pod M t/lib/warnings/2use M t/lib/warnings/gv commit 489957e75a8715be7d2ddf78e1bea2108c917179 Author: Nicholas Clark <[email protected]> Date: Mon Apr 8 16:53:47 2013 +0200 Revert "Add a deprecation warning for all uses of @*, %*, &* and **." This reverts commit 982110e06e40aad7a538cb788327cca8aaabce22. Conflicts: pod/perldelta.pod M dist/B-Deparse/t/deparse.t M gv.c M pod/perldiag.pod M t/lib/warnings/gv ----------------------------------------------------------------------- Summary of changes: dist/B-Deparse/t/deparse.t | 7 +------ embed.fnc | 2 +- embed.h | 2 +- gv.c | 35 +++++++---------------------------- pod/perldiag.pod | 14 +++++--------- proto.h | 2 +- t/lib/warnings/2use | 4 ++-- t/lib/warnings/gv | 30 +++++++++++++++++++++++------- t/lib/warnings/toke | 15 +++++++++++++++ toke.c | 42 +++++++++++++++++++++++++++++++++--------- 10 files changed, 89 insertions(+), 64 deletions(-) diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index af5c574..929f926 100644 --- a/dist/B-Deparse/t/deparse.t +++ b/dist/B-Deparse/t/deparse.t @@ -1055,16 +1055,11 @@ print $_; #### # $#- $#+ $#{%} etc. my @x; -@x = ($#{`}, $#{~}, $#{!}, $#{@}, $#{$}, $#{%}, $#{^}, $#{&}); +@x = ($#{`}, $#{~}, $#{!}, $#{@}, $#{$}, $#{%}, $#{^}, $#{&}, $#{*}); @x = ($#{(}, $#{)}, $#{[}, $#{{}, $#{]}, $#{}}, $#{'}, $#{"}, $#{,}); @x = ($#{<}, $#{.}, $#{>}, $#{/}, $#{?}, $#{=}, $#+, $#{\}, $#{|}, $#-); @x = ($#{;}, $#{:}); #### -# $#{*} -# It's a known TODO that warnings are deparsed as bits, not textually. -no warnings; -() = $#{*}; -#### # ${#} interpolated # It's a known TODO that warnings are deparsed as bits, not textually. no warnings; diff --git a/embed.fnc b/embed.fnc index ecdde73..9e34ccf 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2199,7 +2199,7 @@ iR |SV* |get_and_check_backslash_N_name|NN const char* s \ sR |char* |scan_formline |NN char *s sR |char* |scan_heredoc |NN char *s s |char* |scan_ident |NN char *s|NN const char *send|NN char *dest \ - |STRLEN destlen|I32 ck_uni + |STRLEN destlen|I32 ck_uni|char warn_on_star sR |char* |scan_inputsymbol|NN char *start sR |char* |scan_pat |NN char *start|I32 type sR |char* |scan_str |NN char *start|int keep_quoted \ diff --git a/embed.h b/embed.h index 96309b2..a4e943e 100644 --- a/embed.h +++ b/embed.h @@ -1615,7 +1615,7 @@ #define scan_const(a) S_scan_const(aTHX_ a) #define scan_formline(a) S_scan_formline(aTHX_ a) #define scan_heredoc(a) S_scan_heredoc(aTHX_ a) -#define scan_ident(a,b,c,d,e) S_scan_ident(aTHX_ a,b,c,d,e) +#define scan_ident(a,b,c,d,e,f) S_scan_ident(aTHX_ a,b,c,d,e,f) #define scan_inputsymbol(a) S_scan_inputsymbol(aTHX_ a) #define scan_pat(a,b) S_scan_pat(aTHX_ a,b) #define scan_str(a,b,c,d,e) S_scan_str(aTHX_ a,b,c,d,e) diff --git a/gv.c b/gv.c index d96bde8..143323d 100644 --- a/gv.c +++ b/gv.c @@ -1638,23 +1638,13 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1); else if (*name == '-' || *name == '+') require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0); - } else if (sv_type == SVt_PV && *name == '#') { - Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, - WARN_SYNTAX), - "$# is no longer supported"); - } - if (*name == '*') { - if (sv_type == SVt_PV) + } else if (sv_type == SVt_PV) { + if (*name == '*' || *name == '#') { + /* diag_listed_as: $* is no longer supported */ Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "$* is no longer supported, and will become a syntax error"); - else - Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "%c* is deprecated, and will become a syntax error", - sv_type == SVt_PVAV ? '@' - : sv_type == SVt_PVCV ? '&' - : sv_type == SVt_PVHV ? '%' - : '*'); + "$%c is no longer supported", *name); + } } if (sv_type==SVt_PV || sv_type==SVt_PVGV) { switch (*name) { @@ -1944,22 +1934,11 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, break; } case '*': /* $* */ - if (sv_type == SVt_PV) - Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "$* is no longer supported, and will become a syntax error"); - else { - Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "%c* is deprecated, and will become a syntax error", - sv_type == SVt_PVAV ? '@' - : sv_type == SVt_PVCV ? '&' - : sv_type == SVt_PVHV ? '%' - : '*'); - } - break; case '#': /* $# */ if (sv_type == SVt_PV) + /* diag_listed_as: $* is no longer supported */ Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "$# is no longer supported"); + "$%c is no longer supported", *name); break; case '\010': /* $^H */ { diff --git a/pod/perldiag.pod b/pod/perldiag.pod index f7eb662..cdf9e0d 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2609,16 +2609,12 @@ with 'useperlio'. (F) Your machine doesn't implement the sockatmark() functionality, neither as a system call nor an ioctl call (SIOCATMARK). -=item $* is no longer supported, and will become a syntax error +=item $* is no longer supported -(D deprecated, syntax) The special variable C<$*>, which has had no -effect since v5.10.0, will be removed soon. Currently code which mentions -this variable compiles with this warning, but the variable is no longer -magical, hence reads and writes have no side effects. In future such code -will fail to compile with a syntax error. - -Prior to v5.10.0 the use of C<$*> enabled or disabled multi-line matching -within a string. +(D deprecated, syntax) The special variable C<$*>, deprecated in older +perls, has been removed as of 5.9.0 and is no longer supported. In +previous versions of perl the use of C<$*> enabled or disabled multi-line +matching within a string. Instead of using C<$*> you should use the C</m> (and maybe C</s>) regexp modifiers. You can enable C</m> for a lexical scope (even a whole file) diff --git a/proto.h b/proto.h index 59ecbc6..0795918 100644 --- a/proto.h +++ b/proto.h @@ -7300,7 +7300,7 @@ STATIC char* S_scan_heredoc(pTHX_ char *s) #define PERL_ARGS_ASSERT_SCAN_HEREDOC \ assert(s) -STATIC char* S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck_uni) +STATIC char* S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck_uni, char warn_on_star) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); diff --git a/t/lib/warnings/2use b/t/lib/warnings/2use index 6c7f56f..c0d203a 100644 --- a/t/lib/warnings/2use +++ b/t/lib/warnings/2use @@ -365,7 +365,7 @@ $*; use warnings "void"; $#; EXPECT -$* is no longer supported, and will become a syntax error at - line 3. +$* is no longer supported at - line 3. $# is no longer supported at - line 5. Useless use of a variable in void context at - line 5. ######## @@ -375,5 +375,5 @@ $*; no warnings "void"; $#; EXPECT -$* is no longer supported, and will become a syntax error at - line 3. +$* is no longer supported at - line 3. $# is no longer supported at - line 5. diff --git a/t/lib/warnings/gv b/t/lib/warnings/gv index 332810c..c28dfae 100644 --- a/t/lib/warnings/gv +++ b/t/lib/warnings/gv @@ -60,7 +60,7 @@ $a = ${"#"}; $a = ${"*"}; EXPECT $# is no longer supported at - line 2. -$* is no longer supported, and will become a syntax error at - line 3. +$* is no longer supported at - line 3. ######## # gv.c $a = ${#}; @@ -70,7 +70,7 @@ $a = ${#}; $a = ${*}; EXPECT $# is no longer supported at - line 2. -$* is no longer supported, and will become a syntax error at - line 3. +$* is no longer supported at - line 3. ######## # gv.c $a = $#; @@ -88,11 +88,11 @@ $a = \$#; $a = \$*; EXPECT $# is no longer supported at - line 2. -$* is no longer supported, and will become a syntax error at - line 3. +$* is no longer supported at - line 3. $# is no longer supported at - line 4. -$* is no longer supported, and will become a syntax error at - line 5. +$* is no longer supported at - line 5. $# is no longer supported at - line 6. -$* is no longer supported, and will become a syntax error at - line 7. +$* is no longer supported at - line 7. ######## # gv.c @a = @#; @@ -102,7 +102,7 @@ $a = $*; EXPECT @* is deprecated, and will become a syntax error at - line 3. $# is no longer supported at - line 4. -$* is no longer supported, and will become a syntax error at - line 5. +$* is no longer supported at - line 5. ######## # gv.c $a = $#; @@ -111,7 +111,7 @@ $a = $*; @a = @*; EXPECT $# is no longer supported at - line 2. -$* is no longer supported, and will become a syntax error at - line 3. +$* is no longer supported at - line 3. @* is deprecated, and will become a syntax error at - line 5. ######## # gv.c @@ -131,6 +131,22 @@ EXPECT %* is deprecated, and will become a syntax error at - line 5. ######## # gv.c +# None of these should warn: +$a = \@{*}; +$a = \&{*}; +$a = \*{*}; +$a = \%{*}; +$a = \@{"*"}; +$a = \&{"*"}; +$a = \*{"*"}; +$a = \%{"*"}; +$_ = "*"; +$a = \@$_; +$a = \&$_; +$a = \*$_; +$a = \%$_; +######## +# gv.c use warnings 'syntax' ; use utf8; use open qw( :utf8 :std ); diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 5ee3ad5..df2a0b4 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -425,10 +425,25 @@ EXPECT # toke.c use warnings 'ambiguous' ; $a = ${time} ; +$a = @{time} ; +$a = $#{time} ; # This one is special cased in toke.c +$a = %{time} ; +$a = *{time} ; +$a = defined &{time} ; # To avoid calling &::time no warnings 'ambiguous' ; $a = ${time} ; +$a = @{time} ; +$a = $#{time} ; # This one is special cased in toke.c +$a = %{time} ; +$a = *{time} ; +$a = defined &{time} ; # To avoid calling &::time EXPECT Ambiguous use of ${time} resolved to $time at - line 3. +Ambiguous use of @{time} resolved to @time at - line 4. +Ambiguous use of @{time} resolved to @time at - line 5. +Ambiguous use of %{time} resolved to %time at - line 6. +Ambiguous use of *{time} resolved to *time at - line 7. +Ambiguous use of &{time} resolved to &time at - line 8. ######## # toke.c use warnings 'ambiguous' ; diff --git a/toke.c b/toke.c index 275c957..bcf71db 100644 --- a/toke.c +++ b/toke.c @@ -3864,7 +3864,7 @@ S_intuit_more(pTHX_ char *s) weight -= seen[un_char] * 10; if (isWORDCHAR_lazy_if(s+1,UTF)) { int len; - scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE); + scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE, 0); len = (int)strlen(tmpbuf); if (len > 1 && gv_fetchpvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0, SVt_PV)) @@ -5647,7 +5647,7 @@ Perl_yylex(pTHX) case '*': if (PL_expect != XOPERATOR) { - s = scan_ident(s, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE); + s = scan_ident(s, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, '*'); PL_expect = XOPERATOR; force_ident(PL_tokenbuf, '*'); if (!*PL_tokenbuf) @@ -5681,7 +5681,7 @@ Perl_yylex(pTHX) } PL_tokenbuf[0] = '%'; s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, - sizeof PL_tokenbuf - 1, FALSE); + sizeof PL_tokenbuf - 1, FALSE, '%'); if (!PL_tokenbuf[1]) { PREREF('%'); } @@ -6175,7 +6175,7 @@ Perl_yylex(pTHX) PL_tokenbuf[0] = '&'; s = scan_ident(s - 1, PL_bufend, PL_tokenbuf + 1, - sizeof PL_tokenbuf - 1, TRUE); + sizeof PL_tokenbuf - 1, TRUE, '&'); if (PL_tokenbuf[1]) { PL_expect = XOPERATOR; force_ident_maybe_lex('&'); @@ -6408,7 +6408,7 @@ Perl_yylex(pTHX) if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-@", s[2]))) { PL_tokenbuf[0] = '@'; s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1, - sizeof PL_tokenbuf - 1, FALSE); + sizeof PL_tokenbuf - 1, FALSE, 0); if (PL_expect == XOPERATOR) no_op("Array length", s); if (!PL_tokenbuf[1]) @@ -6420,7 +6420,7 @@ Perl_yylex(pTHX) PL_tokenbuf[0] = '$'; s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, - sizeof PL_tokenbuf - 1, FALSE); + sizeof PL_tokenbuf - 1, FALSE, 0); if (PL_expect == XOPERATOR) no_op("Scalar", s); if (!PL_tokenbuf[1]) { @@ -6539,7 +6539,7 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) no_op("Array", s); PL_tokenbuf[0] = '@'; - s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); + s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE, '@'); if (!PL_tokenbuf[1]) { PREREF('@'); } @@ -7808,7 +7808,7 @@ Perl_yylex(pTHX) p = PEEKSPACE(p); if (isIDFIRST_lazy_if(p,UTF)) { p = scan_ident(p, PL_bufend, - PL_tokenbuf, sizeof PL_tokenbuf, TRUE); + PL_tokenbuf, sizeof PL_tokenbuf, TRUE, 0); p = PEEKSPACE(p); } if (*p != '$') @@ -9259,7 +9259,8 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN } STATIC char * -S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck_uni) +S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, + I32 ck_uni, char warn_on_star) { dVAR; char *bracket = NULL; @@ -9285,6 +9286,8 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck *d = '\0'; d = dest; if (*d) { + /* Either a digit variable, or parse_ident() found an identifier + (anything valid as a bareword), so job done and return. */ if (PL_lex_state != LEX_NORMAL) PL_lex_state = LEX_INTERPENDMAYBE; return s; @@ -9296,8 +9299,12 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck || s[1] == '{' || strnEQ(s+1,"::",2)) ) { + /* Dereferencing a value in a scalar variable. + The alternatives are different syntaxes for a scalar variable. + Using ' as a leading package separator isn't allowed. :: is. */ return s; } + /* Handle the opening { of @{...}, &{...}, *{...}, %{...}, ${...} */ if (*s == '{') { bracket = s; s++; @@ -9312,6 +9319,10 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck if (s < send && (isIDFIRST_lazy_if(s, is_utf8) || VALID_LEN_ONE_IDENT(s, is_utf8))) { + if (warn_on_star && !bracket && *s == '*') + Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), + "%c* is deprecated, and will become a syntax error", + warn_on_star); if (is_utf8) { const STRLEN skip = UTF8SKIP(s); STRLEN i; @@ -9324,20 +9335,29 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck d[1] = '\0'; } } + /* Convert $^F, ${^F} and the ^F of ${^FOO} to control characters */ if (*d == '^' && *s && isCONTROLVAR(*s)) { *d = toCTRL(*s); s++; } + /* Warn about ambiguous code after unary operators if {...} notation isn't + used. There's no difference in ambiguity; it's merely a heuristic + about when not to warn. */ else if (ck_uni && !bracket) check_uni(); if (bracket) { + /* If we were processing {...} notation then... */ if (isIDFIRST_lazy_if(d,is_utf8)) { + /* if it starts as a valid identifier, assume that it is one. + (the later check for } being at the expected point will trap + cases where this doesn't pan out.) */ d += is_utf8 ? UTF8SKIP(d) : 1; parse_ident(&s, &d, e, 1, is_utf8); *d = '\0'; while (s < send && SPACE_OR_TAB(*s)) s++; if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { + /* ${foo[0]} and ${foo{bar}} notation. */ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest, 0)) { const char * const brack = (const char *) @@ -9370,6 +9390,8 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck while (s < send && SPACE_OR_TAB(*s)) s++; + /* Expect to find a closing } after consuming any trailing whitespace. + */ if (*s == '}') { s++; if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) { @@ -9392,6 +9414,8 @@ S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck } } else { + /* Didn't find the closing } at the point we expected, so restore + state such that the next thing to process is the opening { and */ s = bracket; /* let the parser handle it */ *dest = '\0'; } -- Perl5 Master Repository
