#else
Apr |void |newMYSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block
#endif
+p |CV* |newSTUB |NN GV *gv|bool fake
: Used in perly.y
p |OP * |my_attrs |NN OP *o|NULLOK OP *attrs
#if defined(USE_ITHREADS)
#define my_swabn Perl_my_swabn
#define my_unexec() Perl_my_unexec(aTHX)
#define newATTRSUB_flags(a,b,c,d,e,f) Perl_newATTRSUB_flags(aTHX_ a,b,c,d,e,f)
+#define newSTUB(a,b) Perl_newSTUB(aTHX_ a,b)
#define newXS_len_flags(a,b,c,d,e,f,g) Perl_newXS_len_flags(aTHX_ a,b,c,d,e,f,g)
#define nextargv(a) Perl_nextargv(aTHX_ a)
#define oopsAV(a) Perl_oopsAV(aTHX_ a)
gv_name_set(gv, name, len, GV_ADD | ( flags & SVf_UTF8 ? SVf_UTF8 : 0 ));
if (flags & GV_ADDMULTI || doproto) /* doproto means it */
GvMULTI_on(gv); /* _was_ mentioned */
- if (doproto) { /* Replicate part of newSUB here. */
+ if (doproto) {
CV *cv;
if (has_constant) {
/* newCONSTSUB takes ownership of the reference from us. */
from a reference to CV. */
if (exported_constant)
GvIMPORTED_CV_on(gv);
+ CvSTASH_set(cv, PL_curstash); /* XXX Why is this needed? */
} else {
- ENTER;
- (void) start_subparse(0,0); /* Create empty CV in compcv. */
- cv = PL_compcv;
- GvCV_set(gv,cv);
- LEAVE;
+ cv = newSTUB(gv,1);
}
-
- CvGV_set(cv, gv);
- CvFILE_set_from_cop(cv, PL_curcop);
- CvSTASH_set(cv, PL_curstash);
if (proto) {
sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen,
SV_HAS_TRAILING_NUL);
return cv;
}
+CV *
+Perl_newSTUB(pTHX_ GV *gv, bool fake)
+{
+ register CV *cv = MUTABLE_CV(newSV_type(SVt_PVCV));
+ PERL_ARGS_ASSERT_NEWSTUB;
+ assert(!GvCVu(gv));
+ GvCV_set(gv, cv);
+ GvCVGEN(gv) = 0;
+ if (!fake && HvENAME_HEK(GvSTASH(gv)))
+ mro_method_changed_in(GvSTASH(gv));
+ CvGV_set(cv, gv);
+ CvFILE_set_from_cop(cv, PL_curcop);
+ CvSTASH_set(cv, PL_curstash);
+ GvMULTI_on(gv);
+ return cv;
+}
+
/*
=for apidoc U||newXS
* It has the same effect as "sub name;", i.e. just a forward
* declaration! */
if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
- SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
- return newSUB(start_subparse(FALSE, 0),
- newSVOP(OP_CONST, 0, sv),
- NULL, NULL);
+ return newSTUB(gv,0);
}
if (gv)
return GvCVu(gv);
(F) Your machine doesn't implement the umask function and you tried to
use it to restrict permissions for yourself (EXPR & 0700).
-=item Unable to create sub named "%s"
-
-(F) You attempted to create or access a subroutine with an illegal name.
-
=item Unbalanced context: %d more PUSHes than POPs
(W internal) The exit code detected an internal inconsistency in how
__attribute__malloc__
__attribute__warn_unused_result__;
+PERL_CALLCONV CV* Perl_newSTUB(pTHX_ GV *gv, bool fake)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_NEWSTUB \
+ assert(gv)
+
/* PERL_CALLCONV CV* Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block); */
PERL_CALLCONV SV* Perl_newSV(pTHX_ const STRLEN len)
__attribute__malloc__
}
*st = GvESTASH(gv);
if (lref & ~GV_ADDMG && !GvCVu(gv)) {
- SV *tmpsv;
- ENTER;
- tmpsv = newSV(0);
- gv_efullname3(tmpsv, gv, NULL);
/* XXX this is probably not what they think they're getting.
* It has the same effect as "sub name;", i.e. just a forward
* declaration! */
- newSUB(start_subparse(FALSE, 0),
- newSVOP(OP_CONST, 0, tmpsv),
- NULL, NULL);
- LEAVE;
- if (!GvCVu(gv))
- Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
- SVfARG(SvOK(sv) ? sv : &PL_sv_no));
+ newSTUB(gv,0);
}
return GvCVu(gv);
}