summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dist/B-Deparse/t/deparse.t6
-rw-r--r--dist/Safe/t/safeops.t2
-rw-r--r--ext/XS-APItest/t/fetch_pad_names.t1
-rw-r--r--ext/XS-APItest/t/grok.t1
-rw-r--r--install_lib.pl2
-rw-r--r--lib/overload.t6
-rw-r--r--lib/warnings.pm17
-rw-r--r--pod/perldiag.pod24
-rw-r--r--regen/warnings.pl4
-rw-r--r--t/lib/croak/pp_ctl2
-rw-r--r--t/lib/feature/switch30
-rw-r--r--t/lib/warnings/9uninit2
-rw-r--r--t/lib/warnings/op2
-rw-r--r--t/op/coreamp.t2
-rw-r--r--t/op/smartmatch.t1
-rw-r--r--t/op/state.t1
-rw-r--r--t/op/switch.t1
-rw-r--r--t/op/taint.t4
-rw-r--r--t/op/tie_fetch_count.t5
-rw-r--r--t/run/switches.t4
-rw-r--r--toke.c9
-rw-r--r--warnings.h1
22 files changed, 92 insertions, 35 deletions
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index f26aa969d4..af5c574f2c 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -594,7 +594,7 @@ my $c = [];
my $d = \[];
####
# SKIP ?$] < 5.010 && "smartmatch and given/when not implemented on this Perl version"
-# CONTEXT use feature ':5.10';
+# CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch';
# implicit smartmatch in given/when
given ('foo') {
when ('bar') { continue; }
@@ -954,6 +954,7 @@ my @a;
$a[0] = 1;
####
# feature features without feature
+# CONTEXT no warnings 'experimental::smartmatch';
CORE::state $x;
CORE::say $x;
CORE::given ($x) {
@@ -969,6 +970,7 @@ CORE::evalbytes '';
() = CORE::fc $x;
####
# feature features when feature has been disabled by use VERSION
+# CONTEXT no warnings 'experimental::smartmatch';
use feature (sprintf(":%vd", $^V));
use 1;
CORE::state $x;
@@ -998,7 +1000,7 @@ CORE::evalbytes '';
() = CORE::__SUB__;
####
# (the above test with CONTEXT, and the output is equivalent but different)
-# CONTEXT use feature ':5.10';
+# CONTEXT use feature ':5.10'; no warnings 'experimental::smartmatch';
# feature features when feature has been disabled by use VERSION
use feature (sprintf(":%vd", $^V));
use 1;
diff --git a/dist/Safe/t/safeops.t b/dist/Safe/t/safeops.t
index 85dc945101..cc25bcb6bb 100644
--- a/dist/Safe/t/safeops.t
+++ b/dist/Safe/t/safeops.t
@@ -453,7 +453,7 @@ dor $x // $y
dorassign $x //= $y
once SKIP {use feature 'state'; state $foo = 42;}
say SKIP {use feature 'say'; say "foo";}
-smartmatch $x ~~ $y
+smartmatch no warnings 'experimental::smartmatch'; $x ~~ $y
aeach SKIP each @t
akeys SKIP keys @t
avalues SKIP values @t
diff --git a/ext/XS-APItest/t/fetch_pad_names.t b/ext/XS-APItest/t/fetch_pad_names.t
index 559bc3f79b..3d42280952 100644
--- a/ext/XS-APItest/t/fetch_pad_names.t
+++ b/ext/XS-APItest/t/fetch_pad_names.t
@@ -311,6 +311,7 @@ sub general_tests {
is grep( !Encode::is_utf8($_), @$names_av), $tests->{pad_size}{invariant}{cmp};
for my $var (@{$tests->{vars}}) {
+ no warnings 'experimental::smartmatch';
if ($var->{type} eq 'ok') {
ok $var->{name} ~~ $names_av, $var->{msg};
} else {
diff --git a/ext/XS-APItest/t/grok.t b/ext/XS-APItest/t/grok.t
index 2d2d192c7d..99fbc5d3da 100644
--- a/ext/XS-APItest/t/grok.t
+++ b/ext/XS-APItest/t/grok.t
@@ -5,6 +5,7 @@ use Test::More;
use Config;
use XS::APItest;
use feature 'switch';
+no warnings 'experimental::smartmatch';
use constant TRUTH => '0 but true';
# Tests for grok_number. Not yet comprehensive.
diff --git a/install_lib.pl b/install_lib.pl
index 8d37a0c7ff..ae8ba0a990 100644
--- a/install_lib.pl
+++ b/install_lib.pl
@@ -120,7 +120,7 @@ sub samepath {
my($dev1, $ino1, $dev2, $ino2);
($dev1, $ino1) = stat($p1);
($dev2, $ino2) = stat($p2);
- ($dev1 ~~ $dev2 && $ino1 ~~ $ino2);
+ ($dev1 == $dev2 && $ino1 == $ino2);
}
else {
1;
diff --git a/lib/overload.t b/lib/overload.t
index a90005db4d..74adae340e 100644
--- a/lib/overload.t
+++ b/lib/overload.t
@@ -1873,6 +1873,7 @@ foreach my $op (qw(<=> == != < <= > >=)) {
for my $sub (keys %subs) {
+ no warnings 'experimental::smartmatch';
my $term = $subs{$sub};
my $t = sprintf $term, '$_[0][0]';
my $e ="sub { \$funcs .= '($sub)'; my \$r; if (\$use_int) {"
@@ -1914,6 +1915,7 @@ foreach my $op (qw(<=> == != < <= > >=)) {
? "-\$_[0][0]"
: "$_[3](\$_[0][0])";
my $r;
+ no warnings 'experimental::smartmatch';
if ($use_int) {
use integer; $r = eval $e;
}
@@ -1960,7 +1962,7 @@ foreach my $op (qw(<=> == != < <= > >=)) {
$use_int = ($int ne '');
my $plain = $tainted_val;
my $plain_term = $int . sprintf $sub_term, '$plain';
- my $exp = eval $plain_term;
+ my $exp = do {no warnings 'experimental::smartmatch'; eval $plain_term };
diag("eval of plain_term <$plain_term> gave <$@>") if $@;
is(tainted($exp), $exp_taint,
"<$plain_term> taint of expected return");
@@ -1988,7 +1990,7 @@ foreach my $op (qw(<=> == != < <= > >=)) {
my $res_term = $int . sprintf $sub_term, $var;
my $desc = "<$res_term> $ov_pkg" ;
- my $res = eval $res_term;
+ my $res = do { no warnings 'experimental::smartmatch'; eval $res_term };
diag("eval of res_term $desc gave <$@>") if $@;
# uniquely, the inc/dec ops return the original
# ref rather than a copy, so stringify it to
diff --git a/lib/warnings.pm b/lib/warnings.pm
index c0c2cc945d..7d988cbd99 100644
--- a/lib/warnings.pm
+++ b/lib/warnings.pm
@@ -5,7 +5,7 @@
package warnings;
-our $VERSION = '1.17';
+our $VERSION = '1.18';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
@@ -232,10 +232,11 @@ our %Offsets = (
'experimental::lexical_subs'=> 104,
'experimental::lexical_topic'=> 106,
'experimental::regex_sets'=> 108,
+ 'experimental::smartmatch'=> 110,
);
our %Bits = (
- 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x15", # [0..54]
+ 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..55]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [30]
'closed' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -245,10 +246,11 @@ our %Bits = (
'digit' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00\x00\x00\x00\x00", # [31]
'exec' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x15", # [51..54]
+ 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x55", # [51..55]
'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [52]
'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04", # [53]
'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10", # [54]
+ 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40", # [55]
'glob' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [47]
'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [46]
@@ -293,7 +295,7 @@ our %Bits = (
);
our %DeadBits = (
- 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\x2a", # [0..54]
+ 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..55]
'ambiguous' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [29]
'bareword' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [30]
'closed' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [6]
@@ -303,10 +305,11 @@ our %DeadBits = (
'digit' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00\x00\x00\x00\x00", # [31]
'exec' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [7]
'exiting' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [3]
- 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x2a", # [51..54]
+ 'experimental' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xaa", # [51..55]
'experimental::lexical_subs'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [52]
'experimental::lexical_topic'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x08", # [53]
'experimental::regex_sets'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20", # [54]
+ 'experimental::smartmatch'=> "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80", # [55]
'glob' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00", # [4]
'illegalproto' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [47]
'imprecision' => "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [46]
@@ -351,8 +354,8 @@ our %DeadBits = (
);
$NONE = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
-$DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x15", # [2,52..54,4,22,23,25]
-$LAST_BIT = 110 ;
+$DEFAULT = "\x10\x01\x00\x00\x00\x50\x04\x00\x00\x00\x00\x00\x00\x55", # [2,52..55,4,22,23,25]
+$LAST_BIT = 112 ;
$BYTES = 14 ;
$All = "" ; vec($All, $Offsets{'all'}, 2) = 3 ;
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 17d13ceaaa..f7eb662a45 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -2074,6 +2074,13 @@ C<getpwnam> operator returned an invalid UIC.
forget to check the return value of your socket() call? See
L<perlfunc/getsockopt>.
+=item given is experimental
+
+(S experimental::smartmatch) C<given> depends on both a lexical C<$_> and
+smartmatch, both of which are experimental, so its behavior may change or
+even be removed in any future release of perl.
+See the explanation under L<perlsyn/Experimental Details on given and when>.
+
=item Global symbol "%s" requires explicit package name
(F) You've said "use strict" or "use strict vars", which indicates
@@ -4733,6 +4740,15 @@ a compilation error, but could not be found, so it was leaked instead.
it can reliably handle and C<sleep> probably slept for less time than
requested.
+=item Smartmatch is experimental
+
+(S experimental::smartmatch) This warning is emitted if you
+use the smartmatch (C<~~>) operator. This is currently an experimental
+feature, and its details are subject to change in future releases of
+Perl. Particularly, its current behavior is noticed for being
+unnecessarily complex and unintuitive, and is very likely to be
+overhauled.
+
=item Smart matching a non-overloaded object breaks encapsulation
(F) You should not use the C<~~> operator on an object that does not
@@ -6216,6 +6232,14 @@ but in actual fact, you got
So put in parentheses to say what you really mean.
+=item when is experimental
+
+(S experimental::smartmatch) C<when> depends on smartmatch, which is
+experimental. Additionally, it has several special cases that may
+not be immediately obvious, and their behavior may change or
+even be removed in any future release of perl.
+See the explanation under L<perlsyn/Experimental Details on given and when>.
+
=item Wide character in %s
(S utf8) Perl met a wide character (>255) when it wasn't expecting
diff --git a/regen/warnings.pl b/regen/warnings.pl
index 94a98436e8..dd3c49b79b 100644
--- a/regen/warnings.pl
+++ b/regen/warnings.pl
@@ -91,6 +91,8 @@ my $tree = {
[ 5.017, DEFAULT_ON ],
'experimental::lexical_topic' =>
[ 5.017, DEFAULT_ON ],
+ 'experimental::smartmatch' =>
+ [ 5.017, DEFAULT_ON ],
}],
#'default' => [ 5.008, DEFAULT_ON ],
@@ -441,7 +443,7 @@ read_only_bottom_close_and_rename($pm);
__END__
package warnings;
-our $VERSION = '1.17';
+our $VERSION = '1.18';
# Verify that we're called correctly so that warnings will work.
# see also strict.pm.
diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl
index b62b526646..ee1edbaffa 100644
--- a/t/lib/croak/pp_ctl
+++ b/t/lib/croak/pp_ctl
@@ -6,7 +6,7 @@ EXPECT
Can't find label foo at - line 2.
########
# NAME when outside given
-use 5.01;
+use 5.01; no warnings 'experimental::smartmatch';
when(undef){}
EXPECT
Can't "when" outside a topicalizer at - line 2.
diff --git a/t/lib/feature/switch b/t/lib/feature/switch
index 5da635b6d5..0dee7f51cf 100644
--- a/t/lib/feature/switch
+++ b/t/lib/feature/switch
@@ -3,28 +3,28 @@ Check the lexical scoping of the switch keywords.
__END__
# No switch; given should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
print STDOUT given;
EXPECT
Unquoted string "given" may clash with future reserved word at - line 3.
given
########
# No switch; when should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
print STDOUT when;
EXPECT
Unquoted string "when" may clash with future reserved word at - line 3.
when
########
# No switch; default should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
print STDOUT default;
EXPECT
Unquoted string "default" may clash with future reserved word at - line 3.
default
########
# No switch; break should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
print STDOUT break;
EXPECT
Unquoted string "break" may clash with future reserved word at - line 3.
@@ -36,19 +36,19 @@ EXPECT
Can't "continue" outside a when block at - line 2.
########
# Use switch; so given is a keyword
-use feature 'switch';
+use feature 'switch'; no warnings 'experimental::smartmatch';
given("okay\n") { print }
EXPECT
okay
########
# Use switch; so when is a keyword
-use feature 'switch';
+use feature 'switch'; no warnings 'experimental::smartmatch';
given(1) { when(1) { print "okay" } }
EXPECT
okay
########
# Use switch; so default is a keyword
-use feature 'switch';
+use feature 'switch'; no warnings 'experimental::smartmatch';
given(1) { default { print "okay" } }
EXPECT
okay
@@ -60,7 +60,7 @@ EXPECT
Can't "break" outside a given block at - line 3.
########
# switch out of scope; given should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
{ use feature 'switch';
given (1) {print "Okay here\n";}
}
@@ -71,7 +71,7 @@ Okay here
given
########
# switch out of scope; when should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
{ use feature 'switch';
given (1) { when(1) {print "Okay here\n";} }
}
@@ -82,7 +82,7 @@ Okay here
when
########
# switch out of scope; default should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
{ use feature 'switch';
given (1) { default {print "Okay here\n";} }
}
@@ -93,7 +93,7 @@ Okay here
default
########
# switch out of scope; break should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
{ use feature 'switch';
given (1) { break }
}
@@ -103,7 +103,7 @@ Unquoted string "break" may clash with future reserved word at - line 6.
break
########
# C<no feature 'switch'> should work
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
use feature 'switch';
given (1) { when(1) {print "Okay here\n";} }
no feature 'switch';
@@ -114,7 +114,7 @@ Okay here
when
########
# C<no feature> should work too
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
use feature 'switch';
given (1) { when(1) {print "Okay here\n";} }
no feature;
@@ -125,14 +125,14 @@ Okay here
when
########
# Without the feature, no 'Unambiguous use of' warning:
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
@break = ($break = "break");
print ${break}, ${break[0]};
EXPECT
breakbreak
########
# With the feature, we get an 'Unambiguous use of' warning:
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
use feature 'switch';
@break = ($break = "break");
print ${break}, ${break[0]};
diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index f74b7e3053..829e2de838 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -1957,7 +1957,7 @@ $v = 1 + prototype $fn;
EXPECT
Use of uninitialized value in addition (+) at - line 4.
########
-use warnings 'uninitialized';
+use warnings 'uninitialized'; no warnings 'experimental::smartmatch';
my $v;
my $fn = sub {};
$v = 1 + (1 ~~ $fn);
diff --git a/t/lib/warnings/op b/t/lib/warnings/op
index c5cbbc32a6..83d3705f56 100644
--- a/t/lib/warnings/op
+++ b/t/lib/warnings/op
@@ -168,7 +168,7 @@ Using an array as a reference is deprecated at - line 9.
Using an array as a reference is deprecated at - line 10.
########
# op.c
-use warnings 'void' ; close STDIN ;
+use warnings 'void' ; no warnings 'experimental::smartmatch'; close STDIN ;
#line 2
1 x 3 ; # OP_REPEAT (folded)
(1) x 3 ; # OP_REPEAT
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 9923df6663..c1f7181fe7 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -14,6 +14,8 @@ BEGIN {
$^P |= 0x100;
}
+no warnings 'experimental::smartmatch';
+
sub lis($$;$) {
&is(map(@$_ ? "[@{[map $_//'~~u~~', @$_]}]" : 'nought', @_[0,1]), $_[2]);
}
diff --git a/t/op/smartmatch.t b/t/op/smartmatch.t
index 79c9847fbf..ed4b3ec88d 100644
--- a/t/op/smartmatch.t
+++ b/t/op/smartmatch.t
@@ -8,6 +8,7 @@ BEGIN {
use strict;
use warnings;
no warnings 'uninitialized';
+no warnings 'experimental::smartmatch';
use Tie::Array;
use Tie::Hash;
diff --git a/t/op/state.t b/t/op/state.t
index 327ddf5192..ad51d8be67 100644
--- a/t/op/state.t
+++ b/t/op/state.t
@@ -312,6 +312,7 @@ foreach my $x (0 .. 4) {
#
my @spam = qw [spam ham bacon beans];
foreach my $spam (@spam) {
+ no warnings 'experimental::smartmatch';
given (state $spam = $spam) {
when ($spam [0]) {ok 1, "given"}
default {ok 0, "given"}
diff --git a/t/op/switch.t b/t/op/switch.t
index b81549127c..204a57a999 100644
--- a/t/op/switch.t
+++ b/t/op/switch.t
@@ -8,6 +8,7 @@ BEGIN {
use strict;
use warnings;
+no warnings 'experimental::smartmatch';
plan tests => 201;
diff --git a/t/op/taint.t b/t/op/taint.t
index f5b913b2dc..834e6642fa 100644
--- a/t/op/taint.t
+++ b/t/op/taint.t
@@ -2259,6 +2259,7 @@ end
{
# Taintedness of values returned from given()
use feature 'switch';
+ no warnings 'experimental::smartmatch';
my @descriptions = ('when', 'given end', 'default');
@@ -2294,8 +2295,11 @@ end
# Tainted values with smartmatch
# [perl #93590] S_do_smartmatch stealing its own string buffers
+{
+no warnings 'experimental::smartmatch';
ok "M$TAINT" ~~ ['m', 'M'], '$tainted ~~ ["whatever", "match"]';
ok !("M$TAINT" ~~ ['m', undef]), '$tainted ~~ ["whatever", undef]';
+}
# Tainted values and ref()
for(1,2) {
diff --git a/t/op/tie_fetch_count.t b/t/op/tie_fetch_count.t
index 6b2eb792e3..c3ed030cfd 100644
--- a/t/op/tie_fetch_count.t
+++ b/t/op/tie_fetch_count.t
@@ -151,7 +151,10 @@ $dummy = -e -e -e $var ; check_count '-e -e';
$_ = "foo";
$dummy = $var =~ m/ / ; check_count 'm//';
$dummy = $var =~ s/ //; check_count 's///';
-$dummy = $var ~~ 1 ; check_count '~~';
+{
+ no warnings 'experimental::smartmatch';
+ $dummy = $var ~~ 1 ; check_count '~~';
+}
$dummy = $var =~ y/ //; check_count 'y///';
$var = \1;
$dummy = $var =~y/ /-/; check_count '$ref =~ y///';
diff --git a/t/run/switches.t b/t/run/switches.t
index 52c0d95e3e..f1b923461d 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -404,12 +404,12 @@ is( $r, "Hello, world!\n", "-E say" );
$r = runperl(
- switches => [ '-E', '"undef ~~ undef and say q(Hello, world!)"']
+ switches => [ '-E', '"no warnings q{experimental::smartmatch}; undef ~~ undef and say q(Hello, world!)"']
);
is( $r, "Hello, world!\n", "-E ~~" );
$r = runperl(
- switches => [ '-E', '"given(undef) {when(undef) { say q(Hello, world!)"}}']
+ switches => [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}']
);
is( $r, "Hello, world!\n", "-E given" );
diff --git a/toke.c b/toke.c
index 35cd364192..275c95755b 100644
--- a/toke.c
+++ b/toke.c
@@ -5711,6 +5711,9 @@ Perl_yylex(pTHX)
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMPARE)
TOKEN(0);
s += 2;
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
+ "Smartmatch is experimental");
Eop(OP_SMARTMATCH);
}
s++;
@@ -7935,6 +7938,9 @@ Perl_yylex(pTHX)
case KEY_given:
pl_yylval.ival = CopLINE(PL_curcop);
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
+ "given is experimental");
OPERATOR(GIVEN);
case KEY_glob:
@@ -8791,6 +8797,9 @@ Perl_yylex(pTHX)
if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_NONEXPR)
return REPORT(0);
pl_yylval.ival = CopLINE(PL_curcop);
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__SMARTMATCH),
+ "when is experimental");
OPERATOR(WHEN);
case KEY_while:
diff --git a/warnings.h b/warnings.h
index d0bf7107e3..5c40d5c398 100644
--- a/warnings.h
+++ b/warnings.h
@@ -93,6 +93,7 @@
#define WARN_EXPERIMENTAL__LEXICAL_SUBS 52
#define WARN_EXPERIMENTAL__LEXICAL_TOPIC 53
#define WARN_EXPERIMENTAL__REGEX_SETS 54
+#define WARN_EXPERIMENTAL__SMARTMATCH 55
#define WARNsize 14
#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125\125\125"
View Lorry Controller Status