Make smartmatch, given & when experimental

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;

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

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 {

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.

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;

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

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 ;

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

regen/warnings.pl

@@ -91,6 +91,8 @@ BEGIN
                                     [ 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 @@ sub mkOct
 __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.

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.

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]};

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);

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

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]);
 }