This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_sys.c: Generalize -B, -T for EBCDIC, clean up
authorKarl Williamson <khw@cpan.org>
Thu, 21 Aug 2014 18:10:39 +0000 (12:10 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 21 Aug 2014 18:58:38 +0000 (12:58 -0600)
There was discussion about extending these to work for Latin1,
(http://nntp.perl.org/group/perl.perl5.porters/214950 and following)
but in the end it was decided that this is a heuristic, and perturbing
that might break things.  So this patch keeps the same criteria as
before, but refactors things so it isn't ASCII-platform-centric.

However, the version it replaces checked for utf8ness piece-meal,
leading to possibly incorrect results, which this fixes.  If a buffer
isn't entirely UTF-8, then it can't be UTF-8.  So this uses
is_utf8_string() instead of reimplementing the utf8ness checks, and does
it for the buffer as a whole.

And, there was an inapproptiate test for ALPHA under locale that this
removes.  The test for locale non-strange characters is that they be
either printable or space (things like \t are space but not printable).

pp_sys.c

index e01cf48..642214e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3434,7 +3434,6 @@ PP(pp_fttext)
     }
 
     /* now scan s to look for textiness */
-    /*   XXX ASCII dependent code */
 
 #if defined(DOSISH) || defined(USEMYBINMODE)
     /* ignore trailing ^Z on short files */
@@ -3442,43 +3441,53 @@ PP(pp_fttext)
        --len;
 #endif
 
+    assert(len);
+    if (! is_ascii_string((U8 *) s, len)) {
+        const U8 *ep;
+
+        /* Here contains a non-ASCII.  See if the entire string is UTF-8.  But
+         * the buffer may end in a partial character, so consider it UTF-8 if
+         * the first non-UTF8 char is an ending partial */
+        if (is_utf8_string_loc((U8 *) s, len, &ep)
+            || ep + UTF8SKIP(ep)  > (U8 *) (s + len))
+        {
+            if (PL_op->op_type == OP_FTTEXT) {
+                FT_RETURNYES;
+            }
+            else {
+                FT_RETURNNO;
+            }
+        }
+    }
+
+    /* Here, is not UTF-8 or is entirely ASCII.  Look through the buffer for
+     * things that wouldn't be in ASCII text or rich ASCII text.  Count these
+     * in 'odd' */
     for (i = 0; i < len; i++, s++) {
        if (!*s) {                      /* null never allowed in text */
            odd += len;
            break;
        }
-#ifdef EBCDIC
-        else if (!(isPRINT(*s) || isSPACE(*s)))
-            odd++;
-#else
-       else if (*s & 128) {
 #ifdef USE_LOCALE_CTYPE
-           if (IN_LC_RUNTIME(LC_CTYPE) && isALPHA_LC(*s))
+        if (IN_LC_RUNTIME(LC_CTYPE)) {
+            if ( isPRINT_LC(*s) || isSPACE_LC(*s)) {
                continue;
+            }
+        }
+        else
 #endif
-           /* utf8 characters don't count as odd */
-           if (UTF8_IS_START(*s)) {
-               int ulen = UTF8SKIP(s);
-               if (ulen < len - i) {
-                   int j;
-                   for (j = 1; j < ulen; j++) {
-                       if (!UTF8_IS_CONTINUATION(s[j]))
-                           goto not_utf8;
-                   }
-                   --ulen;     /* loop does extra increment */
-                   s += ulen;
-                   i += ulen;
-                   continue;
-               }
-           }
-         not_utf8:
-           odd++;
-       }
-       else if (*s < 32 &&
-         *s != '\n' && *s != '\r' && *s != '\b' &&
-         *s != '\t' && *s != '\f' && *s != 27)
-           odd++;
-#endif
+        if (isPRINT_A(*s)
+                   /* VT occurs so rarely in text, that we consider it odd */
+                || (isSPACE_A(*s) && *s != VT_NATIVE)
+
+                    /* But there is a fair amount of backspaces and escapes in
+                     * some text */
+                || *s == '\b'
+                || *s == ESC_NATIVE)
+        {
+            continue;
+        }
+        odd++;
     }
 
     if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */