t/harness: Clarify error message wording

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 6bf5b19..e875a90 100644 (file)
--- a/op.c
+++ b/op.c
@@ -310,7 +310,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
             (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
             (void*)head_slab));
 
-       while (o && DIFF(OpSLOT(o), OpSLOT(o)->opslot_next) < sz) {
+       while (o && OpSLOT(o)->opslot_size < sz) {
            DEBUG_S_warn((aTHX_ "Alas! too small"));
            o = *(too = &o->op_next);
            if (o) { DEBUG_S_warn((aTHX_ "found another free op at %p", (void*)o)); }
@@ -325,7 +325,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
 
 #define INIT_OPSLOT(s) \
            slot->opslot_offset = DIFF(slab2, slot) ;   \
-           slot->opslot_next = ((OPSLOT*)( (I32**)slot + s )); \
+           slot->opslot_size = s;                      \
            slab2->opslab_free_space -= s;              \
            o = &slot->opslot_op;                       \
            o->op_slabbed = 1
@@ -535,7 +535,9 @@ Perl_opslab_force_free(pTHX_ OPSLAB *slab)
                     ((I32**)&slab2->opslab_slots + slab2->opslab_free_space);
         OPSLOT *end  = (OPSLOT*)
                         ((I32**)slab2 + slab2->opslab_size);
-       for (; slot <= end -1; slot = slot->opslot_next) {
+       for (; slot < end;
+                slot = (OPSLOT*) ((I32**)slot + slot->opslot_size) )
+        {
            if (slot->opslot_op.op_type != OP_FREED
             && !(slot->opslot_op.op_savefree
 #ifdef DEBUGGING
@@ -698,16 +700,22 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
                 && isIDFIRST_utf8_safe((U8 *)name+1, name + len))
             || (name[1] == '_' && len > 2)))
     {
+        const char * const type =
+              PL_parser->in_my == KEY_sigvar ? "subroutine signature" :
+              PL_parser->in_my == KEY_state  ? "\"state\""     : "\"my\"";
+
        if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
         && isASCII(name[1])
         && (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
-           /* diag_listed_as: Can't use global %s in "%s" */
-           yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in \"%s\"",
-                             name[0], toCTRL(name[1]), (int)(len - 2), name + 2,
-                             PL_parser->in_my == KEY_state ? "state" : "my"));
+           /* diag_listed_as: Can't use global %s in %s */
+           yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in %s",
+                             name[0], toCTRL(name[1]),
+                              (int)(len - 2), name + 2,
+                             type));
        } else {
-           yyerror_pv(Perl_form(aTHX_ "Can't use global %.*s in \"%s\"", (int) len, name,
-                             PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
+           yyerror_pv(Perl_form(aTHX_ "Can't use global %.*s in %s",
+                              (int) len, name,
+                             type), flags & SVf_UTF8);
        }
     }
 
@@ -5453,7 +5461,8 @@ Perl_op_scope(pTHX_ OP *o)
     dVAR;
     if (o) {
        if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
-           o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
+           o = op_prepend_elem(OP_LINESEQ,
+                    newOP(OP_ENTER, (o->op_flags & OPf_WANT)), o);
             OpTYPE_set(o, OP_LEAVE);
        }
        else if (o->op_type == OP_LINESEQ) {
@@ -9281,10 +9290,14 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
     /* for my  $x () sets OPpLVAL_INTRO;
      * for our $x () sets OPpOUR_INTRO */
     loop->op_private = (U8)iterpflags;
+
+    /* upgrade loop from a LISTOP to a LOOPOP;
+     * keep it in-place if there's space */
     if (loop->op_slabbed
-     && DIFF(loop, OpSLOT(loop)->opslot_next)
-        < SIZE_TO_PSIZE(sizeof(LOOP)))
+        &&    OpSLOT(loop)->opslot_size
+            < SIZE_TO_PSIZE(sizeof(LOOP)) + OPSLOT_HEADER_P)
     {
+        /* no space; allocate new op */
        LOOP *tmp;
        NewOp(1234,tmp,1,LOOP);
        Copy(loop,tmp,1,LISTOP);
@@ -9295,6 +9308,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
     }
     else if (!loop->op_slabbed)
     {
+        /* loop was malloc()ed */
        loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
         OpLASTSIB_set(loop->op_last, (OP*)loop);
     }
@@ -16079,8 +16093,17 @@ Perl_rpeep(pTHX_ OP *o)
               this optimisation if the first NEXTSTATE has a label.  */
            if (!CopLABEL((COP*)o) && !PERLDB_NOOPT) {
                OP *nextop = o->op_next;
-               while (nextop && nextop->op_type == OP_NULL)
-                   nextop = nextop->op_next;
+               while (nextop) {
+                    switch (nextop->op_type) {
+                        case OP_NULL:
+                        case OP_SCALAR:
+                        case OP_LINESEQ:
+                        case OP_SCOPE:
+                            nextop = nextop->op_next;
+                            continue;
+                    }
+                    break;
+                }
 
                if (nextop && (nextop->op_type == OP_NEXTSTATE)) {
                    op_null(o);
@@ -17029,7 +17052,7 @@ Perl_peep(pTHX_ OP *o)
 /*
 =head1 Custom Operators
 
-=for apidoc custom_op_xop
+=for apidoc Perl_custom_op_xop
 Return the XOP structure for a given custom op.  This macro should be
 considered internal to C<OP_NAME> and the other access macros: use them instead.
 This macro does call a function.  Prior