*
* It is also used to store XS functions that need to be present in
* miniperl for a lack of a better place to put them. It might be
- * clever to move them to seperate XS files which would then be pulled
+ * clever to move them to separate XS files which would then be pulled
* in by some to-be-written build process.
*/
#include "perliol.h" /* For the PERLIO_F_XXX */
#endif
-static HV *
-S_get_isa_hash(pTHX_ HV *const stash)
-{
- dVAR;
- struct mro_meta *const meta = HvMROMETA(stash);
-
- PERL_ARGS_ASSERT_GET_ISA_HASH;
-
- if (!meta->isa) {
- AV *const isa = mro_get_linear_isa(stash);
- if (!meta->isa) {
- HV *const isa_hash = newHV();
- /* Linearisation didn't build it for us, so do it here. */
- SV *const *svp = AvARRAY(isa);
- SV *const *const svp_end = svp + AvFILLp(isa) + 1;
- const HEK *const canon_name = HvNAME_HEK(stash);
-
- while (svp < svp_end) {
- (void) hv_store_ent(isa_hash, *svp++, &PL_sv_undef, 0);
- }
-
- (void) hv_common(isa_hash, NULL, HEK_KEY(canon_name),
- HEK_LEN(canon_name), HEK_FLAGS(canon_name),
- HV_FETCH_ISSTORE, &PL_sv_undef,
- HEK_HASH(canon_name));
- (void) hv_store(isa_hash, "UNIVERSAL", 9, &PL_sv_undef, 0);
-
- SvREADONLY_on(isa_hash);
-
- meta->isa = isa_hash;
- }
- }
- return meta->isa;
-}
-
/*
* Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
* The main guts of traverse_isa was actually copied from gv_fetchmeth
{
dVAR;
const struct mro_meta *const meta = HvMROMETA(stash);
- HV *const isa = meta->isa ? meta->isa : S_get_isa_hash(aTHX_ stash);
+ HV *isa = meta->isa;
STRLEN len = strlen(name);
const HV *our_stash;
PERL_ARGS_ASSERT_ISA_LOOKUP;
+ if (!isa) {
+ (void)mro_get_linear_isa(stash);
+ isa = meta->isa;
+ }
+
if (hv_common(isa, NULL, name, len, 0 /* No "UTF-8" flag possible with only
a char * argument*/,
HV_FETCH_ISEXISTS, NULL, 0)) {
}
/* A stash/class can go by many names (ie. User == main::User), so
- we use the name in the stash itself, which is canonical. */
+ we use the HvENAME in the stash itself, which is canonical, falling
+ back to HvNAME if necessary. */
our_stash = gv_stashpvn(name, len, 0);
if (our_stash) {
- HEK *const canon_name = HvNAME_HEK(our_stash);
+ HEK *canon_name = HvENAME_HEK(our_stash);
+ if (!canon_name) canon_name = HvNAME_HEK(our_stash);
if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name),
HEK_FLAGS(canon_name),
PERL_UNUSED_ARG(cv);
if (items != 2)
- Perl_croak(aTHX_ "Usage: invocant->DOES(kind)");
+ Perl_croak(aTHX_ "Usage: invocand->DOES(kind)");
else {
SV * const sv = ST(0);
const char *name;
Otherwise in list context it returns the pattern and the
modifiers, in scalar context it returns the pattern just as it
would if the qr// was stringified normally, regardless as
- to the class of the variable and any strigification overloads
+ to the class of the variable and any stringification overloads
on the object.
*/
if ( GIMME_V == G_ARRAY ) {
STRLEN left = 0;
- char reflags[sizeof(INT_PAT_MODS) + 1]; /* The +1 is for the charset
- modifier */
+ char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
const char *fptr;
char ch;
U16 match_flags;
/*
we are in list context so stringify
the modifiers that apply. We ignore "negative
- modifiers" in this scenario.
+ modifiers" in this scenario, and the default character set
*/
- if (RX_EXTFLAGS(re) & RXf_PMf_LOCALE) {
- reflags[left++] = LOCALE_PAT_MOD;
- }
- else if (RX_EXTFLAGS(re) & RXf_PMf_UNICODE) {
- reflags[left++] = UNICODE_PAT_MOD;
+ if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
+ STRLEN len;
+ const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
+ &len);
+ Copy(name, reflags + left, len, char);
+ left += len;
}
fptr = INT_PAT_MODS;
- match_flags = (U16)((RX_EXTFLAGS(re) & PMf_COMPILETIME)
+ match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
>> RXf_PMf_STD_PMMOD_SHIFT);
while((ch = *fptr++)) {