/* ------------------------------- handy.h ------------------------------- */
/* saves machine code for a common noreturn idiom typically used in Newx*() */
-#ifdef __clang__
-#pragma clang diagnostic push
-#pragma clang diagnostic ignored "-Wunused-function"
+#ifdef GCC_DIAG_PRAGMA
+GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
#endif
static void
S_croak_memory_wrap(void)
{
Perl_croak_nocontext("%s",PL_memory_wrap);
}
-#ifdef __clang__
-#pragma clang diagnostic pop
+#ifdef GCC_DIAG_PRAGMA
+GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
#endif
/* ------------------------------- utf8.h ------------------------------- */
/* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
* encoded string at '*dest', updating '*dest' to include it */
- const U8 uv = NATIVE_TO_LATIN1(byte);
-
PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
- if (UNI_IS_INVARIANT(uv))
- *(*dest)++ = UNI_TO_NATIVE(uv);
+ if (NATIVE_BYTE_IS_INVARIANT(byte))
+ *(*dest)++ = byte;
else {
- *(*dest)++ = UTF8_EIGHT_BIT_HI(uv);
- *(*dest)++ = UTF8_EIGHT_BIT_LO(uv);
+ *(*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)
-{
- PERL_ARGS_ASSERT_ISIDFIRST_LAZY;
+A helper function for the macro isUTF8_CHAR(), which should be used instead of
+this function. The macro will handle smaller code points directly saving time,
+using this function as a fall-back for higher code points.
- return isIDFIRST_lazy_if(p,1);
-}
+Tests if the first bytes of string C<s> form a valid UTF-8 character. 0 is
+returned if the bytes starting at C<s> up to but not including C<e> do not form a
+complete well-formed UTF-8 character; otherwise the number of bytes in the
+character is returned.
-PERL_STATIC_INLINE bool
-S_isALNUM_lazy(pTHX_ const char* p)
+Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a valid UTF-8
+character.
+
+=cut */
+PERL_STATIC_INLINE STRLEN
+S__is_utf8_char_slow(const U8 *s, const U8 *e)
{
- PERL_ARGS_ASSERT_ISALNUM_LAZY;
+ dTHX; /* The function called below requires thread context */
+
+ STRLEN actual_len;
+
+ PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW;
- return isALNUM_lazy_if(p,1);
+ assert(e >= s);
+ utf8n_to_uvchr(s, e - s, &actual_len, UTF8_CHECK_ONLY);
+
+ return (actual_len == (STRLEN) -1) ? 0 : actual_len;
}
/* ------------------------------- perl.h ----------------------------- */
/*
-=for apidoc AiR|bool|is_safe_syscall|SV *pv|const char *what|const char *op_name
+=head1 Miscellaneous Functions
+
+=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.
+Test that the given C<pv> doesn't contain any internal C<NUL> characters.
If it does, set C<errno> to ENOENT, optionally warn, and return FALSE.
Return TRUE if the name is safe.
*/
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);
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;
}
}
}
/*
+
+Return true if the supplied filename has a newline character
+immediately before the final NUL.
+
+My original look at this incorrectly used the len from SvPV(), but
+that's incorrect, since we allow for a NUL in pv[len-1].
+
+So instead, strlen() and work from there.
+
+This allow for the user reading a filename, forgetting to chomp it,
+then calling:
+
+ open my $foo, "$file\0";
+
+*/
+
+#ifdef PERL_CORE
+
+PERL_STATIC_INLINE bool
+S_should_warn_nl(const char *pv) {
+ STRLEN len;
+
+ PERL_ARGS_ASSERT_SHOULD_WARN_NL;
+
+ len = strlen(pv);
+
+ return len > 0 && pv[len-1] == '\n';
+}
+
+#endif
+
+/* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
+
+#define MAX_CHARSET_NAME_LENGTH 2
+
+PERL_STATIC_INLINE const char *
+get_regex_charset_name(const U32 flags, STRLEN* const lenp)
+{
+ /* Returns a string that corresponds to the name of the regex character set
+ * given by 'flags', and *lenp is set the length of that string, which
+ * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
+
+ *lenp = 1;
+ switch (get_regex_charset(flags)) {
+ case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
+ case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS;
+ case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
+ case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
+ case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
+ *lenp = 2;
+ return ASCII_MORE_RESTRICT_PAT_MODS;
+ }
+ /* The NOT_REACHED; hides an assert() which has a rather complex
+ * definition in perl.h. */
+ NOT_REACHED; /* NOTREACHED */
+ return "?"; /* Unknown */
+}
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
https://perl5.git.perl.org / perl5.git / blobdiff