[prev in list] [next in list] [prev in thread] [next in thread]
List: perl5-changes
Subject: [perl.git] branch smoke-me/nicholas/doublestar-minitrue, updated. v5.17.10-53-g2e3898d
From: "Nicholas Clark" <nick () ccl4 ! org>
Date: 2013-04-09 13:56:27
Message-ID: E1UPZ2B-00074x-DU () camel ! ams6 ! corp ! booking ! com
[Download RAW message or body]
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 <nick@ccl4.org>
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 <nick@ccl4.org>
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 <nick@ccl4.org>
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
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic