Make smartmatch, given & when experimental

diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index f26aa96..af5c574 100644 (file)
--- 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 85dc945..cc25bcb 100644 (file)
--- 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 559bc3f..3d42280 100644 (file)
--- 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 2d2d192..99fbc5d 100644 (file)
--- 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 8d37a0c..ae8ba0a 100644 (file)
--- 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 a90005d..74adae3 100644 (file)
--- 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 c0c2cc9..7d988cb 100644 (file)
--- 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 17d13ce..f7eb662 100644 (file)
--- 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 94a9843..dd3c49b 100644 (file)
--- 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 b62b526..ee1edba 100644 (file)
--- 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 5da635b..0dee7f5 100644 (file)
--- 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 f74b7e3..829e2de 100644 (file)
--- 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 c5cbbc3..83d3705 100644 (file)
--- 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 9923df6..c1f7181 100644 (file)
--- 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 79c9847..ed4b3ec 100644 (file)
--- 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 327ddf5..ad51d8b 100644 (file)
--- 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 b815491..204a57a 100644 (file)
--- 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 f5b913b..834e664 100644 (file)
--- 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 6b2eb79..c3ed030 100644 (file)
--- 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 52c0d95..f1b9234 100644 (file)
--- 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 35cd364..275c957 100644 (file)
--- 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 d0bf710..5c40d5c 100644 (file)
--- 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"