Convert ext/B/t/debug.t to Test::More. (Diagnostics are good, m'kay)

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index fdcbcbd..9c7b314 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1326,6 +1326,8 @@ Releases a Perl interpreter.  See L<perlembed>.
 void
 perl_free(pTHXx)
 {
+    dVAR;
+
     if (PL_veto_cleanup)
        return;
 
@@ -2476,33 +2478,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. */
 
 /*