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

[perl5.git] / op.c

diff --git a/op.c b/op.c
index ca24417..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.
@@ -3126,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));
@@ -3911,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);
@@ -5591,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;
 }
 
@@ -6403,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)) &&
@@ -6412,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);