This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lib/B/Deparse-core.t: Tidy leading whitespace
authorJames E Keenan <jkeenan@cpan.org>
Mon, 21 Dec 2020 20:17:18 +0000 (15:17 -0500)
committerKarl Williamson <khw@cpan.org>
Sun, 27 Dec 2020 18:54:08 +0000 (11:54 -0700)
The loops-within-loops structure of this program means that irregular
leading whitespace makes it difficult to follow the control flow.

Convert leading tabs to whitespace.  Rebreak some lines to show
structure of nested ternaries more clearly.  Join short lines in a
couple of instances.

lib/B/Deparse-core.t

index 80dbc05..deffaf7 100644 (file)
@@ -60,51 +60,49 @@ sub testit {
     # 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/;
-       }
-       my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n    " : "";
-
-       if ($lex == 2) {
-           my $repl = 'my $a';
-           if ($expr =~ 'CORE::do') {
-               # do foo() is a syntax error, so B::Deparse emits
-               # do (foo()), but does not distinguish between foo and my,
-               # because it is too complicated.
-               $repl = '(my $a)';
-           }
-           s/\$a/$repl/ for $expr, $expected_expr;
-       }
-
-       my $desc = "$keyword: lex=$lex $expr => $expected_expr";
-       $desc .= " (lex sub)" if $lexsub;
+        if ($lex) {
+            next if $keyword =~ /local|our|state|my/;
+        }
+        my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n    " : "";
+
+        if ($lex == 2) {
+            my $repl = 'my $a';
+            if ($expr =~ 'CORE::do') {
+                # do foo() is a syntax error, so B::Deparse emits
+                # do (foo()), but does not distinguish between foo and my,
+                # because it is too complicated.
+                $repl = '(my $a)';
+            }
+            s/\$a/$repl/ for $expr, $expected_expr;
+        }
+
+        my $desc = "$keyword: lex=$lex $expr => $expected_expr";
+        $desc .= " (lex sub)" if $lexsub;
 
         my $code;
-       my $code_ref;
-       if ($lexsub) {
-           package lexsubtest;
-           no warnings 'experimental::lexical_subs', 'experimental::isa';
-           use feature 'lexical_subs';
-           no strict 'vars';
+        my $code_ref;
+        if ($lexsub) {
+            package lexsubtest;
+            no warnings 'experimental::lexical_subs', 'experimental::isa';
+            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_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_ref = eval $code
-                           or die "$@ in $expr";
-       }
-
-       my $got_text = $deparse->coderef2text($code_ref);
-
-       unless ($got_text =~ /
+            $code = "use feature 'isa';\n$code" if $keyword eq "isa";
+            $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_ref = eval $code or die "$@ in $expr";
+        }
+
+        my $got_text = $deparse->coderef2text($code_ref);
+
+        unless ($got_text =~ /
     package (?:lexsub)?test;
 (?:    BEGIN \{\$\{\^WARNING_BITS\} = "[^"]+"\}
 )?    use strict 'refs', 'subs';
@@ -112,14 +110,14 @@ sub testit {
 (?:    (?:CORE::)?state sub \w+;
 )?    \Q$vars\E\(\) = (.*)
 \}/s) {
-           ::fail($desc);
-           ::diag("couldn't extract line from boilerplate\n");
-           ::diag($got_text);
-           return;
-       }
-
-       my $got_expr = $1;
-       is $got_expr, $expected_expr, $desc
+            ::fail($desc);
+            ::diag("couldn't extract line from boilerplate\n");
+            ::diag($got_text);
+            return;
+        }
+
+        my $got_expr = $1;
+        is $got_expr, $expected_expr, $desc
             or ::diag("ORIGINAL CODE:\n$code");;
     }
 }
@@ -149,17 +147,17 @@ sub do_infix_keyword {
     testit $keyword, "(\$a CORE::$keyword \$b)", $exp, 1;
     testit $keyword, "(\$a $keyword \$b)", $exp, 1;
     if (!$strong) {
-       # B::Deparse fully qualifies any sub whose name is a keyword,
-       # imported or not, since the importedness may not be reproduced by
-       # the deparsed code.  x is special.
-       my $pre = "test::" x ($keyword ne 'x');
-       testit $keyword, "$keyword(\$a, \$b)", "$pre$keyword(\$a, \$b);";
+        # B::Deparse fully qualifies any sub whose name is a keyword,
+        # imported or not, since the importedness may not be reproduced by
+        # the deparsed code.  x is special.
+        my $pre = "test::" x ($keyword ne 'x');
+        testit $keyword, "$keyword(\$a, \$b)", "$pre$keyword(\$a, \$b);";
     }
     testit $keyword, "$keyword(\$a, \$b)", "$keyword(\$a, \$b);", 1;
 }
 
 # test a keyword that is a standard op/function, like 'index(...)'.
