a MAGIC structure that contains a pointer to the object associated with the
tie.
+=for apidoc Ayh||MAGIC
+
=cut
*/
if (vtbl && vtbl->svt_free)
vtbl->svt_free(aTHX_ sv, mg);
- if (mg->mg_type == PERL_MAGIC_collxfrm && mg->mg_len >= 0)
- /* collate magic uses string len not buffer len, so
- * free even with mg_len == 0 */
+ if (mg->mg_len > 0)
Safefree(mg->mg_ptr);
- else if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
- if (mg->mg_len > 0 || mg->mg_type == PERL_MAGIC_utf8)
- Safefree(mg->mg_ptr);
- else if (mg->mg_len == HEf_SVKEY)
- SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
- }
+ else if (mg->mg_len == HEf_SVKEY)
+ SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
if (mg->mg_flags & MGf_REFCOUNTED)
SvREFCNT_dec(mg->mg_obj);
}
/*
-=for apidoc_section Errno
+=for apidoc_section $errno
=for apidoc sv_string_from_errnum
Generates the message string describing an OS error and returns it as
}
/*
-=for apidoc_section Magic
+=for apidoc_section $magic
=for apidoc magic_methcall
Invoke a magic method (like FETCH).
return 0;
}
+
+int
+Perl_magic_freemglob(pTHX_ SV *sv, MAGIC *mg)
+{
+ PERL_ARGS_ASSERT_MAGIC_FREEMGLOB;
+ PERL_UNUSED_ARG(sv);
+
+ /* glob magic uses mg_len as a string length rather than a buffer
+ * length, so we need to free even with mg_len == 0: hence we can't
+ * rely on standard magic free handling */
+ assert(mg->mg_type == PERL_MAGIC_regex_global && mg->mg_len >= -1);
+ Safefree(mg->mg_ptr);
+ mg->mg_ptr = NULL;
+ return 0;
+}
+
+
int
Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
{
}
return 0;
}
+
+int
+Perl_magic_freecollxfrm(pTHX_ SV *sv, MAGIC *mg)
+{
+ PERL_ARGS_ASSERT_MAGIC_FREECOLLXFRM;
+ PERL_UNUSED_ARG(sv);
+
+ /* Collate magic uses mg_len as a string length rather than a buffer
+ * length, so we need to free even with mg_len == 0: hence we can't
+ * rely on standard magic free handling */
+ if (mg->mg_len >= 0) {
+ assert(mg->mg_type == PERL_MAGIC_collxfrm);
+ Safefree(mg->mg_ptr);
+ mg->mg_ptr = NULL;
+ }
+
+ return 0;
+}
#endif /* USE_LOCALE_COLLATE */
/* Just clear the UTF-8 cache data. */
}
int
+Perl_magic_freeutf8(pTHX_ SV *sv, MAGIC *mg)
+{
+ PERL_ARGS_ASSERT_MAGIC_FREEUTF8;
+ PERL_UNUSED_ARG(sv);
+
+ /* utf8 magic uses mg_len as a string length rather than a buffer
+ * length, so we need to free even with mg_len == 0: hence we can't
+ * rely on standard magic free handling */
+ assert(mg->mg_type == PERL_MAGIC_utf8 && mg->mg_len >= -1);
+ Safefree(mg->mg_ptr);
+ mg->mg_ptr = NULL;
+ return 0;
+}
+
+
+int
Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
{
const char *bad = NULL;
}
#ifdef WIN32
else if (strEQ(mg->mg_ptr+1, "IN32_SLOPPY_STAT")) {
- w32_sloppystat = (bool)sv_true(sv);
+ w32_sloppystat = SvTRUE(sv);
}
#endif
break;
}
/*
-=for apidoc_section Signals
+=for apidoc_section $signals
=for apidoc whichsig
=for apidoc_item whichsig_pv
=for apidoc_item whichsig_pvn
}
/*
-=for apidoc_section Magic
+=for apidoc_section $magic
=for apidoc magic_sethint
Triggered by a store to C<%^H>, records the key/value pair to