-/*
+/*
* This file contains mathoms, various binary artifacts from previous
- * versions of Perl. For binary or source compatibility reasons, though,
- * we cannot completely remove them from the core code.
+ * versions of Perl which we cannot completely remove from the core
+ * code. There are two reasons functions should be here:
+ *
+ * 1) A function has been been replaced by a macro within a minor release,
+ * so XS modules compiled against an older release will expect to
+ * still be able to link against the function
+ * 2) A function Perl_foo(...) with #define foo Perl_foo(aTHX_ ...)
+ * has been replaced by a macro, e.g. #define foo(...) foo_flags(...,0)
+ * but XS code may still explicitly use the long form, i.e.
+ * Perl_foo(aTHX_ ...)
+ *
+ * NOTE: ALL FUNCTIONS IN THIS FILE should have an entry with the 'b' flag in
+ * embed.fnc.
+ *
+ * To move a function to this file, simply cut and paste it here, and change
+ * its embed.fnc entry to additionally have the 'b' flag. If, for some reason
+ * a function you'd like to be treated as mathoms can't be moved from its
+ * current place, simply enclose it between
*
- * SMP - Oct. 24, 2005
+ * #ifndef NO_MATHOMS
+ * ...
+ * #endif
+ *
+ * and add the 'b' flag in embed.fnc.
*
* The compilation of this file can be suppressed; see INSTALL
*
+ * Some blurb for perlapi.pod:
+
+=head1 Obsolete backwards compatibility functions
+
+Some of these are also deprecated. You can exclude these from
+your compiled Perl by adding this option to Configure:
+C<-Accflags='-DNO_MATHOMS'>
+
+=cut
+
*/
+
#include "EXTERN.h"
#define PERL_IN_MATHOMS_C
#include "perl.h"
*/
#else
-/* Not all of these have prototypes elsewhere, so do this to get
- * non-mangled names.
- */
-START_EXTERN_C
-
-PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
-PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
-PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
-PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV *sv);
-PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV *sv);
-PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV *sv);
-PERL_CALLCONV char * Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp);
-PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ SV *sv);
-PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ SV *sv);
-PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ SV *sv);
-PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv);
-PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr);
-PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
-PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
-PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr);
-PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv);
-PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
-PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
-PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
-PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
-PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ SV *sv);
-PERL_CALLCONV NV Perl_huge(void);
-PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
-PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
-PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
-PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
-PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
-PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp);
-PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp);
-PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
-PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
-PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
-PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
-PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
-PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
-PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
-PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
-PERL_CALLCONV AV * Perl_newAV(pTHX);
-PERL_CALLCONV HV * Perl_newHV(pTHX);
-PERL_CALLCONV IO * Perl_newIO(pTHX);
-PERL_CALLCONV I32 Perl_my_stat(pTHX);
-PERL_CALLCONV I32 Perl_my_lstat(pTHX);
-PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2);
-PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
-PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV *const sv);
-PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
-PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
-PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
-PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
-PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
-PERL_CALLCONV SV *Perl_sv_mortalcopy(pTHX_ SV *const oldstr);
+/* 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.
Unsets the RV status of the SV, and decrements the reference count of
whatever was being referenced by the RV. This can almost be thought of
as a reversal of C<newSVrv>. This is C<sv_unref_flags> with the C<flag>
-being zero. See C<SvROK_off>.
+being zero. See C<L</SvROK_off>>.
=cut
*/
Undo various types of fakery on an SV: if the PV is a shared string, make
a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
-an xpvmg. See also C<sv_force_normal_flags>.
+an C<xpvmg>. See also C<L</sv_force_normal_flags>>.
=cut
*/
int
Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
{
- dTHXs;
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) */
Perl_printf_nocontext(const char *format, ...)
{
dTHX;
- va_list(arglist);
+ va_list arglist;
int ret = 0;
#ifdef PERL_IMPLICIT_CONTEXT
}
bool
-Perl_is_utf8_string_loc(pTHX_ 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;
=for apidoc sv_nolocking
Dummy routine which "locks" an SV when there is no locking module present.
-Exists to avoid test for a NULL function pointer and because it could
+Exists to avoid test for a C<NULL> function pointer and because it could
potentially warn under some level of strict-ness.
-"Superseded" by sv_nosharing().
+"Superseded" by C<sv_nosharing()>.
=cut
*/
=for apidoc sv_nounlocking
Dummy routine which "unlocks" an SV when there is no locking module present.
-Exists to avoid test for a NULL function pointer and because it could
+Exists to avoid test for a C<NULL> function pointer and because it could
potentially warn under some level of strict-ness.
-"Superseded" by sv_nosharing().
+"Superseded" by C<sv_nosharing()>.
=cut
+
+PERL_UNLOCK_HOOK in intrpvar.h is the macro that refers to this, and guarantees
+that mathoms gets loaded.
+
*/
void
void
Perl_save_long(pTHX_ long int *longp)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_LONG;
SSCHECK(3);
}
void
-Perl_save_iv(pTHX_ IV *ivp)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_SAVE_IV;
-
- SSCHECK(3);
- SSPUSHIV(*ivp);
- SSPUSHPTR(ivp);
- SSPUSHUV(SAVEt_IV);
-}
-
-void
Perl_save_nogv(pTHX_ GV *gv)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_NOGV;
SSCHECK(2);
void
Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_SAVE_LIST;
Tells an SV to use C<ptr> to find its string value. Implemented by
calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
-magic. See C<sv_usepvn_flags>.
+magic. See C<L</sv_usepvn_flags>>.
=cut
*/
/*
=for apidoc unpack_str
-The engine implementing unpack() Perl function. Note: parameters strbeg,
-new_s and ocnt are not used. This call should not be used, use
-unpackstring instead.
+The engine implementing C<unpack()> Perl function. Note: parameters C<strbeg>,
+C<new_s> and C<ocnt> are not used. This call should not be used, use
+C<unpackstring> 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)
/*
=for apidoc pack_cat
-The engine implementing pack() Perl function. Note: parameters
-next_in_list and flags are not used. This call should not be used; use
-packlist instead.
+The engine implementing C<pack()> Perl function. Note: parameters
+C<next_in_list> and C<flags> are not used. This call should not be used; use
+C<packlist> instead.
=cut
*/
{
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 *
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**
NULL, 0));
}
-/* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
-
AV *
Perl_newAV(pTHX)
{
void
Perl_save_freesv(pTHX_ SV *sv)
{
- dVAR;
save_freesv(sv);
}
void
Perl_save_mortalizesv(pTHX_ SV *sv)
{
- dVAR;
-
PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
save_mortalizesv(sv);
void
Perl_save_freeop(pTHX_ OP *o)
{
- dVAR;
save_freeop(o);
}
void
Perl_save_freepv(pTHX_ char *pv)
{
- dVAR;
save_freepv(pv);
}
void
Perl_save_op(pTHX)
{
- dVAR;
save_op();
}
char *
Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
{
+ PERL_ARGS_ASSERT_SV_COLLXFRM;
return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
}
+
+char *
+Perl_mem_collxfrm(pTHX_ const char *input_string, STRLEN len, STRLEN *xlen)
+{
+ /* This function is retained for compatibility in case someone outside core
+ * is using this (but it is undocumented) */
+
+ PERL_ARGS_ASSERT_MEM_COLLXFRM;
+
+ return _mem_collxfrm(input_string, len, xlen, FALSE);
+}
+
#endif
bool
Perl_sv_2bool(pTHX_ SV *const sv)
{
+ PERL_ARGS_ASSERT_SV_2BOOL;
return sv_2bool_flags(sv, SV_GMAGIC);
}
/*
=for apidoc custom_op_name
-Return the name for a given custom op. This was once used by the OP_NAME
+Return the name for a given custom op. This was once used by the C<OP_NAME>
macro, but is no longer: it has only been kept for compatibility, and
should not be used.
=for apidoc custom_op_desc
Return the description of a given custom op. This was once used by the
-OP_DESC macro, but is no longer: it has only been kept for
+C<OP_DESC> macro, but is no longer: it has only been kept for
compatibility, and should not be used.
=cut
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)
+SV *
+Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
{
- PERL_ARGS_ASSERT_TO_UTF8_TITLE;
-
- return _to_utf8_title_flags(p, ustrp, lenp, FALSE);
+ return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
}
-UV
-Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+void
+Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
{
- PERL_ARGS_ASSERT_TO_UTF8_UPPER;
+ PERL_ARGS_ASSERT_SV_COPYPV;
- return _to_utf8_upper_flags(p, ustrp, lenp, FALSE);
-}
-
-SV *
-Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
-{
- return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
+ sv_copypv_flags(dsv, ssv, SV_GMAGIC);
}
UV /* Made into a function, so can be deprecated */
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)
-{
- return isWORDCHAR_uni(c);
-}
-
-bool
-Perl_is_uni_alnumc(pTHX_ UV c)
-{
- return isALNUM_uni(c);
-}
-
-bool
-Perl_is_uni_alpha(pTHX_ UV c)
-{
- return isALPHA_uni(c);
-}
-
-bool
-Perl_is_uni_ascii(pTHX_ UV c)
-{
- return isASCII_uni(c);
-}
-
-bool
-Perl_is_uni_blank(pTHX_ UV c)
-{
- return isBLANK_uni(c);
-}
-
-bool
-Perl_is_uni_space(pTHX_ UV c)
-{
- return isSPACE_uni(c);
-}
-
-bool
-Perl_is_uni_digit(pTHX_ UV c)
-{
- return isDIGIT_uni(c);
-}
-
-bool
-Perl_is_uni_upper(pTHX_ UV c)
-{
- return isUPPER_uni(c);
-}
-
-bool
-Perl_is_uni_lower(pTHX_ UV c)
-{
- return isLOWER_uni(c);
-}
-
-bool
-Perl_is_uni_cntrl(pTHX_ UV c)
-{
- return isCNTRL_L1(c);
-}
-
-bool
-Perl_is_uni_graph(pTHX_ UV c)
-{
- return isGRAPH_uni(c);
-}
-
-bool
-Perl_is_uni_print(pTHX_ UV c)
-{
- return isPRINT_uni(c);
-}
-
-bool
-Perl_is_uni_punct(pTHX_ UV c)
-{
- return isPUNCT_uni(c);
-}
-
-bool
-Perl_is_uni_xdigit(pTHX_ UV c)
-{
- return isXDIGIT_uni(c);
-}
-
-bool
-Perl_is_uni_alnum_lc(pTHX_ UV c)
-{
- return isWORDCHAR_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_alnumc_lc(pTHX_ UV c)
-{
- return isALPHANUMERIC_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_idfirst_lc(pTHX_ UV c)
-{
- /* XXX Should probably be something that resolves to the old IDFIRST, but
- * this function is deprecated, so not bothering */
- return isIDFIRST_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_alpha_lc(pTHX_ UV c)
-{
- return isALPHA_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_ascii_lc(pTHX_ UV c)
-{
- return isASCII_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_blank_lc(pTHX_ UV c)
-{
- return isBLANK_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_space_lc(pTHX_ UV c)
-{
- return isSPACE_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_digit_lc(pTHX_ UV c)
-{
- return isDIGIT_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_idfirst(pTHX_ UV c)
-{
- U8 tmpbuf[UTF8_MAXBYTES+1];
- uvchr_to_utf8(tmpbuf, c);
- return _is_utf8_idstart(tmpbuf);
-}
-
-bool
-Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
-
- return _is_utf8_idstart(p);
-}
-
-bool
-Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_XIDFIRST;
-
- return _is_utf8_xidstart(p);
-}
-
-bool
-Perl_is_utf8_idcont(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_IDCONT;
-
- return _is_utf8_idcont(p);
-}
-
-bool
-Perl_is_utf8_xidcont(pTHX_ const U8 *p)
-{
- dVAR;
-
- 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);
-}
-
-bool
-Perl_is_uni_lower_lc(pTHX_ UV c)
-{
- return isLOWER_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_cntrl_lc(pTHX_ UV c)
-{
- return isCNTRL_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_graph_lc(pTHX_ UV c)
-{
- return isGRAPH_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_print_lc(pTHX_ UV c)
-{
- return isPRINT_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_punct_lc(pTHX_ UV c)
-{
- return isPUNCT_LC_uvchr(c);
-}
-
-bool
-Perl_is_uni_xdigit_lc(pTHX_ UV c)
-{
- return isXDIGIT_LC_uvchr(c);
-}
-
-U32
-Perl_to_uni_upper_lc(pTHX_ U32 c)
-{
- /* XXX returns only the first character -- do not use XXX */
- /* XXX no locale support yet */
- STRLEN len;
- U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
- return (U32)to_uni_upper(c, tmpbuf, &len);
-}
-
-U32
-Perl_to_uni_title_lc(pTHX_ U32 c)
-{
- /* XXX returns only the first character XXX -- do not use XXX */
- /* XXX no locale support yet */
- STRLEN len;
- U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
- return (U32)to_uni_title(c, tmpbuf, &len);
-}
-
-U32
-Perl_to_uni_lower_lc(pTHX_ U32 c)
-{
- /* XXX returns only the first character -- do not use XXX */
- /* XXX no locale support yet */
- STRLEN len;
- U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
- return (U32)to_uni_lower(c, tmpbuf, &len);
-}
-
-bool
-Perl_is_utf8_alnum(pTHX_ const U8 *p)
-{
- dVAR;
-
- 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)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
-
- return isALPHANUMERIC_utf8(p);
-}
-
-bool
-Perl_is_utf8_alpha(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
-
- return isALPHA_utf8(p);
-}
-
-bool
-Perl_is_utf8_ascii(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_ASCII;
-
- return isASCII_utf8(p);
-}
-
-bool
-Perl_is_utf8_blank(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_BLANK;
-
- return isBLANK_utf8(p);
-}
-
-bool
-Perl_is_utf8_space(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_SPACE;
-
- return isSPACE_utf8(p);
-}
-
-bool
-Perl_is_utf8_perl_space(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE;
-
- /* 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)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD;
-
- /* 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)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
-
- return isDIGIT_utf8(p);
-}
-
-bool
-Perl_is_utf8_posix_digit(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT;
-
- /* 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)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_UPPER;
-
- return isUPPER_utf8(p);
-}
-
-bool
-Perl_is_utf8_lower(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_LOWER;
-
- return isLOWER_utf8(p);
-}
-
-bool
-Perl_is_utf8_cntrl(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
-
- return isCNTRL_utf8(p);
-}
-
-bool
-Perl_is_utf8_graph(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
-
- return isGRAPH_utf8(p);
-}
-
-bool
-Perl_is_utf8_print(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_PRINT;
-
- return isPRINT_utf8(p);
-}
-
-bool
-Perl_is_utf8_punct(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
-
- return isPUNCT_utf8(p);
-}
-
-bool
-Perl_is_utf8_xdigit(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
-
- return isXDIGIT_utf8(p);
-}
-
-bool
-Perl_is_utf8_mark(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_MARK;
-
- return _is_utf8_mark(p);
-}
-
/*
=for apidoc is_utf8_char
{
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<perlapi/isUTF8_CHAR>.
+
+=cut */
+
+STRLEN
+Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end)
+{
+
+ PERL_ARGS_ASSERT_IS_UTF8_CHAR_BUF;
+
+ return isUTF8_CHAR(buf, buf_end);
}
/* DEPRECATED!
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
+=for apidoc utf8_to_uvuni
-Returns the native code point of the first character in the string C<s>
+Returns the Unicode code point of the first character in the string C<s>
which is assumed to be in UTF-8 encoding; C<retlen> 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</utf8_to_uvchr_buf> instead.
+is one reason why this function is deprecated. The other is that only in
+extremely limited circumstances should the Unicode versus native code point be
+of any interest to you. See L</utf8_to_uvuni_buf> for alternatives.
If C<s> points to one of the detected malformations, and UTF8 warnings are
-enabled, zero is returned and C<*retlen> is set (if C<retlen> isn't
+enabled, zero is returned and C<*retlen> is set (if C<retlen> doesn't point to
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<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
next possible position in C<s> that could begin a non-malformed character.
-See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
+See L<perlapi/utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
=cut
*/
UV
-Perl_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
+Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
{
- PERL_ARGS_ASSERT_UTF8_TO_UVCHR;
+ PERL_UNUSED_CONTEXT;
+ PERL_ARGS_ASSERT_UTF8_TO_UVUNI;
- return utf8_to_uvchr_buf(s, s + UTF8_MAXBYTES, retlen);
+ return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen));
}
/*
-=for apidoc utf8_to_uvuni
+=for apidoc pad_compname_type
-Returns the Unicode code point of the first character in the string C<s>
-which is assumed to be in UTF-8 encoding; C<retlen> 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 one reason why this function is deprecated. The other is that only in
-extremely limited circumstances should the Unicode versus native code point be
-of any interest to you. See L</utf8_to_uvuni_buf> for alternatives.
-
-If C<s> points to one of the detected malformations, and UTF8 warnings are
-enabled, zero is returned and C<*retlen> is set (if C<retlen> doesn't point to
-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<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
-next possible position in C<s> that could begin a non-malformed character.
-See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
+Looks up the type of the lexical variable at position C<po> in the
+currently-compiling pad. If the variable is typed, the stash of the
+class to which it is typed is returned. If not, C<NULL> is returned.
=cut
*/
-UV
-Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
{
- PERL_ARGS_ASSERT_UTF8_TO_UVUNI;
+ return PAD_COMPNAME_TYPE(po);
+}
- return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen));
+/* return ptr to little string in big string, NULL if not found */
+/* The original version of this routine was donated by Corey Satten. */
+
+char *
+Perl_instr(const char *big, const char *little)
+{
+ PERL_ARGS_ASSERT_INSTR;
+
+ 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);
}
-END_EXTERN_C
+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 */
/*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
* ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff