make ~$x give warning is $x isn't initialised.

[perl5.git] / op.c

diff --git a/op.c b/op.c
index c5b2e83..344130c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,7 +1,7 @@
 /*    op.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -677,10 +677,14 @@ Perl_scalarvoid(pTHX_ OP *o)
        else {
            if (ckWARN(WARN_VOID)) {
                useless = "a constant";
+               /* don't warn on optimised away booleans, eg 
+                * use constant Foo, 5; Foo || print; */
+               if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
+                   useless = 0;
                /* the constants 0 and 1 are permitted as they are
                   conventionally used as dummies in constructs like
                        1 while some_condition_with_side_effects;  */
-               if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
+               else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
                    useless = 0;
                else if (SvPOK(sv)) {
                   /* perl4's way of mixing documentation and code
@@ -3122,6 +3126,14 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
            op_free(right);
            return Nullop;
        }
+       /* optimise C<my @x = ()> to C<my @x>, and likewise for hashes */
+       if ((left->op_type == OP_PADAV || left->op_type == OP_PADHV)
+               && right->op_type == OP_STUB
+               && (left->op_private & OPpLVAL_INTRO))
+       {
+           op_free(right);
+           return left;
+       }
        curop = list(force_list(left));
        o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
        o->op_private = (U8)(0 | (flags >> 8));
@@ -3316,9 +3328,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        }
     }
 
-    o = prepend_elem(OP_LINESEQ, (OP*)cop, o);
-    CHECKOP(cop->op_type, cop);
-    return o;
+    return prepend_elem(OP_LINESEQ, (OP*)cop, o);
 }
 
 
@@ -3363,11 +3373,30 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
        if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
            op_free(first);
            *firstp = Nullop;
+           other->op_private |= OPpCONST_SHORTCIRCUIT;
            return other;
        }
        else {
+           /* check for C<my $x if 0>, or C<my($x,$y) if 0> */
+           OP *o2 = other;
+           if ( ! (o2->op_type == OP_LIST
+                   && (( o2 = cUNOPx(o2)->op_first))
+                   && o2->op_type == OP_PUSHMARK
+                   && (( o2 = o2->op_sibling)) )
+           )
+               o2 = other;
+           if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV
+                       || o2->op_type == OP_PADHV)
+               && o2->op_private & OPpLVAL_INTRO
+               && ckWARN(WARN_DEPRECATED))
+           {
+               Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                           "Deprecated use of my() in false conditional");
+           }
+
            op_free(other);
            *otherp = Nullop;
+           first->op_private |= OPpCONST_SHORTCIRCUIT;
            return first;
        }
     }
@@ -3577,6 +3606,10 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
        }
     }
 
+    /* if block is null, the next append_elem() would put UNSTACK, a scalar
+     * op, in listop. This is wrong. [perl #27024] */
+    if (!block)
+       block = newOP(OP_NULL, 0);
     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
     o = new_logop(OP_AND, 0, &expr, &listop);
 
@@ -3886,6 +3919,8 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
        if (SvPOK(cv))
            Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (SV *)cv);
+       else
+           Perl_sv_catpvf(aTHX_ msg, ": none");
        sv_catpv(msg, " vs ");
        if (p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
@@ -5566,6 +5601,19 @@ Perl_ck_sassign(pTHX_ OP *o)
            return kid;
        }
     }
+    /* optimise C<my $x = undef> to C<my $x> */
+    if (kid->op_type == OP_UNDEF) {
+       OP *kkid = kid->op_sibling;
+       if (kkid && kkid->op_type == OP_PADSV
+               && (kkid->op_private & OPpLVAL_INTRO))
+       {
+           cLISTOPo->op_first = NULL;
+           kid->op_sibling = NULL;
+           op_free(o);
+           op_free(kid);
+           return kkid;
+       }
+    }
     return o;
 }
 
@@ -5976,42 +6024,6 @@ Perl_ck_join(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_state(pTHX_ OP *o)
-{
-    /* warn on C<my $x=1 if foo;> , C<$a && my $x=1;> style statements */
-    OP *kid;
-    o = o->op_sibling;
-    if (!o || o->op_type != OP_NULL || !(o->op_flags & OPf_KIDS))
-       return o;
-    kid = cUNOPo->op_first;
-    if (!(kid->op_type == OP_AND || kid->op_type == OP_OR))
-       return o;
-    kid = kUNOP->op_first->op_sibling;
-    if (kid->op_type == OP_SASSIGN)
-       kid = kBINOP->op_first->op_sibling;
-    else if (kid->op_type == OP_AASSIGN)
-       kid = kBINOP->op_first->op_sibling;
-
-    if (kid->op_type == OP_LIST
-           || (kid->op_type == OP_NULL && kid->op_targ == OP_LIST))
-    {
-       kid = kUNOP->op_first;
-       if (kid->op_type == OP_PUSHMARK)
-           kid = kid->op_sibling;
-    }
-    if ((kid->op_type == OP_PADSV || kid->op_type == OP_PADAV
-           || kid->op_type == OP_PADHV)
-       && (kid->op_private & OPpLVAL_INTRO)
-       && (ckWARN(WARN_DEPRECATED)))
-    {
-       Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                           "Deprecated use of my() in conditional");
-    }
-    return o;
-}
-
-
-OP *
 Perl_ck_subr(pTHX_ OP *o)
 {
     OP *prev = ((cUNOPo->op_first->op_sibling)
@@ -6414,7 +6426,7 @@ Perl_peep(pTHX_ register OP *o)
                            o->op_next : o->op_next->op_next;
                IV i;
                if (pop && pop->op_type == OP_CONST &&
-                   (PL_op = pop->op_next) &&
+                   ((PL_op = pop->op_next)) &&
                    pop->op_next->op_type == OP_AELEM &&
                    !(pop->op_next->op_private &
                      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
@@ -6423,6 +6435,8 @@ Perl_peep(pTHX_ register OP *o)
                    i >= 0)
                {
                    GV *gv;
+                   if (cSVOPx(pop)->op_private & OPpCONST_STRICT)
+                       no_bareword_allowed(pop);
                    if (o->op_type == OP_GV)
                        op_null(o->op_next);
                    op_null(pop->op_next);