In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/3f5e3f2f07f57709accec3bfe9c57bc97f48246c?hp=3c3ecf18c35ad7832c6e454d304b30b2c0fef127>
- Log ----------------------------------------------------------------- commit 3f5e3f2f07f57709accec3bfe9c57bc97f48246c Author: Brian Fraser <[email protected]> Date: Mon Mar 25 01:46:43 2013 -0300 Silence "smartmatch is experimental" warnings in autodie M cpan/autodie/lib/Fatal.pm M cpan/autodie/t/exceptions.t commit 33392251fee232767152e17ae40256271d793131 Author: Brian Fraser <[email protected]> Date: Mon Mar 25 21:17:51 2013 -0300 perldelta for the new warnings M pod/perldelta.pod commit 0f539b13d39feb3bad9b2c86a57dea5035124802 Author: Brian Fraser <[email protected]> Date: Mon Mar 25 01:22:35 2013 -0300 Make smartmatch, given & when experimental M dist/B-Deparse/t/deparse.t M dist/Safe/t/safeops.t M ext/XS-APItest/t/fetch_pad_names.t M ext/XS-APItest/t/grok.t M install_lib.pl M lib/overload.t M lib/warnings.pm M pod/perldiag.pod M regen/warnings.pl M t/lib/croak/pp_ctl M t/lib/feature/switch M t/lib/warnings/9uninit M t/lib/warnings/op M t/op/coreamp.t M t/op/smartmatch.t M t/op/state.t M t/op/switch.t M t/op/taint.t M t/op/tie_fetch_count.t M t/run/switches.t M toke.c M warnings.h commit 629deb5825bff527bfd3021146f63d64c72b50ce Author: Brian Fraser <[email protected]> Date: Mon Mar 25 02:10:08 2013 -0300 t/porting/dual-life.t: Drop dependency on smartmatch M t/porting/dual-life.t commit 8d4c8383e764c1ca32cd8cc7a166eb032be926ed Author: Brian Fraser <[email protected]> Date: Sat Mar 23 17:45:10 2013 -0300 t/re/regexp_unicode_prop.t: Drop dependency on given/when M t/re/regexp_unicode_prop.t commit 44ac36ff996782b807ffe693b62e66e436f5a91f Author: Brian Fraser <[email protected]> Date: Sat Mar 23 17:42:34 2013 -0300 Porting/core-cpan-diff: Drop dependency on smartmatch M Porting/core-cpan-diff commit df711a6015fca36881af2e0c4c5fc3eb58221863 Author: Brian Fraser <[email protected]> Date: Sat Mar 23 17:42:00 2013 -0300 Porting/checkpodencoding.pl: Drop dependency on smartmatch M Porting/checkpodencoding.pl commit 44bda1357563f00c4856ad314c8cde43bba62433 Author: Brian Fraser <[email protected]> Date: Sat Mar 23 17:40:54 2013 -0300 File::Glob: Drop dependency on given/when M ext/File-Glob/Glob.pm ----------------------------------------------------------------------- Summary of changes: Porting/checkpodencoding.pl | 10 +++++----- Porting/core-cpan-diff | 9 ++++++--- cpan/autodie/lib/Fatal.pm | 1 + cpan/autodie/t/exceptions.t | 1 + dist/B-Deparse/t/deparse.t | 6 ++++-- dist/Safe/t/safeops.t | 2 +- ext/File-Glob/Glob.pm | 34 +++++++++++++++++++--------------- ext/XS-APItest/t/fetch_pad_names.t | 1 + ext/XS-APItest/t/grok.t | 1 + install_lib.pl | 2 +- lib/overload.t | 6 ++++-- lib/warnings.pm | 17 ++++++++++------- pod/perldelta.pod | 10 +++++++++- pod/perldiag.pod | 24 ++++++++++++++++++++++++ regen/warnings.pl | 4 +++- t/lib/croak/pp_ctl | 2 +- t/lib/feature/switch | 30 +++++++++++++++--------------- t/lib/warnings/9uninit | 2 +- t/lib/warnings/op | 2 +- t/op/coreamp.t | 2 ++ t/op/smartmatch.t | 1 + t/op/state.t | 1 + t/op/switch.t | 1 + t/op/taint.t | 4 ++++ t/op/tie_fetch_count.t | 5 ++++- t/porting/dual-life.t | 2 +- t/re/regexp_unicode_prop.t | 24 +++++++++++------------- t/run/switches.t | 4 ++-- toke.c | 9 +++++++++ warnings.h | 1 + 30 files changed, 145 insertions(+), 73 deletions(-) diff --git a/Porting/checkpodencoding.pl b/Porting/checkpodencoding.pl index a2d12df..a936368 100755 --- a/Porting/checkpodencoding.pl +++ b/Porting/checkpodencoding.pl @@ -30,21 +30,21 @@ sub finder { next if # Test cases - $file ~~ m[Pod-Simple/t]; + $file =~ m[Pod-Simple/t]; my ($in_pod, $has_encoding, @non_ascii); FILE: while (my $line = <$fh>) { chomp $line; - if ($line ~~ /^=[a-z]+/) { + if ($line =~ /^=[a-z]+/) { $in_pod = 1; } if ($in_pod) { - if ($line ~~ /^=encoding (\S+)/) { + if ($line =~ /^=encoding (\S+)/) { $has_encoding = 1; last FILE; - } elsif ($line ~~ /[^[:ascii:]]/) { + } elsif ($line =~ /[^[:ascii:]]/) { my $encoding = guess_encoding($line); push @non_ascii => { num => $., @@ -54,7 +54,7 @@ sub finder { } } - if ($line ~~ /^=cut/) { + if ($line =~ /^=cut/) { $in_pod = 0; } } diff --git a/Porting/core-cpan-diff b/Porting/core-cpan-diff index 8483e18..60a27d1 100644 --- a/Porting/core-cpan-diff +++ b/Porting/core-cpan-diff @@ -226,6 +226,7 @@ sub do_compare { } my %ignorable = map { ( $_ => 1 ) } @Maintainers::IGNORABLE; + my %wanted_upstream = map { ( $_ => 1 ) } @$wanted_upstreams; my %seen_dist; for my $module (@$modules) { @@ -247,7 +248,7 @@ sub do_compare { } my $upstream = $m->{UPSTREAM}; - next if @$wanted_upstreams and !( $upstream ~~ $wanted_upstreams ); + next if @$wanted_upstreams and !$wanted_upstream{$upstream}; print $outfh "\n$module - " . $Maintainers::Modules{$module}->{DISTRIBUTION} . "\n"; @@ -477,6 +478,7 @@ sub do_crosscheck { $distros{ distro_base($short_distro) }{$distro} = 1; } + my %wanted_upstream = map { ( $_ => 1 ) } @$wanted_upstreams; for my $module (@$modules) { my $m = $Maintainers::Modules{$module} or die "ERROR: No such module in Maintainers.pl: '$module'\n"; @@ -495,7 +497,7 @@ sub do_crosscheck { die "ERROR: $module has no DISTRIBUTION entry\n" unless defined $pdist; my $upstream = $m->{UPSTREAM}; - next if @$wanted_upstreams and !( $upstream ~~ $wanted_upstreams ); + next if @$wanted_upstreams and !$wanted_upstream{$upstream}; my $cdist = $modules{$module}; ( my $short_pdist = $pdist ) =~ s{^.*/}{}; @@ -578,8 +580,9 @@ sub get_map { sub cpan_to_perl { my ( $excluded, $map, $customized, $cpan_file ) = @_; + my %customized = map { ( $_ => 1 ) } @$customized; for my $exclude (@$excluded) { - next if $exclude ~~ $customized; + next if $customized{$exclude}; # may be a simple string to match exactly, or a pattern if ( ref $exclude ) { diff --git a/cpan/autodie/lib/Fatal.pm b/cpan/autodie/lib/Fatal.pm index ce17af9..c6a3d1b 100644 --- a/cpan/autodie/lib/Fatal.pm +++ b/cpan/autodie/lib/Fatal.pm @@ -859,6 +859,7 @@ sub _one_invocation { my $code = qq[ no warnings qw(unopened uninitialized numeric); + no if \$\] >= 5.017011, warnings => "experimental::smartmatch"; if (wantarray) { my \@results = $call(@argv); diff --git a/cpan/autodie/t/exceptions.t b/cpan/autodie/t/exceptions.t index 2f8c238..123cf8e 100644 --- a/cpan/autodie/t/exceptions.t +++ b/cpan/autodie/t/exceptions.t @@ -9,6 +9,7 @@ BEGIN { plan skip_all => "Perl 5.10 only tests" if $] < 5.010; } use 5.010; use constant NO_SUCH_FILE => 'this_file_had_better_not_exist_xyzzy'; +no if $] >= 5.017011, warnings => "experimental::smartmatch"; plan 'no_plan'; diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t index f26aa96..af5c574 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 85dc945..cc25bcb 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/File-Glob/Glob.pm b/ext/File-Glob/Glob.pm index a9c5a97..379d7f0 100644 --- a/ext/File-Glob/Glob.pm +++ b/ext/File-Glob/Glob.pm @@ -4,7 +4,6 @@ use strict; our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, $DEFAULT_FLAGS); require XSLoader; -use feature 'switch'; @ISA = qw(Exporter); @@ -38,26 +37,31 @@ pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob" @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.19'; +$VERSION = '1.20'; sub import { require Exporter; local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; Exporter::import(grep { - my $passthrough; - given ($_) { - $DEFAULT_FLAGS &= ~GLOB_NOCASE() when ':case'; - $DEFAULT_FLAGS |= GLOB_NOCASE() when ':nocase'; - when (':globally') { - no warnings 'redefine'; - *CORE::GLOBAL::glob = \&File::Glob::csh_glob; - } - if ($_ eq ':bsd_glob') { - no strict; *{caller."::glob"} = \&bsd_glob_override; - } - $passthrough = 1; + my $passthrough; + if ($_ eq ':case') { + $DEFAULT_FLAGS &= ~GLOB_NOCASE() + } + elsif ($_ eq ':nocase') { + $DEFAULT_FLAGS |= GLOB_NOCASE(); + } + elsif ($_ eq ':globally') { + no warnings 'redefine'; + *CORE::GLOBAL::glob = \&File::Glob::csh_glob; } - $passthrough; + elsif ($_ eq ':bsd_glob') { + no strict; *{caller."::glob"} = \&bsd_glob_override; + $passthrough = 1; + } + else { + $passthrough = 1; + } + $passthrough; } @_); } diff --git a/ext/XS-APItest/t/fetch_pad_names.t b/ext/XS-APItest/t/fetch_pad_names.t index 559bc3f..3d42280 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 2d2d192..99fbc5d 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 8d37a0c..ae8ba0a 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 a90005d..74adae3 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 c0c2cc9..7d988cb 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/perldelta.pod b/pod/perldelta.pod index b2526ad..025f380 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -169,7 +169,15 @@ XXX L<message|perldiag/"message"> =item * -XXX L<message|perldiag/"message"> +L<Smartmatch is experimental|perldiag/"Smartmatch is experimental"> + +=item * + +L<given is experimental|perldiag/"given is experimental"> + +=item * + +L<when is experimental|perldiag/"when is experimental"> =back diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 17d13ce..f7eb662 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 94a9843..dd3c49b 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 b62b526..ee1edba 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 5da635b..0dee7f5 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 f74b7e3..829e2de 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 c5cbbc3..83d3705 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 9923df6..c1f7181 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 79c9847..ed4b3ec 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 327ddf5..ad51d8b 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 b815491..204a57a 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 f5b913b..834e664 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 6b2eb79..c3ed030 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/porting/dual-life.t b/t/porting/dual-life.t index 5bbdd28..e757644 100644 --- a/t/porting/dual-life.t +++ b/t/porting/dual-life.t @@ -53,7 +53,7 @@ for my $f ( @programs ) { $f =~ s/\.\z// if $^O eq 'VMS'; next if $f =~ $not_installed; my $bn = basename($f); - if(qr/\A(?i:$bn)\z/ ~~ %dist_dir_exe) { + if(grep { /\A(?i:$bn)\z/ } keys %dist_dir_exe) { ok( -f "$dist_dir_exe{lc $bn}$ext", "$f$ext"); } else { ok( -f catfile('..', 'utils', "$bn$ext"), "$f$ext" ); diff --git a/t/re/regexp_unicode_prop.t b/t/re/regexp_unicode_prop.t index 3e08afc..fb1b154 100644 --- a/t/re/regexp_unicode_prop.t +++ b/t/re/regexp_unicode_prop.t @@ -188,19 +188,17 @@ sub match { my ($str, $name); - given ($char) { - when (/^\\/) { - $str = eval qq ["$char"]; - $name = qq ["$char"]; - } - when (/^0x([0-9A-Fa-f]+)$/) { - $str = chr hex $1; - $name = "chr ($char)"; - } - default { - $str = $char; - $name = qq ["$char"]; - } + if ($char =~ /^\\/) { + $str = eval qq ["$char"]; + $name = qq ["$char"]; + } + elsif ($char =~ /^0x([0-9A-Fa-f]+)$/) { + $str = chr hex $1; + $name = "chr ($char)"; + } + else { + $str = $char; + $name = qq ["$char"]; } undef $@; diff --git a/t/run/switches.t b/t/run/switches.t index 52c0d95..f1b9234 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 35cd364..275c957 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 d0bf710..5c40d5c 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" -- Perl5 Master Repository
