summaryrefslogtreecommitdiff
path: root/perl.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2007-01-15 14:38:58 +0000
committerNicholas Clark <nick@ccl4.org>2007-01-15 14:38:58 +0000
commit780a5241a93925d81e932db73df46ee749b203b9 (patch)
tree5d2b5e37c760af0191c2ced00c015d067dd9736a /perl.c
parentd1144667a1a63a59aa92742530166e5d3591539f (diff)
downloadperl-780a5241a93925d81e932db73df46ee749b203b9.tar.gz
Add get_cvn_flags(), which is like get_cv() but takes a length. This
allows symbolic code references with embeded NULs to work. p4raw-id: //depot/perl@29830
Diffstat (limited to 'perl.c')
-rw-r--r--perl.c30
1 files changed, 22 insertions, 8 deletions
diff --git a/perl.c b/perl.c
index fdcbcbdaaf..88bbcbbd80 100644
--- a/perl.c
+++ b/perl.c
@@ -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. */
/*