Change regexec.c to use new foldEQ functions

[perl5.git] / util.c

diff --git a/util.c b/util.c
index 2eb2cc1..d5f0f1f 100644 (file)
--- a/util.c
+++ b/util.c
@@ -878,37 +878,58 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     return NULL;
 }
 
+/*
+=for apidoc foldEQ
+
+Returns true if the leading len bytes of the strings s1 and s2 are the same
+case-insensitively; false otherwise.  Uppercase and lowercase ASCII range bytes
+match themselves and their opposite case counterparts.  Non-cased and non-ASCII
+range bytes match only themselves.
+
+=cut
+*/
+
+
 I32
-Perl_ibcmp(const char *s1, const char *s2, register I32 len)
+Perl_foldEQ(const char *s1, const char *s2, register I32 len)
 {
     register const U8 *a = (const U8 *)s1;
     register const U8 *b = (const U8 *)s2;
 
-    PERL_ARGS_ASSERT_IBCMP;
+    PERL_ARGS_ASSERT_FOLDEQ;
 
     while (len--) {
        if (*a != *b && *a != PL_fold[*b])
-           return 1;
+           return 0;
        a++,b++;
     }
-    return 0;
+    return 1;
 }
 
+/*
+=for apidoc foldEQ_locale
+
+Returns true if the leading len bytes of the strings s1 and s2 are the same
+case-insensitively in the current locale; false otherwise.
+
+=cut
+*/
+
 I32
-Perl_ibcmp_locale(const char *s1, const char *s2, register I32 len)
+Perl_foldEQ_locale(const char *s1, const char *s2, register I32 len)
 {
     dVAR;
     register const U8 *a = (const U8 *)s1;
     register const U8 *b = (const U8 *)s2;
 
-    PERL_ARGS_ASSERT_IBCMP_LOCALE;
+    PERL_ARGS_ASSERT_FOLDEQ_LOCALE;
 
     while (len--) {
        if (*a != *b && *a != PL_fold_locale[*b])
-           return 1;
+           return 0;
        a++,b++;
     }
-    return 0;
+    return 1;
 }
 
 /* copy a string to a safe spot */
@@ -3832,46 +3853,6 @@ Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
     }
 }
 
-#ifdef EBCDIC
-/* in ASCII order, not that it matters */
-static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
-
-int
-Perl_ebcdic_control(pTHX_ int ch)
-{
-    if (ch > 'a') {
-       const char *ctlp;
-
-       if (islower(ch))
-           ch = toupper(ch);
-
-       if ((ctlp = strchr(controllablechars, ch)) == 0) {
-           Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
-       }
-
-       if (ctlp == controllablechars)
-           return('\177'); /* DEL */
-       else
-           return((unsigned char)(ctlp - controllablechars - 1));
-    } else { /* Want uncontrol */
-       if (ch == '\177' || ch == -1)
-           return('?');
-       else if (ch == '\157')
-           return('\177');
-       else if (ch == '\174')
-           return('\000');
-       else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
-           return('\036');
-       else if (ch == '\155')
-           return('\037');
-       else if (0 < ch && ch < (sizeof(controllablechars) - 1))
-           return(controllablechars[ch+1]);
-       else
-           Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
-    }
-}
-#endif
-
 /* XXX Add documentation after final interface and behavior is decided */
 /* May want to show context for error, so would pass Perl_bslash_c(pTHX_ const char* current, const char* start, const bool output_warning)
     U8 source = *current;
@@ -3895,10 +3876,18 @@ Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning)
            Perl_croak(aTHX_ "It is proposed that \"\\c{\" no longer be valid. It has historically evaluated to\n \";\".  If you disagree with this proposal, send email to perl5-porters@perl.org\nOtherwise, or in the meantime, you can work around this failure by changing\n\"\\c{\" to \";\"");
        }
        else if (output_warning) {
+           U8 clearer[3];
+           U8 i = 0;
+           if (! isALNUM(result)) {
+               clearer[i++] = '\\';
+           }
+           clearer[i++] = result;
+           clearer[i++] = '\0';
+
            Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                           "\"\\c%c\" more clearly written simply as \"%c\"",
+                           "\"\\c%c\" more clearly written simply as \"%s\"",
                            source,
-                           result);
+                           clearer);
        }
     }
 
@@ -4522,7 +4511,7 @@ dotted_decimal_version:
            saw_decimal++;
            d++;
        }
-       else if (!*d || *d == ';' || isSPACE(*d) || *d == '}') {
+       else if (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') {
            if ( d == s ) {
                /* found nothing */
                BADVERSION(s,errstr,"Invalid version format (version required)");
@@ -4553,7 +4542,7 @@ dotted_decimal_version:
 
        /* scan the fractional part after the decimal point*/
 
-       if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '}') )) {
+       if (!isDIGIT(*d) && (strict || ! (!*d || *d == ';' || isSPACE(*d) || *d == '{' || *d == '}') )) {
                /* strict or lax-but-not-the-end */
                BADVERSION(s,errstr,"Invalid version format (fractional part required)");
        }
@@ -4591,7 +4580,7 @@ version_prescan_finish:
     while (isSPACE(*d))
        d++;
 
-    if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '}') )) {
+    if (!isDIGIT(*d) && (! (!*d || *d == ';' || *d == '{' || *d == '}') )) {
        /* trailing non-numeric data */
        BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
     }