This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
No longer print experimental::isa warning (closes #18754)
[perl5.git] / lib / B / Deparse-core.t
index deffaf7..48d23f7 100644 (file)
@@ -36,18 +36,19 @@ BEGIN {
 
 use strict;
 use Test::More;
-plan tests => 3904;
 
 use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
                                     # logic to add CORE::
 use B::Deparse;
-my $deparse = new B::Deparse;
+my $deparse = B::Deparse->new();
 
 my %SEEN;
 my %SEEN_STRENGTH;
 
-# for a given keyword, create a sub of that name, then
-# deparse "() = $expr", and see if it matches $expected_expr
+# For a given keyword, create a sub of that name,
+# then deparse 3 different assignment expressions
+# using that keyword.  See if the $expr we get back
+# matches $expected_expr.
 
 sub testit {
     my ($keyword, $expr, $expected_expr, $lexsub) = @_;
@@ -55,14 +56,11 @@ sub testit {
     $expected_expr //= $expr;
     $SEEN{$keyword} = 1;
 
-
     # lex=0:   () = foo($a,$b,$c)
     # lex=1:   my ($a,$b); () = foo($a,$b,$c)
     # lex=2:   () = foo(my $a,$b,$c)
     for my $lex (0, 1, 2) {
-        if ($lex) {
-            next if $keyword =~ /local|our|state|my/;
-        }
+        next if ($lex and $keyword =~ /local|our|state|my/);
         my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n    " : "";
 
         if ($lex == 2) {
@@ -83,20 +81,21 @@ sub testit {
         my $code_ref;
         if ($lexsub) {
             package lexsubtest;
-            no warnings 'experimental::lexical_subs', 'experimental::isa';
+            no warnings 'experimental::lexical_subs';
             use feature 'lexical_subs';
             no strict 'vars';
             $code = "sub { state sub $keyword; ${vars}() = $expr }";
             $code = "use feature 'isa';\n$code" if $keyword eq "isa";
+            $code = "use feature 'switch';\n$code" if $keyword eq "break";
             $code_ref = eval $code or die "$@ in $expr";
         }
         else {
             package test;
-            no warnings 'experimental::isa';
             use subs ();
             import subs $keyword;
             $code = "no strict 'vars'; sub { ${vars}() = $expr }";
             $code = "use feature 'isa';\n$code" if $keyword eq "isa";
+            $code = "use feature 'switch';\n$code" if $keyword eq "break";
             $code_ref = eval $code or die "$@ in $expr";
         }
 
@@ -126,8 +125,7 @@ sub testit {
 # Deparse can't distinguish 'and' from '&&' etc
 my %infix_map = qw(and && or ||);
 
-
-# test a keyword that is a binary infix operator, like 'cmp'.
+# Test a keyword that is a binary infix operator, like 'cmp'.
 # $parens - "$a op $b" is deparsed as "($a op $b)"
 # $strong - keyword is strong
 
@@ -156,7 +154,7 @@ sub do_infix_keyword {
     testit $keyword, "$keyword(\$a, \$b)", "$keyword(\$a, \$b);", 1;
 }
 
-# test a keyword that is a standard op/function, like 'index(...)'.
+# Test a keyword that is a standard op/function, like 'index(...)'.
 # $narg   - how many args to test it with
 # $parens - "foo $a, $b" is deparsed as "foo($a, $b)"
 # $dollar - an extra '$_' arg will appear in the deparsed output
@@ -364,9 +362,12 @@ my %not_tested = map { $_ => 1} qw(
     END
     INIT
     UNITCHECK
+    catch
     default
+    defer
     else
     elsif
+    finally
     for
     foreach
     format
@@ -383,6 +384,7 @@ my %not_tested = map { $_ => 1} qw(
     require
     s
     tr
+    try
     unless
     until
     use
@@ -391,8 +393,6 @@ my %not_tested = map { $_ => 1} qw(
     y
 );
 
-
-
 # Sanity check against keyword data:
 # make sure we haven't missed any keywords,
 # and that we got the strength right.
@@ -434,7 +434,7 @@ SKIP:
     ok($pass, "sanity checks");
 }
 
-
+done_testing();
 
 __DATA__
 #
@@ -641,7 +641,7 @@ sin              01    $
 sleep            01    -
 socket           4     p
 socketpair       5     p
-sort             @     p1+
+sort             12    p+
 # split handled specially
 # splice handled specially
 sprintf          123   p