Make the large file tests more robust/talkative as suggested by

[p5sagit/p5-mst-13.2.git] / doop.c

diff --git a/doop.c b/doop.c
index 3c34425..3548556 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -36,7 +36,6 @@
 STATIC I32
 S_do_trans_simple(pTHX_ SV *sv)
 {
-    dTHR;
     U8 *s;
     U8 *d;
     U8 *send;
@@ -49,7 +48,7 @@ S_do_trans_simple(pTHX_ SV *sv)
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-       Perl_croak(aTHX_ "panic: do_trans");
+       Perl_croak(aTHX_ "panic: do_trans_simple");
 
     s = (U8*)SvPV(sv, len);
     send = s + len;
@@ -80,10 +79,7 @@ S_do_trans_simple(pTHX_ SV *sv)
        c = utf8_to_uv(s, send - s, &ulen, 0);
         if (c < 0x100 && (ch = tbl[(short)c]) >= 0) {
             matches++;
-            if (ch < 0x80)
-                *d++ = ch;
-            else
-                d = uv_to_utf8(d,ch);
+            d = uv_to_utf8(d,ch);
             s += ulen;
         }
        else { /* No match -> copy */
@@ -102,7 +98,6 @@ S_do_trans_simple(pTHX_ SV *sv)
 STATIC I32
 S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     I32 matches = 0;
@@ -112,7 +107,7 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-       Perl_croak(aTHX_ "panic: do_trans");
+       Perl_croak(aTHX_ "panic: do_trans_count");
 
     s = (U8*)SvPV(sv, len);
     send = s + len;
@@ -140,7 +135,6 @@ S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -153,7 +147,7 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 
     tbl = (short*)cPVOP->op_pv;
     if (!tbl)
-       Perl_croak(aTHX_ "panic: do_trans");
+       Perl_croak(aTHX_ "panic: do_trans_complex");
 
     s = (U8*)SvPV(sv, len);
     send = s + len;
@@ -195,12 +189,9 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
                matches--;
            }
 
-           if (ch >= 0) {
-               if (hasutf)
-                 d = uv_to_utf8(d, ch);
-               else 
-                 *d++ = ch;
-           }
+           if (ch >= 0)
+               d = uv_to_utf8(d, ch);
+           
            matches++;
 
            s += hasutf && *s & 0x80 ? UNISKIP(*s) : 1;
@@ -222,7 +213,6 @@ S_do_trans_complex(pTHX_ SV *sv)/* SPC - NOT OK */
 STATIC I32
 S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -293,7 +283,6 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     I32 matches = 0;
@@ -322,7 +311,6 @@ S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */
 STATIC I32
 S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 {
-    dTHR;
     U8 *s;
     U8 *send;
     U8 *d;
@@ -449,7 +437,6 @@ S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */
 I32
 Perl_do_trans(pTHX_ SV *sv)
 {
-    dTHR;
     STRLEN len;
     I32 hasutf = (PL_op->op_private &
                     (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
@@ -517,8 +504,6 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
     }
 
     if (items-- > 0) {
-       char *s;
-
        sv_setpv(sv, "");
        if (*mark)
            sv_catsv(sv, *mark);
@@ -526,10 +511,9 @@ Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **s
     }
     else
        sv_setpv(sv,"");
-    len = delimlen;
-    if (len) {
+    if (delimlen) {
        for (; items > 0; items--,mark++) {
-           sv_catpvn(sv,delim,len);
+           sv_catsv(sv,del);
            sv_catsv(sv,*mark);
        }
     }
@@ -600,7 +584,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
            }
 #ifdef UV_IS_QUAD
            else if (size == 64) {
-               dTHR;
                if (ckWARN(WARN_PORTABLE))
                    Perl_warner(aTHX_ WARN_PORTABLE,
                                "Bit vector size > 32 non-portable");
@@ -670,7 +653,6 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
                      s[offset + 3];
 #ifdef UV_IS_QUAD
        else if (size == 64) {
-           dTHR;
            if (ckWARN(WARN_PORTABLE))
                Perl_warner(aTHX_ WARN_PORTABLE,
                            "Bit vector size > 32 non-portable");
@@ -758,7 +740,6 @@ Perl_do_vecset(pTHX_ SV *sv)
        }
 #ifdef UV_IS_QUAD
        else if (size == 64) {
-           dTHR;
            if (ckWARN(WARN_PORTABLE))
                Perl_warner(aTHX_ WARN_PORTABLE,
                            "Bit vector size > 32 non-portable");
@@ -781,7 +762,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 {
     STRLEN len;
     char *s;
-    dTHR;
 
     if (SvTYPE(sv) == SVt_PVAV) {
        register I32 i;
@@ -843,7 +823,6 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 I32
 Perl_do_chomp(pTHX_ register SV *sv)
 {
-    dTHR;
     register I32 count;
     STRLEN len;
     char *s;
@@ -921,7 +900,6 @@ Perl_do_chomp(pTHX_ register SV *sv)
 void
 Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 {
-    dTHR;      /* just for taint */
 #ifdef LIBERAL
     register long *dl;
     register long *ll;