summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--av.c14
-rw-r--r--doop.c2
-rw-r--r--embed.fnc4
-rw-r--r--embed.h4
-rw-r--r--ext/Tie-Hash-NamedCapture/NamedCapture.pm2
-rw-r--r--ext/Tie-Hash-NamedCapture/NamedCapture.xs2
-rw-r--r--mg.c4
-rw-r--r--pod/perldelta.pod10
-rw-r--r--pp.c8
-rw-r--r--pp_hot.c6
-rw-r--r--pp_sort.c2
-rw-r--r--pp_sys.c2
-rw-r--r--proto.h8
-rw-r--r--regcomp.c4
-rw-r--r--sv.c12
-rw-r--r--universal.c8
-rw-r--r--util.c4
17 files changed, 53 insertions, 43 deletions
diff --git a/av.c b/av.c
index fe6cd9bdf5..6d2b949357 100644
--- a/av.c
+++ b/av.c
@@ -345,7 +345,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
}
if (SvREADONLY(av) && key >= AvFILL(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (!AvREAL(av) && AvREIFY(av))
av_reify(av);
@@ -463,7 +463,7 @@ Perl_av_clear(pTHX_ register AV *av)
#endif
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
/* Give any tie a chance to cleanup first */
if (SvRMAGICAL(av)) {
@@ -579,7 +579,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
@@ -611,7 +611,7 @@ Perl_av_pop(pTHX_ register AV *av)
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
if (retval)
@@ -672,7 +672,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num)
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
@@ -737,7 +737,7 @@ Perl_av_shift(pTHX_ register AV *av)
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
if (retval)
@@ -853,7 +853,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
assert(SvTYPE(av) == SVt_PVAV);
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (SvRMAGICAL(av)) {
const MAGIC * const tied_magic
diff --git a/doop.c b/doop.c
index f64ebb0674..87bd180bc6 100644
--- a/doop.c
+++ b/doop.c
@@ -633,7 +633,7 @@ Perl_do_trans(pTHX_ SV *sv)
if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) {
if (!SvIsCOW(sv))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
(void)SvPV_const(sv, len);
if (!len)
diff --git a/embed.fnc b/embed.fnc
index d148ec8025..cb5d827bd6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -246,8 +246,8 @@ Aprd |void |croak_sv |NN SV *baseex
: croak()'s first parm can be NULL. Otherwise, mod_perl breaks.
Afprd |void |croak |NULLOK const char* pat|...
Aprd |void |vcroak |NULLOK const char* pat|NULLOK va_list* args
-Aprd |void |croak_no_modify
-Aprd |void |croak_xs_usage |NN const CV *const cv \
+Anprd |void |croak_no_modify
+Anprd |void |croak_xs_usage |NN const CV *const cv \
|NN const char *const params
#if defined(WIN32)
norx |void |win32_croak_not_implemented|NN const char * fname
diff --git a/embed.h b/embed.h
index 1d1fc47563..941e0b82e7 100644
--- a/embed.h
+++ b/embed.h
@@ -77,9 +77,9 @@
#define croak Perl_croak
#endif
#define croak_memory_wrap S_croak_memory_wrap
-#define croak_no_modify() Perl_croak_no_modify(aTHX)
+#define croak_no_modify Perl_croak_no_modify
#define croak_sv(a) Perl_croak_sv(aTHX_ a)
-#define croak_xs_usage(a,b) Perl_croak_xs_usage(aTHX_ a,b)
+#define croak_xs_usage Perl_croak_xs_usage
#define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a)
#define custom_op_name(a) Perl_custom_op_name(aTHX_ a)
#define cv_clone(a) Perl_cv_clone(aTHX_ a)
diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.pm b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
index 932e4404d1..9702666799 100644
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.pm
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.pm
@@ -1,7 +1,7 @@
use strict;
package Tie::Hash::NamedCapture;
-our $VERSION = "0.08";
+our $VERSION = "0.09";
require XSLoader;
XSLoader::load(); # This returns true, which makes require happy.
diff --git a/ext/Tie-Hash-NamedCapture/NamedCapture.xs b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
index 58b7da7e0d..04cc4638e6 100644
--- a/ext/Tie-Hash-NamedCapture/NamedCapture.xs
+++ b/ext/Tie-Hash-NamedCapture/NamedCapture.xs
@@ -84,7 +84,7 @@ FETCH(...)
if (!rx || !SvROK(ST(0))) {
if (ix & UNDEF_FATAL)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
else
XSRETURN_UNDEF;
}
diff --git a/mg.c b/mg.c
index 0cb605230d..761bf73452 100644
--- a/mg.c
+++ b/mg.c
@@ -682,7 +682,7 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET;
PERL_UNUSED_ARG(sv);
PERL_UNUSED_ARG(mg);
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
NORETURN_FUNCTION_END;
}
@@ -2477,7 +2477,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
*/
croakparen:
if (!PL_localizing) {
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
}
break;
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index abcd2edc6b..c573a61fe9 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -132,6 +132,10 @@ L<CPAN> has been upgraded from version 1.98 to 1.99_51.
L<DynaLoader> has been upgraded from version 1.16 to 1.17.
+=item *
+
+L<Tie::Hash::NamedCapture> has been upgraded from version 0.08 to 0.09.
+
=back
=head2 Removed Modules and Pragmata
@@ -334,6 +338,12 @@ well.
=item *
+The private Perl_croak_no_modify has had its context parameter removed. It is
+now has a void prototype. Users of the public API croak_no_modify remain
+unaffected.
+
+=item *
+
XXX
=back
diff --git a/pp.c b/pp.c
index 5b0010fb8c..6088a11394 100644
--- a/pp.c
+++ b/pp.c
@@ -231,7 +231,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
if (vivify_sv && sv != &PL_sv_undef) {
GV *gv;
if (SvREADONLY(sv))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (cUNOP->op_targ) {
SV * const namesv = PAD_SV(cUNOP->op_targ);
gv = MUTABLE_GV(newSV(0));
@@ -777,7 +777,7 @@ S_do_chomp(pTHX_ SV *retval, SV *sv, bool chomping)
sv_force_normal_flags(sv, 0);
}
else
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
if (PL_encoding) {
@@ -1040,7 +1040,7 @@ PP(pp_postinc)
const bool inc =
PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (SvROK(TOPs))
TARG = sv_newmortal();
sv_setsv(TARG, TOPs);
@@ -5081,7 +5081,7 @@ PP(pp_push)
SPAGAIN;
}
else {
- if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify(aTHX);
+ if (SvREADONLY(ary) && MARK < SP) Perl_croak_no_modify();
PL_delaymagic = DM_DELAY;
for (++MARK; MARK <= SP; MARK++) {
SV *sv;
diff --git a/pp_hot.c b/pp_hot.c
index b5551bf2de..0cf1b7d005 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -438,7 +438,7 @@ PP(pp_preinc)
const bool inc =
PL_op->op_type == OP_PREINC || PL_op->op_type == OP_I_PREINC;
if (SvTYPE(TOPs) >= SVt_PVAV || (isGV_with_GP(TOPs) && !SvFAKE(TOPs)))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (!SvREADONLY(TOPs) && !SvGMAGICAL(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
&& SvIVX(TOPs) != (inc ? IV_MAX : IV_MIN))
{
@@ -2161,7 +2161,7 @@ PP(pp_subst)
|| ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
|| SvTYPE(TARG) > SVt_PVLV)
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
PUTBACK;
s = SvPV_nomg(TARG, len);
@@ -2946,7 +2946,7 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
SvGETMAGIC(sv);
if (!SvOK(sv)) {
if (SvREADONLY(sv))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
prepare_SV_for_RV(sv);
switch (to_what) {
case OPpDEREF_SV:
diff --git a/pp_sort.c b/pp_sort.c
index 30595f062f..eae20984c2 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1586,7 +1586,7 @@ PP(pp_sort)
}
else {
if (SvREADONLY(av))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
else
SvREADONLY_on(av);
p1 = p2 = AvARRAY(av);
diff --git a/pp_sys.c b/pp_sys.c
index 57679eb3dd..938aafe0f2 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1100,7 +1100,7 @@ PP(pp_sselect)
if (SvIsCOW(sv))
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
if (!SvPOK(sv)) {
if (!SvPOKp(sv))
diff --git a/proto.h b/proto.h
index 8929439138..83372f8a09 100644
--- a/proto.h
+++ b/proto.h
@@ -643,7 +643,7 @@ PERL_CALLCONV_NO_RET void Perl_croak(pTHX_ const char* pat, ...)
PERL_STATIC_NO_RET void S_croak_memory_wrap(void)
__attribute__noreturn__;
-PERL_CALLCONV_NO_RET void Perl_croak_no_modify(pTHX)
+PERL_CALLCONV_NO_RET void Perl_croak_no_modify(void)
__attribute__noreturn__;
PERL_CALLCONV_NO_RET void Perl_croak_sv(pTHX_ SV *baseex)
@@ -652,10 +652,10 @@ PERL_CALLCONV_NO_RET void Perl_croak_sv(pTHX_ SV *baseex)
#define PERL_ARGS_ASSERT_CROAK_SV \
assert(baseex)
-PERL_CALLCONV_NO_RET void Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+PERL_CALLCONV_NO_RET void Perl_croak_xs_usage(const CV *const cv, const char *const params)
__attribute__noreturn__
- __attribute__nonnull__(pTHX_1)
- __attribute__nonnull__(pTHX_2);
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
#define PERL_ARGS_ASSERT_CROAK_XS_USAGE \
assert(cv); assert(params)
diff --git a/regcomp.c b/regcomp.c
index 7007e55acd..83e0530f0c 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -6488,7 +6488,7 @@ Perl_reg_named_buff(pTHX_ REGEXP * const rx, SV * const key, SV * const value,
if (flags & RXapif_FETCH) {
return reg_named_buff_fetch(rx, key, flags);
} else if (flags & (RXapif_STORE | RXapif_DELETE | RXapif_CLEAR)) {
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
return NULL;
} else if (flags & RXapif_EXISTS) {
return reg_named_buff_exists(rx, key, flags)
@@ -6810,7 +6810,7 @@ Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren,
PERL_UNUSED_ARG(value);
if (!PL_localizing)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
I32
diff --git a/sv.c b/sv.c
index 067a9e0a82..4a57a9a0a9 100644
--- a/sv.c
+++ b/sv.c
@@ -4785,7 +4785,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
}
}
else if (IN_PERL_RUNTIME)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
#else
if (SvREADONLY(sv)) {
@@ -4807,7 +4807,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *const sv, const U32 flags)
unshare_hek(SvSHARED_HEK_FROM_PV(pvx));
}
else if (IN_PERL_RUNTIME)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
#endif
if (SvROK(sv))
@@ -5320,7 +5320,7 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how,
&& !PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(how)
)
{
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
}
if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) {
@@ -7954,7 +7954,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
if (IN_PERL_RUNTIME)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
if (SvROK(sv)) {
IV i;
@@ -8136,7 +8136,7 @@ Perl_sv_dec_nomg(pTHX_ register SV *const sv)
sv_force_normal_flags(sv, 0);
if (SvREADONLY(sv)) {
if (IN_PERL_RUNTIME)
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
}
if (SvROK(sv)) {
IV i;
@@ -9495,7 +9495,7 @@ Perl_sv_bless(pTHX_ SV *const sv, HV *const stash)
tmpRef = SvRV(sv);
if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
if (SvREADONLY(tmpRef) && !SvIsCOW(tmpRef))
- Perl_croak_no_modify(aTHX);
+ Perl_croak_no_modify();
if (SvOBJECT(tmpRef)) {
if (SvTYPE(tmpRef) != SVt_PVIO)
--PL_sv_objcount;
diff --git a/universal.c b/universal.c
index 055d8ab176..8cc6e63a93 100644
--- a/universal.c
+++ b/universal.c
@@ -298,7 +298,7 @@ C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
*/
void
-Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+Perl_croak_xs_usage(const CV *const cv, const char *const params)
{
const GV *const gv = CvGV(cv);
@@ -308,16 +308,16 @@ Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
const HV *const stash = GvSTASH(gv);
if (HvNAME_get(stash))
- Perl_croak(aTHX_ "Usage: %"HEKf"::%"HEKf"(%s)",
+ Perl_croak_nocontext("Usage: %"HEKf"::%"HEKf"(%s)",
HEKfARG(HvNAME_HEK(stash)),
HEKfARG(GvNAME_HEK(gv)),
params);
else
- Perl_croak(aTHX_ "Usage: %"HEKf"(%s)",
+ Perl_croak_nocontext("Usage: %"HEKf"(%s)",
HEKfARG(GvNAME_HEK(gv)), params);
} else {
/* Pants. I don't think that it should be possible to get here. */
- Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
+ Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
}
}
diff --git a/util.c b/util.c
index 28a5ff477c..b7403e89c6 100644
--- a/util.c
+++ b/util.c
@@ -1625,9 +1625,9 @@ paths reduces CPU cache pressure.
*/
void
-Perl_croak_no_modify(pTHX)
+Perl_croak_no_modify()
{
- Perl_croak(aTHX_ "%s", PL_no_modify);
+ Perl_croak_nocontext( "%s", PL_no_modify);
}
/*
View Lorry Controller Status