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; }
$a[0] = 1;
####
# feature features without feature
+# CONTEXT no warnings 'experimental::smartmatch';
CORE::state $x;
CORE::say $x;
CORE::given ($x) {
() = 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;
() = 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;
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
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 {
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.
my($dev1, $ino1, $dev2, $ino2);
($dev1, $ino1) = stat($p1);
($dev2, $ino2) = stat($p2);
- ($dev1 ~~ $dev2 && $ino1 ~~ $ino2);
+ ($dev1 == $dev2 && $ino1 == $ino2);
}
else {
1;
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) {"
? "-\$_[0][0]"
: "$_[3](\$_[0][0])";
my $r;
+ no warnings 'experimental::smartmatch';
if ($use_int) {
use integer; $r = eval $e;
}
$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");
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
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.
'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]
'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]
);
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]
'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]
);
$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 ;
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
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
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
[ 5.017, DEFAULT_ON ],
'experimental::lexical_topic' =>
[ 5.017, DEFAULT_ON ],
+ 'experimental::smartmatch' =>
+ [ 5.017, DEFAULT_ON ],
}],
#'default' => [ 5.008, DEFAULT_ON ],
__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.
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.
__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.
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
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";}
}
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";} }
}
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";} }
}
default
########
# switch out of scope; break should be a bareword.
-use warnings;
+use warnings; no warnings 'experimental::smartmatch';
{ use feature 'switch';
given (1) { break }
}
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';
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;
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]};
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);
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
$^P |= 0x100;
}
+no warnings 'experimental::smartmatch';
+
sub lis($$;$) {
&is(map(@$_ ? "[@{[map $_//'~~u~~', @$_]}]" : 'nought', @_[0,1]), $_[2]);
}
use strict;
use warnings;
no warnings 'uninitialized';
+no warnings 'experimental::smartmatch';
use Tie::Array;
use Tie::Hash;
#
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"}
use strict;
use warnings;
+no warnings 'experimental::smartmatch';
plan tests => 201;
{
# Taintedness of values returned from given()
use feature 'switch';
+ no warnings 'experimental::smartmatch';
my @descriptions = ('when', 'given end', 'default');
# 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) {
$_ = "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///';
$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" );
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++;
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:
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:
#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"