[perl #7911] no warning for useless /d in tr/0-9//d

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 525b159..10c1fc9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9,11 +9,13 @@
  */
 
 /*
- * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
- * our Mr. Bilbo's first cousin on the mother's side (her mother being the
- * youngest of the Old Took's daughters); and Mr. Drogo was his second
- * cousin.  So Mr. Frodo is his first *and* second cousin, once removed
- * either way, as the saying is, if you follow me."  --the Gaffer
+ * 'You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
+ *  our Mr. Bilbo's first cousin on the mother's side (her mother being the
+ *  youngest of the Old Took's daughters); and Mr. Drogo was his second
+ *  cousin.  So Mr. Frodo is his first *and* second cousin, once removed
+ *  either way, as the saying is, if you follow me.'       --the Gaffer
+ *
+ *     [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
  */
 
 /* This file contains the functions that create, manipulate and optimize
@@ -3449,6 +3451,15 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            }
        }
     }
+
+    if(ckWARN(WARN_MISC)) {
+        if(del && rlen == tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); 
+        } else if(rlen > tlen) {
+            Perl_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list");
+        } 
+    }
+
     if (grows)
        o->op_private |= OPpTRANS_GROWS;
 #ifdef PERL_MAD
@@ -4422,7 +4433,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 #endif
     CopSTASH_set(cop, PL_curstash);
 
-    if (PERLDB_LINE && PL_curstash != PL_debstash) {
+    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash) {
+       /* this line can have a breakpoint - store the cop in IV */
        AV *av = CopFILEAVx(PL_curcop);
        if (av) {
            SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
@@ -5794,6 +5806,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (!block)
        goto done;
 
+    /* If we assign an optree to a PVCV, then we've defined a subroutine that
+       the debugger could be able to set a breakpoint in, so signal to
+       pp_entereval that it should not throw away any saved lines at scope
+       exit.  */
+       
+    PL_breakable_sub_gen++;
     if (CvLVALUE(cv)) {
        CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0,
                             mod(scalarseq(block), OP_LEAVESUBLV));
@@ -7916,7 +7934,7 @@ Perl_ck_join(pTHX_ OP *o)
     if (kid && kid->op_type == OP_MATCH) {
        if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
-           const char *pmstr = re ? RX_PRECOMP(re) : "STRING";
+           const char *pmstr = re ? RX_PRECOMP_const(re) : "STRING";
            const STRLEN len = re ? RX_PRELEN(re) : 6;
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        "/%.*s/ should probably be written as \"%.*s\"",