-# narg    - how many args to test it with
+# $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
 # $strong - keyword is strong
@@ -171,30 +169,35 @@ sub do_std_keyword {
     $SEEN_STRENGTH{$keyword} = $strong;
 
     for my $core (0,1) { # if true, add CORE:: to keyword being deparsed
-      for my $lexsub (0,1) { # if true, define lex sub
-       my @code;
-       for my $do_exp(0, 1) { # first create expr, then expected-expr
-           my @args = map "\$$_", (undef,"a".."z")[1..$narg];
-           push @args, '$_'
-               if $dollar && $do_exp && ($strong && !$lexsub or $core);
-           my $args = join(', ', @args);
-            # XXX $lex_parens is temporary, until lex subs are
-            #     deparsed properly.
-           my $lex_parens =
-               !$core && $do_exp && $lexsub && $keyword ne 'map';
-           $args = ((!$core && !$strong) || $parens || $lex_parens)
-                       ? "($args)"
-                       :  @args ? " $args" : "";
-           push @code, (($core && !($do_exp && $strong))
-                        ? "CORE::"
-                        : $lexsub && $do_exp
-                          ? "CORE::" x $core
-                          : $do_exp && !$core && !$strong ? "test::" : "")
-                                                       . "$keyword$args;";
-       }
-       # code[0]: to run; code[1]: expected
-       testit $keyword, @code, $lexsub;
-      }
+        for my $lexsub (0,1) { # if true, define lex sub
+            my @code;
+            for my $do_exp(0, 1) { # first create expr, then expected-expr
+                my @args = map "\$$_", (undef,"a".."z")[1..$narg];
+                push @args, '$_'
+                    if $dollar && $do_exp && ($strong && !$lexsub or $core);
+                my $args = join(', ', @args);
+                # XXX $lex_parens is temporary, until lex subs are
+                #     deparsed properly.
+                my $lex_parens =
+                    !$core && $do_exp && $lexsub && $keyword ne 'map';
+                $args = ((!$core && !$strong) || $parens || $lex_parens)
+                    ? "($args)"
+                    :  @args
+                        ? " $args"
+                        : "";
+                push @code, (
+                    ($core && !($do_exp && $strong))
+                    ? "CORE::"
+                    : $lexsub && $do_exp
+                        ? "CORE::" x $core
+                        : $do_exp && !$core && !$strong
+                            ? "test::"
+                            : ""
+                ) . "$keyword$args;";
+            }
+            # code[0]: to run; code[1]: expected
+            testit $keyword, @code, $lexsub;
+        }
     }
 }
 
@@ -217,18 +220,18 @@ while (<DATA>) {
     die "unrecognised flag(s): '$flags'" unless $flags =~ /^-?$/;
 
     if ($args eq 'B') { # binary infix
-       die "$keyword: binary (B) op can't have '\$' flag\\n" if $dollar;
-       die "$keyword: binary (B) op can't have '1' flag\\n" if $invert1;
-       do_infix_keyword($keyword, $parens, $strong);
+        die "$keyword: binary (B) op can't have '\$' flag\\n" if $dollar;
+        die "$keyword: binary (B) op can't have '1' flag\\n" if $invert1;
+        do_infix_keyword($keyword, $parens, $strong);
     }
     else {
-       my @narg = split //, $args;
-       for my $n (0..$#narg) {
-           my $narg = $narg[$n];
-           my $p = $parens;
-           $p = !$p if ($n == 0 && $invert1);
-           do_std_keyword($keyword, $narg, $p, (!$n && $dollar), $strong);
-       }
+        my @narg = split //, $args;
+        for my $n (0..$#narg) {
+            my $narg = $narg[$n];
+            my $p = $parens;
+            $p = !$p if ($n == 0 && $invert1);
+            do_std_keyword($keyword, $narg, $p, (!$n && $dollar), $strong);
+        }
     }
 }