Fix bug in DynaLoader, which has been passing a filename in dynamic

storage to newXS() seemingly forever. This involves creating
newXS_flags(), with the first flag being "arrange to copy the 
filename and free it at the right time".

p4raw-id: //depot/perl@28063

1 files changed, 48 insertions, 8 deletions

diff --git a/op.c b/op.c
index 1e852546ba..366897b7b0 100644
--- a/op.c
+++ b/op.c
@@ -5429,15 +5429,10 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     /* file becomes the CvFILE. For an XS, it's supposed to be static storage,
        and so doesn't get free()d.  (It's expected to be from the C pre-
        processor __FILE__ directive). But we need a dynamically allocated one,
-       and we need it to get freed.  So we cheat, and take advantage of the
-       fact that the first 0 bytes of any string always look the same.  */
-    cv = newXS(name, const_sv_xsub, file);
+       and we need it to get freed.  */
+    cv = newXS_flags(name, const_sv_xsub, file, "", XS_DYNAMIC_FILENAME);
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
-    /* prototype is "".  But this gets free()d.  :-)  */
-    sv_usepvn_flags((SV*)cv, file, len, SV_HAS_TRAILING_NUL); 
-    /* This gives us a prototype of "", rather than the file name.  */
-    SvCUR_set(cv, 0);
 
 #ifdef USE_ITHREADS
     if (stash)
@@ -5448,10 +5443,55 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     return cv;
 }
 
+CV *
+Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
+		 const char *const filename, const char *const proto,
+		 U32 flags)
+{
+    CV *cv = newXS(name, subaddr, filename);
+
+    if (flags & XS_DYNAMIC_FILENAME) {
+	/* We need to "make arrangements" (ie cheat) to ensure that the
+	   filename lasts as long as the PVCV we just created, but also doesn't
+	   leak  */
+	STRLEN filename_len = strlen(filename);
+	STRLEN proto_and_file_len = filename_len;
+	char *proto_and_file;
+	STRLEN proto_len;
+
+	if (proto) {
+	    proto_len = strlen(proto);
+	    proto_and_file_len += proto_len;
+
+	    Newx(proto_and_file, proto_and_file_len + 1, char);
+	    Copy(proto, proto_and_file, proto_len, char);
+	    Copy(filename, proto_and_file + proto_len, filename_len + 1, char);
+	} else {
+	    proto_len = 0;
+	    proto_and_file = savepvn(filename, filename_len);
+	}
+
+	/* This gets free()d.  :-)  */
+	sv_usepvn_flags((SV*)cv, proto_and_file, proto_and_file_len,
+			SV_HAS_TRAILING_NUL);
+	if (proto) {
+	    /* This gives us the correct prototype, rather than one with the
+	       file name appended.  */
+	    SvCUR_set(cv, proto_len);
+	} else {
+	    SvPOK_off(cv);
+	}
+    } else {
+	sv_setpv((SV *)cv, proto);
+    }
+    return cv;
+}
+
 /*
 =for apidoc U||newXS
 
-Used by C<xsubpp> to hook up XSUBs as Perl subs.
+Used by C<xsubpp> to hook up XSUBs as Perl subs.  I<filename> needs to be
+static storage, as it is used directly as CvFILE(), without a copy being made.
 
 =cut
 */