This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Deparse: don't parenthesise state @a = ...
[perl5.git] / lib / B / Deparse-core.t
index 370728b..6ee935f 100644 (file)
@@ -4,7 +4,7 @@
 #
 # Initially this test file just checked that CORE::foo got correctly
 # deparsed as CORE::foo, hence the name. It's since been expanded
-# to fully test both CORE:: verses none, plus that any arguments
+# to fully test both CORE:: versus none, plus that any arguments
 # are correctly deparsed. It also cross-checks against regen/keywords.pl
 # to make sure we've tested all keywords, and with the correct strength.
 #
@@ -36,11 +36,10 @@ BEGIN {
 
 use strict;
 use Test::More;
-plan tests => 4006;
+plan tests => 3886;
 
 use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature
                                     # logic to add CORE::
-no warnings 'experimental::autoderef';
 use B::Deparse;
 my $deparse = new B::Deparse;
 
@@ -81,21 +80,23 @@ sub testit {
        $desc .= " (lex sub)" if $lexsub;
 
 
+        my $code;
        my $code_ref;
        if ($lexsub) {
            package lexsubtest;
            no warnings 'experimental::lexical_subs';
            use feature 'lexical_subs';
            no strict 'vars';
-           $code_ref =
-               eval "sub { state sub $keyword; ${vars}() = $expr }"
-                           || die "$@ in $expr";
+            $code = "sub { state sub $keyword; ${vars}() = $expr }";
+           $code_ref = eval $code
+                           or die "$@ in $expr";
        }
        else {
            package test;
            use subs ();
            import subs $keyword;
-           $code_ref = eval "no strict 'vars'; sub { ${vars}() = $expr }"
+           $code = "no strict 'vars'; sub { ${vars}() = $expr }";
+           $code_ref = eval $code
                            or die "$@ in $expr";
        }
 
@@ -103,11 +104,12 @@ sub testit {
 
        unless ($got_text =~ /
     package (?:lexsub)?test;
-    BEGIN \{\$\{\^WARNING_BITS} = "[^"]*"}
-    use strict 'refs', 'subs';
+(?:    BEGIN \{\$\{\^WARNING_BITS\} = "[^"]+"\}
+)?    use strict 'refs', 'subs';
     use feature [^\n]+
-    \Q$vars\E\(\) = (.*)
-}/s) {
+(?:    (?:CORE::)?state sub \w+;
+)?    \Q$vars\E\(\) = (.*)
+\}/s) {
            ::fail($desc);
            ::diag("couldn't extract line from boilerplate\n");
            ::diag($got_text);
@@ -115,7 +117,8 @@ sub testit {
        }
 
        my $got_expr = $1;
-       is $got_expr, $expected_expr, $desc;
+       is $got_expr, $expected_expr, $desc
+            or ::diag("ORIGINAL CODE:\n$code");;
     }
 }
 
@@ -252,6 +255,7 @@ testit do       => 'do { 1 };',
                   "do {\n        1\n    };";
 
 testit each     => 'CORE::each %bar;';
+testit each     => 'CORE::each @foo;';
 
 testit eof      => 'CORE::eof();';
 
@@ -271,17 +275,32 @@ testit glob     => 'CORE::glob $a;',              'CORE::glob($a);';
 testit grep     => 'CORE::grep { $a } $b, $c',    'grep({$a;} $b, $c);';
 
 testit keys     => 'CORE::keys %bar;';
+testit keys     => 'CORE::keys @bar;';
 
 testit map      => 'CORE::map { $a } $b, $c',    'map({$a;} $b, $c);';
 
 testit not      => '3 unless CORE::not $a && $b;';
 
+testit pop      => 'CORE::pop @foo;';
+
+testit push     => 'CORE::push @foo;',           'CORE::push(@foo);';
+testit push     => 'CORE::push @foo, 1;',        'CORE::push(@foo, 1);';
+testit push     => 'CORE::push @foo, 1, 2;',     'CORE::push(@foo, 1, 2);';
+
 testit readline => 'CORE::readline $a . $b;';
 
 testit readpipe => 'CORE::readpipe $a + $b;';
 
 testit reverse  => 'CORE::reverse sort(@foo);';
 
+testit shift    => 'CORE::shift @foo;';
+
+testit splice   => q{CORE::splice @foo;},                 q{CORE::splice(@foo);};
+testit splice   => q{CORE::splice @foo, 0;},              q{CORE::splice(@foo, 0);};
+testit splice   => q{CORE::splice @foo, 0, 1;},           q{CORE::splice(@foo, 0, 1);};
+testit splice   => q{CORE::splice @foo, 0, 1, 'a';},      q{CORE::splice(@foo, 0, 1, 'a');};
+testit splice   => q{CORE::splice @foo, 0, 1, 'a', 'b';}, q{CORE::splice(@foo, 0, 1, 'a', 'b');};
+
 # note that the test does '() = split...' which is why the
 # limit is optimised to 1
 testit split    => 'split;',                     q{split(' ', $_, 1);};
@@ -298,7 +317,12 @@ testit sub      => 'CORE::sub { $a, $b }',
 
 testit system   => 'CORE::system($foo $bar);';
 
+testit unshift  => 'CORE::unshift @foo;',        'CORE::unshift(@foo);';
+testit unshift  => 'CORE::unshift @foo, 1;',     'CORE::unshift(@foo, 1);';
+testit unshift  => 'CORE::unshift @foo, 1, 2;',  'CORE::unshift(@foo, 1, 2);';
+
 testit values   => 'CORE::values %bar;';
+testit values   => 'CORE::values @foo;';
 
 
 # XXX These are deparsed wrapped in parens.
@@ -463,7 +487,7 @@ defined          01    $+
 die              @     p1
 # do handled specially
 # dump handled specially
-each             1     - # also tested specially
+# each handled specially
 endgrent         0     -
 endhostent       0     -
 endnetent        0     -
@@ -522,7 +546,7 @@ index            23    p
 int              01    $
 ioctl            3     p
 join             13    p
-keys             1     - # also tested specially
+# keys handled specially
 kill             123   p
 # last handled specially
 lc               01    $
@@ -555,12 +579,12 @@ ord              01    $
 our              123   p+ # skip with 0 args, as our() => ()
 pack             123   p
 pipe             2     p
-pop              01    1
+pop              0     1 # also tested specially
 pos              01    $+
 print            @     p$+
 printf           @     p$+
 prototype        1     +
-push             123   p
+# push handled specially
 quotemeta        01    $
 rand             01    -
 read             34    p
@@ -601,7 +625,7 @@ setprotoent      1     -
 setpwent         0     -
 setservent       1     -
 setsockopt       4     p
-shift            01    1
+shift            0     1 # also tested specially
 shmctl           3     p
 shmget           3     p
 shmread          4     p
@@ -611,14 +635,14 @@ sin              01    $
 sleep            01    -
 socket           4     p
 socketpair       5     p
-sort             @     p+
+sort             @     p1+
 # split handled specially
-splice           12345 p
+# splice handled specially
 sprintf          123   p
 sqrt             01    $
 srand            01    -
 stat             01    $
-state            123   p+ # skip with 0 args, as state() => ()
+state            123   p1+ # skip with 0 args, as state() => ()
 study            01    $+
 # sub handled specially
 substr           234   p
@@ -642,10 +666,10 @@ umask            01    -
 undef            01    +
 unlink           @     p$
 unpack           12    p$
-unshift          1     p
+# unshift handled specially
 untie            1     -
 utime            @     p1
-values           1     - # also tested specially
+# values handled specially
 vec              3     p
 wait             0     -
 waitpid          2     p