RMG - Remove out-of-date instruction about epigraph link

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index 4f65948..94169a6 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -302,11 +302,12 @@ C<croak()>.  Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
 void
 Perl_croak_xs_usage(const CV *const cv, const char *const params)
 {
-    const GV *const gv = CvGV(cv);
+    /* Avoid CvGV as it requires aTHX.  */
+    const GV *gv = CvNAMED(cv) ? NULL : cv->sv_any->xcv_gv_u.xcv_gv;
 
     PERL_ARGS_ASSERT_CROAK_XS_USAGE;
 
-    if (gv) {
+    if (gv) got_gv: {
        const HV *const stash = GvSTASH(gv);
 
        if (HvNAME_get(stash))
@@ -320,9 +321,12 @@ Perl_croak_xs_usage(const CV *const cv, const char *const params)
            Perl_croak_nocontext("Usage: %"HEKf"(%s)",
                                 HEKfARG(GvNAME_HEK(gv)), params);
     } else {
+        dTHX;
+        if ((gv = CvGV(cv))) goto got_gv;
+
        /* Pants. I don't think that it should be possible to get here. */
        /* diag_listed_as: SKIPME */
-       Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
+       Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
     }
 }
 
@@ -384,7 +388,7 @@ XS(XS_UNIVERSAL_can)
     else {
         pkg = gv_stashsv(sv, 0);
         if (!pkg)
-            pkg = gv_stashpv("UNIVERSAL", 0);
+            pkg = gv_stashpvs("UNIVERSAL", 0);
     }
 
     if (pkg) {
@@ -561,12 +565,12 @@ XS(XS_Internals_SvREADONLY)       /* This is dangerous stuff. */
 #ifdef PERL_OLD_COPY_ON_WRITE
            if (SvIsCOW(sv)) sv_force_normal(sv);
 #endif
-           SvREADONLY_on(sv);
+           SvFLAGS(sv) |= SVf_READONLY;
            XSRETURN_YES;
        }
        else {
            /* I hope you really know what you are doing. */
-           SvREADONLY_off(sv);
+           SvFLAGS(sv) &=~ SVf_READONLY;
            XSRETURN_NO;
        }
     }