This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
ExtUtils::Install was upgraded to 1.65 by 9345802d17
[perl5.git] / inline.h
index 86deaf5..518d8da 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -201,10 +201,73 @@ S_croak_memory_wrap(void)
 #pragma clang diagnostic pop
 #endif
 
+#ifdef BOOTSTRAP_CHARSET
+static bool
+S_bootstrap_ctype(U8 character, UV classnum, bool full_Latin1)
+{
+    /* See comments in handy.h.  This is placed in this file primarily to avoid
+     * having to have an entry for it in embed.fnc */
+
+    dTHX;
+
+    if (! full_Latin1 && ! isASCII(character)) {
+        return FALSE;
+    }
+
+    switch (classnum) {
+        case _CC_ALPHANUMERIC: return isALPHANUMERIC_L1(character);
+        case _CC_ALPHA:     return isALPHA_L1(character);
+        case _CC_ASCII:     return isASCII_L1(character);
+        case _CC_BLANK:     return isBLANK_L1(character);
+        case _CC_CASED:     return isLOWER_L1(character)
+                                   || isUPPER_L1(character);
+        case _CC_CNTRL:     return isCNTRL_L1(character);
+        case _CC_DIGIT:     return isDIGIT_L1(character);
+        case _CC_GRAPH:     return isGRAPH_L1(character);
+        case _CC_LOWER:     return isLOWER_L1(character);
+        case _CC_PRINT:     return isPRINT_L1(character);
+        case _CC_PSXSPC:    return isPSXSPC_L1(character);
+        case _CC_PUNCT:     return isPUNCT_L1(character);
+        case _CC_SPACE:     return isSPACE_L1(character);
+        case _CC_UPPER:     return isUPPER_L1(character);
+        case _CC_WORDCHAR:  return isWORDCHAR_L1(character);
+        case _CC_XDIGIT:    return isXDIGIT_L1(character);
+        case _CC_VERTSPACE: return isSPACE_L1(character) && ! isBLANK_L1(character);
+        case _CC_IDFIRST:   return isIDFIRST_L1(character);
+        case _CC_QUOTEMETA: return _isQUOTEMETA(character);
+        case _CC_CHARNAME_CONT: return isCHARNAME_CONT(character);
+        case _CC_NONLATIN1_FOLD: return _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(character);
+        case _CC_NON_FINAL_FOLD: return _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(character);
+        case _CC_IS_IN_SOME_FOLD: return _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(character);
+        case _CC_BACKSLASH_FOO_LBRACE_IS_META: return 0;
+
+
+        default: break;
+    }
+    Perl_croak(aTHX_ "panic: bootstrap_ctype() has an unexpected character class '%" UVxf "'", classnum);
+}
+#endif
+
 /* ------------------------------- utf8.h ------------------------------- */
 
-/* These exist only to replace the macros they formerly were so that their use
- * can be deprecated */
+PERL_STATIC_INLINE void
+S_append_utf8_from_native_byte(const U8 byte, U8** dest)
+{
+    /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
+     * encoded string at '*dest', updating '*dest' to include it */
+
+    PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
+
+    if (NATIVE_BYTE_IS_INVARIANT(byte))
+        *(*dest)++ = byte;
+    else {
+        *(*dest)++ = UTF8_EIGHT_BIT_HI(byte);
+        *(*dest)++ = UTF8_EIGHT_BIT_LO(byte);
+    }
+}
+
+/* These two exist only to replace the macros they formerly were so that their
+ * use can be deprecated */
 
 PERL_STATIC_INLINE bool
 S_isIDFIRST_lazy(pTHX_ const char* p)
@@ -225,7 +288,7 @@ S_isALNUM_lazy(pTHX_ const char* p)
 /* ------------------------------- perl.h ----------------------------- */
 
 /*
-=for apidoc AiR|bool|is_safe_syscall|SV *pv|const char *what|const char *op_name
+=for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
 
 Test that the given C<pv> doesn't contain any internal NUL characters.
 If it does, set C<errno> to ENOENT, optionally warn, and return FALSE.
@@ -238,23 +301,20 @@ Used by the IS_SAFE_SYSCALL() macro.
 */
 
 PERL_STATIC_INLINE bool
-S_is_safe_syscall(pTHX_ SV *pv, const char *what, const char *op_name) {
+S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) {
     /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
      * perl itself uses xce*() functions which accept 8-bit strings.
      */
 
     PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
 
-    if (SvPOK(pv) && SvCUR(pv) >= 1) {
-        char *p = SvPVX(pv);
+    if (pv && len > 1) {
         char *null_at;
-        if (UNLIKELY((null_at = (char *)memchr(p, 0, SvCUR(pv)-1)) != NULL)) {
+        if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
                 SETERRNO(ENOENT, LIB_INVARG);
-                if (ckWARN(WARN_SYSCALLS)) {
-                    Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
+                Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
                                    "Invalid \\0 character in %s for %s: %s\\0%s",
-                                   what, op_name, p, null_at+1);
-                }
+                                   what, op_name, pv, null_at+1);
                 return FALSE;
         }
     }