ApdR |bool |sv_derived_from_pvn|NN SV* sv|NN const char *const name \
|STRLEN len|U32 flags
ApdR |bool |sv_does |NN SV* sv|NN const char *const name
+ApdR |bool |sv_does_sv |NN SV* sv|NN SV* namesv|U32 flags
+ApdR |bool |sv_does_pv |NN SV* sv|NN const char *const name|U32 flags
+ApdR |bool |sv_does_pvn |NN SV* sv|NN const char *const name|const STRLEN len \
+ |U32 flags
Amd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2
Apd |I32 |sv_eq_flags |NULLOK SV* sv1|NULLOK SV* sv2|const U32 flags
Apd |void |sv_free |NULLOK SV *const sv
#define sv_derived_from_sv(a,b,c) Perl_sv_derived_from_sv(aTHX_ a,b,c)
#define sv_destroyable(a) Perl_sv_destroyable(aTHX_ a)
#define sv_does(a,b) Perl_sv_does(aTHX_ a,b)
+#define sv_does_pv(a,b,c) Perl_sv_does_pv(aTHX_ a,b,c)
+#define sv_does_pvn(a,b,c,d) Perl_sv_does_pvn(aTHX_ a,b,c,d)
+#define sv_does_sv(a,b,c) Perl_sv_does_sv(aTHX_ a,b,c)
#define sv_dump(a) Perl_sv_dump(aTHX_ a)
#define sv_eq_flags(a,b,c) Perl_sv_eq_flags(aTHX_ a,b,c)
#define sv_force_normal_flags(a,b) Perl_sv_force_normal_flags(aTHX_ a,b)
#define sv_clean_objs() Perl_sv_clean_objs(aTHX)
#define sv_del_backref(a,b) Perl_sv_del_backref(aTHX_ a,b)
#define sv_free_arenas() Perl_sv_free_arenas(aTHX)
+#define sv_ref(a,b,c) Perl_sv_ref(aTHX_ a,b,c)
#define sv_sethek(a,b) Perl_sv_sethek(aTHX_ a,b)
#ifndef PERL_IMPLICIT_CONTEXT
#define tied_method Perl_tied_method
#define PERL_ARGS_ASSERT_SV_DOES \
assert(sv); assert(name)
+PERL_CALLCONV bool Perl_sv_does_pv(pTHX_ SV* sv, const char *const name, U32 flags)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SV_DOES_PV \
+ assert(sv); assert(name)
+
+PERL_CALLCONV bool Perl_sv_does_pvn(pTHX_ SV* sv, const char *const name, const STRLEN len, U32 flags)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SV_DOES_PVN \
+ assert(sv); assert(name)
+
+PERL_CALLCONV bool Perl_sv_does_sv(pTHX_ SV* sv, SV* namesv, U32 flags)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SV_DOES_SV \
+ assert(sv); assert(namesv)
+
PERL_CALLCONV void Perl_sv_dump(pTHX_ SV* sv)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_SV_DUMP \
#define PERL_ARGS_ASSERT_SV_RECODE_TO_UTF8 \
assert(sv); assert(encoding)
+PERL_CALLCONV SV* Perl_sv_ref(pTHX_ SV *dst, const SV *const sv, const int ob)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SV_REF \
+ assert(sv)
+
PERL_CALLCONV const char* Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1);
#include "XSUB.h"
bool
-Perl_sv_does(pTHX_ SV *sv, const char *const name)
+Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags)
{
- const char *classname;
+ SV *classname;
bool does_it;
SV *methodname;
dSP;
- PERL_ARGS_ASSERT_SV_DOES;
+ PERL_ARGS_ASSERT_SV_DOES_SV;
+ PERL_UNUSED_ARG(flags);
ENTER;
SAVETMPS;
}
if (sv_isobject(sv)) {
- classname = sv_reftype(SvRV(sv),TRUE);
+ classname = sv_ref(NULL,SvRV(sv),TRUE);
} else {
- classname = SvPV_nolen(sv);
+ classname = sv;
}
- if (strEQ(name,classname)) {
+ if (sv_eq(classname, namesv)) {
LEAVE;
return TRUE;
}
PUSHMARK(SP);
- XPUSHs(sv);
- mXPUSHs(newSVpv(name, 0));
+ EXTEND(SP, 2);
+ PUSHs(sv);
+ PUSHs(namesv);
PUTBACK;
methodname = newSVpvs_flags("isa", SVs_TEMP);
}
/*
+=for apidoc sv_does
+
+Exactly like L</sv_does_pv>, but doesn't take a C<flags> parameter.
+
+=cut
+*/
+
+bool
+Perl_sv_does(pTHX_ SV *sv, const char *const name)
+{
+ PERL_ARGS_ASSERT_SV_DOES;
+ return sv_does_sv(sv, newSVpvn_flags(name, strlen(name), SVs_TEMP), 0);
+}
+
+/*
+=for apidoc sv_does_pv
+
+Exactly like L</sv_does_pvn>, but takes a nul-terminated string
+instead of a string/length pair.
+
+=cut
+*/
+
+
+bool
+Perl_sv_does_pv(pTHX_ SV *sv, const char *const name, U32 flags)
+{
+ PERL_ARGS_ASSERT_SV_DOES_PV;
+ return sv_does_sv(sv, newSVpvn_flags(name, strlen(name), SVs_TEMP | flags), flags);
+}
+
+bool
+Perl_sv_does_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len, U32 flags)
+{
+ PERL_ARGS_ASSERT_SV_DOES_PVN;
+
+ return sv_does_sv(sv, newSVpvn_flags(name, len, flags | SVs_TEMP), flags);
+}
+
+/*
=for apidoc croak_xs_usage
A specialised variant of C<croak()> for emitting the usage message for xsubs
Perl_croak(aTHX_ "Usage: invocant->DOES(kind)");
else {
SV * const sv = ST(0);
- const char *name;
-
- name = SvPV_nolen_const(ST(1));
- if (sv_does( sv, name ))
+ if (sv_does_sv( sv, ST(1), 0 ))
XSRETURN_YES;
XSRETURN_NO;