diff options
Diffstat (limited to 'perl.c')
| -rw-r--r-- | perl.c | 30 |
1 files changed, 22 insertions, 8 deletions
@@ -2476,33 +2476,47 @@ Perl_get_hv(pTHX_ const char *name, I32 create) /* =head1 CV Manipulation Functions +=for apidoc p||get_cvn_flags + +Returns the CV of the specified Perl subroutine. C<flags> are passed to +C<gv_fetchpvn_flags>. If C<GV_ADD> is set and the Perl subroutine does not +exist then it will be declared (which has the same effect as saying +C<sub name;>). If C<GV_ADD> is not set and the subroutine does not exist +then NULL is returned. + =for apidoc p||get_cv -Returns the CV of the specified Perl subroutine. If C<create> is set and -the Perl subroutine does not exist then it will be declared (which has the -same effect as saying C<sub name;>). If C<create> is not set and the -subroutine does not exist then NULL is returned. +Uses C<strlen> to get the length of C<name>, then calls C<get_cvn_flags>. =cut */ CV* -Perl_get_cv(pTHX_ const char *name, I32 create) +Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags) { - GV* const gv = gv_fetchpv(name, create, SVt_PVCV); + GV* const gv = gv_fetchpvn_flags(name, len, flags, SVt_PVCV); /* XXX unsafe for threads if eval_owner isn't held */ /* 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! */ - if (create && !GvCVu(gv)) + if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) { + SV *const sv = newSVpvn(name,len); + SvFLAGS(sv) |= flags & SVf_UTF8; return newSUB(start_subparse(FALSE, 0), - newSVOP(OP_CONST, 0, newSVpv(name,0)), + newSVOP(OP_CONST, 0, sv), NULL, NULL); + } if (gv) return GvCVu(gv); return NULL; } +CV* +Perl_get_cv(pTHX_ const char *name, I32 flags) +{ + return get_cvn_flags(name, strlen(name), flags); +} + /* Be sure to refetch the stack pointer after calling these routines. */ /* |