Perl_scalar() tail-call optimise
authorDavid Mitchell <davem@iabyn.com>
Wed, 29 May 2019 10:03:26 +0000 (11:03 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 24 Jun 2019 10:40:07 +0000 (11:40 +0100)
The part of this function that scans the children of e.g.

    $scalar = do { void; void; scalar }

applying scalar context only to the last child: tail call optimise that
call to Perl_scalar().

It also adds some extra 'warnings' tests. An earlier attempt at this
patch caused some unrelated tests to start emitting spurious 'useless in
void context' messages, which are covered by the new tests.

This also showed up that the current method for updating PL_curcop
while descending optrees in Perl_scalar/scalarvoid/S_scalarseq is a bit
broken. It gets updated every time a newstate op is seen, but haphazardly
(and sometimes wrongly) restored to &PL_compiling when going back up the
tree. One of the tests is TODO based on PL_curcop being wrong and so the
'no warnings "void"' leaking into an outer scope.

This commit maintains the status quo.

op.c
t/lib/warnings/op

diff --git a/op.c b/op.c
index 6522239..b9abc1c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1874,14 +1874,18 @@ Perl_scalar(pTHX_ OP *o)
                              || sib->op_targ == OP_DBSTATE  )
                         )
                 )
-                    scalar(kid);
+                {
+                    /* tail call optimise calling scalar() on the last kid */
+                    next_kid = kid;
+                    goto do_next;
+                }
                 else if (kid->op_type == OP_LEAVEWHEN)
                     scalar(kid);
                 else
                     scalarvoid(kid);
                 kid = sib;
             }
-            PL_curcop = &PL_compiling;
+            NOT_REACHED; /* NOTREACHED */
             break;
 
         case OP_SORT:
@@ -1939,9 +1943,19 @@ Perl_scalar(pTHX_ OP *o)
                 return top_op; /* at top; no parents/siblings to try */
             if (OpHAS_SIBLING(o))
                 next_kid = o->op_sibparent;
-            else
+            else {
                 o = o->op_sibparent; /*try parent's next sibling */
-
+                switch (o->op_type) {
+                case OP_SCOPE:
+                case OP_LINESEQ:
+                case OP_LIST:
+                case OP_LEAVE:
+                case OP_LEAVETRY:
+                    /* should really restore PL_curcop to its old value, but
+                     * setting it to PL_compiling is better than do nothing */
+                    PL_curcop = &PL_compiling;
+                }
+            }
         }
         o = next_kid;
     } /* while */
index 8529783..4d0b002 100644 (file)
@@ -2021,3 +2021,45 @@ $a.$b.$c;
 EXPECT
 Useless use of concatenation (.) or string in void context at - line 4.
 Useless use of concatenation (.) or string in void context at - line 5.
+########
+# PL_curcop tracked correctly in Perl_scalar()
+use warnings;
+my $scalar = do {
+    no warnings 'void';
+    1,2,3,4,5;
+};
+EXPECT
+########
+# PL_curcop tracked correctly in Perl_list()
+use warnings;
+my @array = do {
+    no warnings 'void';
+    1,2,3,4,5;
+};
+EXPECT
+########
+# TODO PL_curcop restored correctly in Perl_scalar()
+use warnings;
+my $scalar = do {
+    my $x = 1;
+    11,12,
+    do {
+        no warnings 'void';
+        my $x = 2;
+        21,22,
+    },
+    31,32,
+    do {
+        my $x = 3;
+        41,42,
+    },
+    51,52
+};
+EXPECT
+Useless use of a constant (11) in void context at - line 5.
+Useless use of a constant (12) in void context at - line 5.
+Useless use of a constant (31) in void context at - line 11.
+Useless use of a constant (32) in void context at - line 11.
+Useless use of a constant (41) in void context at - line 14.
+Useless use of a constant (42) in void context at - line 14.
+Useless use of a constant (51) in void context at - line 16.