X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f8c1150140e8f939dc97b3c3554dd59f92b7b0af..ea5399c22ee9b4d69814e9c8ab7ba1862e4bc8e6:/mathoms.c diff --git a/mathoms.c b/mathoms.c index 880d0cd..194c83f 100644 --- a/mathoms.c +++ b/mathoms.c @@ -71,6 +71,10 @@ C<-Accflags='-DNO_MATHOMS'> */ #else +/* The functions in this file should be able to call other deprecated functions + * without a compiler warning */ +GCC_DIAG_IGNORE(-Wdeprecated-declarations) + /* ref() is now a macro using Perl_doref; * this version provided for binary compatibility only. */ @@ -518,7 +522,7 @@ int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) { int ret = 0; - va_list(arglist); + va_list arglist; /* Easier to special case this here than in embed.pl. (Look at what it generates for proto.h) */ @@ -536,7 +540,7 @@ int Perl_printf_nocontext(const char *format, ...) { dTHX; - va_list(arglist); + va_list arglist; int ret = 0; #ifdef PERL_IMPLICIT_CONTEXT @@ -690,7 +694,7 @@ Perl_init_i18nl14n(pTHX_ int printwarn) } bool -Perl_is_utf8_string_loc(const U8 *s, STRLEN len, const U8 **ep) +Perl_is_utf8_string_loc(const U8 *s, const STRLEN len, const U8 **ep) { PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC; @@ -727,6 +731,10 @@ potentially warn under some level of strict-ness. "Superseded" by C. =cut + +PERL_UNLOCK_HOOK in intrpvar.h is the macro that refers to this, and guarantees +that mathoms gets loaded. + */ void @@ -819,7 +827,7 @@ C instead. =cut */ -I32 +SSize_t Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags) @@ -865,8 +873,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) { PERL_ARGS_ASSERT_HV_EXISTS_ENT; - return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash) - ? TRUE : FALSE; + return cBOOL(hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)); } HE * @@ -927,8 +934,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) klen = klen_i32; flags = 0; } - return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0) - ? TRUE : FALSE; + return cBOOL(hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)); } SV** @@ -1083,6 +1089,7 @@ Perl_sv_eq(pTHX_ SV *sv1, SV *sv2) char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp) { + PERL_ARGS_ASSERT_SV_COLLXFRM; return sv_collxfrm_flags(sv, nxp, SV_GMAGIC); } @@ -1102,6 +1109,7 @@ Perl_mem_collxfrm(pTHX_ const char *input_string, STRLEN len, STRLEN *xlen) bool Perl_sv_2bool(pTHX_ SV *const sv) { + PERL_ARGS_ASSERT_SV_2BOOL; return sv_2bool_flags(sv, SV_GMAGIC); } @@ -1140,38 +1148,6 @@ Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block) return newATTRSUB(floor, o, proto, NULL, block); } -UV -Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) -{ - PERL_ARGS_ASSERT_TO_UTF8_FOLD; - - return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL); -} - -UV -Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) -{ - PERL_ARGS_ASSERT_TO_UTF8_LOWER; - - return _to_utf8_lower_flags(p, ustrp, lenp, FALSE); -} - -UV -Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) -{ - PERL_ARGS_ASSERT_TO_UTF8_TITLE; - - return _to_utf8_title_flags(p, ustrp, lenp, FALSE); -} - -UV -Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) -{ - PERL_ARGS_ASSERT_TO_UTF8_UPPER; - - return _to_utf8_upper_flags(p, ustrp, lenp, FALSE); -} - SV * Perl_sv_mortalcopy(pTHX_ SV *const oldstr) { @@ -1183,7 +1159,7 @@ Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv) { PERL_ARGS_ASSERT_SV_COPYPV; - sv_copypv_flags(dsv, ssv, 0); + sv_copypv_flags(dsv, ssv, SV_GMAGIC); } UV /* Made into a function, so can be deprecated */ @@ -1200,22 +1176,6 @@ ASCII_TO_NEED(const UV enc, const UV ch) return ch; } -bool /* Made into a function, so can be deprecated */ -Perl_isIDFIRST_lazy(pTHX_ const char* p) -{ - PERL_ARGS_ASSERT_ISIDFIRST_LAZY; - - return isIDFIRST_lazy_if(p,1); -} - -bool /* Made into a function, so can be deprecated */ -Perl_isALNUM_lazy(pTHX_ const char* p) -{ - PERL_ARGS_ASSERT_ISALNUM_LAZY; - - return isALNUM_lazy_if(p,1); -} - bool Perl_is_uni_alnum(pTHX_ UV c) { @@ -1377,38 +1337,6 @@ Perl_is_uni_idfirst(pTHX_ UV c) } bool -Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */ -{ - PERL_ARGS_ASSERT_IS_UTF8_IDFIRST; - - return _is_utf8_idstart(p); -} - -bool -Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */ -{ - PERL_ARGS_ASSERT_IS_UTF8_XIDFIRST; - - return _is_utf8_xidstart(p); -} - -bool -Perl_is_utf8_idcont(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_IDCONT; - - return _is_utf8_idcont(p); -} - -bool -Perl_is_utf8_xidcont(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_XIDCONT; - - return _is_utf8_xidcont(p); -} - -bool Perl_is_uni_upper_lc(pTHX_ UV c) { return isUPPER_LC_uvchr(c); @@ -1481,159 +1409,6 @@ Perl_to_uni_lower_lc(pTHX_ U32 c) } bool -Perl_is_utf8_alnum(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_ALNUM; - - /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true - * descendant of isalnum(3), in other words, it doesn't - * contain the '_'. --jhi */ - return isWORDCHAR_utf8(p); -} - -bool -Perl_is_utf8_alnumc(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_ALNUMC; - - return isALPHANUMERIC_utf8(p); -} - -bool -Perl_is_utf8_alpha(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_ALPHA; - - return isALPHA_utf8(p); -} - -bool -Perl_is_utf8_ascii(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_ASCII; - PERL_UNUSED_CONTEXT; - - return isASCII_utf8(p); -} - -bool -Perl_is_utf8_blank(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_BLANK; - PERL_UNUSED_CONTEXT; - - return isBLANK_utf8(p); -} - -bool -Perl_is_utf8_space(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_SPACE; - PERL_UNUSED_CONTEXT; - - return isSPACE_utf8(p); -} - -bool -Perl_is_utf8_perl_space(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE; - PERL_UNUSED_CONTEXT; - - /* Only true if is an ASCII space-like character, and ASCII is invariant - * under utf8, so can just use the macro */ - return isSPACE_A(*p); -} - -bool -Perl_is_utf8_perl_word(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD; - PERL_UNUSED_CONTEXT; - - /* Only true if is an ASCII word character, and ASCII is invariant - * under utf8, so can just use the macro */ - return isWORDCHAR_A(*p); -} - -bool -Perl_is_utf8_digit(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_DIGIT; - - return isDIGIT_utf8(p); -} - -bool -Perl_is_utf8_posix_digit(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT; - PERL_UNUSED_CONTEXT; - - /* Only true if is an ASCII digit character, and ASCII is invariant - * under utf8, so can just use the macro */ - return isDIGIT_A(*p); -} - -bool -Perl_is_utf8_upper(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_UPPER; - - return isUPPER_utf8(p); -} - -bool -Perl_is_utf8_lower(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_LOWER; - - return isLOWER_utf8(p); -} - -bool -Perl_is_utf8_cntrl(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_CNTRL; - PERL_UNUSED_CONTEXT; - - return isCNTRL_utf8(p); -} - -bool -Perl_is_utf8_graph(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_GRAPH; - - return isGRAPH_utf8(p); -} - -bool -Perl_is_utf8_print(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_PRINT; - - return isPRINT_utf8(p); -} - -bool -Perl_is_utf8_punct(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_PUNCT; - - return isPUNCT_utf8(p); -} - -bool -Perl_is_utf8_xdigit(pTHX_ const U8 *p) -{ - PERL_ARGS_ASSERT_IS_UTF8_XDIGIT; - PERL_UNUSED_CONTEXT; - - return isXDIGIT_utf8(p); -} - -bool Perl_is_utf8_mark(pTHX_ const U8 *p) { PERL_ARGS_ASSERT_IS_UTF8_MARK; @@ -1660,14 +1435,15 @@ Perl_is_utf8_char(const U8 *s) { PERL_ARGS_ASSERT_IS_UTF8_CHAR; - /* Assumes we have enough space, which is why this is deprecated */ - return isUTF8_CHAR(s, s + UTF8SKIP(s)); + /* Assumes we have enough space, which is why this is deprecated. But the + * strnlen() makes it safe for the common case of NUL-terminated strings */ + return isUTF8_CHAR(s, s + my_strnlen((char *) s, UTF8SKIP(s))); } /* =for apidoc is_utf8_char_buf -This is identical to the macro L. +This is identical to the macro L. =cut */ @@ -1688,42 +1464,13 @@ Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end) UV Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen) { + PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI; return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen)); } /* -=for apidoc utf8_to_uvchr - -Returns the native code point of the first character in the string C -which is assumed to be in UTF-8 encoding; C will be set to the -length, in bytes, of that character. - -Some, but not all, UTF-8 malformations are detected, and in fact, some -malformed input could cause reading beyond the end of the input buffer, which -is why this function is deprecated. Use L instead. - -If C points to one of the detected malformations, and UTF8 warnings are -enabled, zero is returned and C<*retlen> is set (if C isn't -C) to -1. If those warnings are off, the computed value if well-defined (or -the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen> -is set (if C isn't NULL) so that (S + C<*retlen>>) is the -next possible position in C that could begin a non-malformed character. -See L for details on when the REPLACEMENT CHARACTER is returned. - -=cut -*/ - -UV -Perl_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen) -{ - PERL_ARGS_ASSERT_UTF8_TO_UVCHR; - - return utf8_to_uvchr_buf(s, s + UTF8_MAXBYTES, retlen); -} - -/* =for apidoc utf8_to_uvuni Returns the Unicode code point of the first character in the string C @@ -1742,7 +1489,7 @@ NULL) to -1. If those warnings are off, the computed value if well-defined (or the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen> is set (if C isn't NULL) so that (S + C<*retlen>>) is the next possible position in C that could begin a non-malformed character. -See L for details on when the REPLACEMENT CHARACTER is returned. +See L for details on when the REPLACEMENT CHARACTER is returned. =cut */ @@ -1750,13 +1497,14 @@ See L for details on when the REPLACEMENT CHARACTER is returned UV Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen) { + PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_UTF8_TO_UVUNI; return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen)); } /* -=for apidoc Am|HV *|pad_compname_type|PADOFFSET po +=for apidoc pad_compname_type Looks up the type of the lexical variable at position C in the currently-compiling pad. If the variable is typed, the stash of the @@ -1782,6 +1530,38 @@ Perl_instr(const char *big, const char *little) return instr((char *) big, (char *) little); } +SV * +Perl_newSVsv(pTHX_ SV *const old) +{ + return newSVsv(old); +} + +bool +Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok) +{ + PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE; + + return sv_utf8_downgrade(sv, fail_ok); +} + +char * +Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp) +{ + PERL_ARGS_ASSERT_SV_2PVUTF8; + + return sv_2pvutf8(sv, lp); +} + +char * +Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp) +{ + PERL_ARGS_ASSERT_SV_2PVBYTE; + + return sv_2pvbyte(sv, lp); +} + +GCC_DIAG_RESTORE + #endif /* NO_MATHOMS */ /*