In Perl_ck_subr(), hoist the if (proto) check outside of the while loop.
authorNicholas Clark <nick@ccl4.org>
Mon, 13 Sep 2010 12:38:27 +0000 (13:38 +0100)
committerNicholas Clark <nick@ccl4.org>
Mon, 13 Sep 2010 12:51:34 +0000 (13:51 +0100)
Prototype checking is currently 165 lines of code. The rest of the while loop
is 19, including comments. It's much easier to see how prototype checking fits
into the structure this way, *and* it avoids a repeated if check inside a loop.

op.c

diff --git a/op.c b/op.c
index 83800e1..e3d8213 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8447,17 +8447,38 @@ Perl_ck_subr(pTHX_ OP *o)
     o->op_private |= (PL_hints & HINT_STRICT_REFS);
     if (PERLDB_SUB && PL_curstash != PL_debstash)
        o->op_private |= OPpENTERSUB_DB;
-    while (o2 != cvop) {
-       OP* o3;
-       if (PL_madskills && o2->op_type == OP_STUB) {
+    if (!proto) {
+       while (o2 != cvop) {
+           OP* o3;
+           if (PL_madskills && o2->op_type == OP_STUB) {
+               o2 = o2->op_sibling;
+               continue;
+           }
+           if (PL_madskills && o2->op_type == OP_NULL)
+               o3 = ((UNOP*)o2)->op_first;
+           else
+               o3 = o2;
+           /* Yes, this while loop is duplicated. But it's a lot clearer
+              to see what is going on without that massive switch(*proto)
+              block just here.  */
+           list(o2); /* This is only called if !proto  */
+
+           mod(o2, OP_ENTERSUB);
+           prev = o2;
            o2 = o2->op_sibling;
-           continue;
-       }
-       if (PL_madskills && o2->op_type == OP_NULL)
-           o3 = ((UNOP*)o2)->op_first;
-       else
-           o3 = o2;
-       if (proto) {
+       } /* while */
+    } else {
+       while (o2 != cvop) {
+           OP* o3;
+           if (PL_madskills && o2->op_type == OP_STUB) {
+               o2 = o2->op_sibling;
+               continue;
+           }
+           if (PL_madskills && o2->op_type == OP_NULL)
+               o3 = ((UNOP*)o2)->op_first;
+           else
+               o3 = o2;
+
            if (proto >= proto_end)
                return too_many_arguments(o, gv_ename(namegv));
 
@@ -8621,13 +8642,12 @@ Perl_ck_subr(pTHX_ OP *o)
                Perl_croak(aTHX_ "Malformed prototype for %s: %"SVf,
                           gv_ename(namegv), SVfARG(cv));
            }
-       }
-       else
-           list(o2);
-       mod(o2, OP_ENTERSUB);
-       prev = o2;
-       o2 = o2->op_sibling;
-    } /* while */
+
+           mod(o2, OP_ENTERSUB);
+           prev = o2;
+           o2 = o2->op_sibling;
+       } /* while */
+    }
     if (o2 == cvop && proto && *proto == '_') {
        /* generate an access to $_ */
        o2 = newDEFSVOP();