X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=cf1dee0a0a3dd6d6815faf20089676fc361b0c6d;hb=c721372142d4c809beb9dbba1d6d9e8702004478;hp=f1662c105e3e1ec62d2f6f380304804fe98f25af;hpb=e658793210bbe632a5e80a876acfcd0984c46b87;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index f1662c1..cf1dee0 100644
--- a/util.c
+++ b/util.c
@@ -504,7 +504,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 	sv_catpvn(sv, "\n", 1);		/* Taken into account in fbm_instr() */
     s = (U8*)SvPV_force(sv, len);
     (void)SvUPGRADE(sv, SVt_PVBM);
-    if (len == 0)		/* TAIL might be on on a zero-length string. */
+    if (len == 0)		/* TAIL might be on a zero-length string. */
 	return;
     if (len > 2) {
 	U8 mlen;
@@ -1957,6 +1957,7 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
 	did_pipes = 0;
 	if (n) {			/* Error */
 	    int pid2, status;
+	    PerlLIO_close(p[This]);
 	    if (n != sizeof(int))
 		Perl_croak(aTHX_ "panic: kid popen errno read");
 	    do {
@@ -2057,8 +2058,11 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 	}
 #endif	/* defined OS2 */
 	/*SUPPRESS 560*/
-	if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV)))
+	if ((tmpgv = gv_fetchpv("$",TRUE, SVt_PV))) {
+        SvREADONLY_off(GvSV(tmpgv));
 	    sv_setiv(GvSV(tmpgv), PerlProc_getpid());
+        SvREADONLY_on(GvSV(tmpgv));
+    }
 	PL_forkprocess = 0;
 	hv_clear(PL_pidstatus);	/* we have no children */
 	return Nullfp;
@@ -2096,6 +2100,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 	did_pipes = 0;
 	if (n) {			/* Error */
 	    int pid2, status;
+	    PerlLIO_close(p[This]);
 	    if (n != sizeof(int))
 		Perl_croak(aTHX_ "panic: kid popen errno read");
 	    do {
@@ -2586,7 +2591,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f
     char *xfailed = Nullch;
     char tmpbuf[MAXPATHLEN];
     register char *s;
-    I32 len;
+    I32 len = 0;
     int retval;
 #if defined(DOSISH) && !defined(OS2) && !defined(atarist)
 #  define SEARCH_EXTS ".bat", ".cmd", NULL
@@ -3884,3 +3889,76 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 #endif
 }
 
+/*
+=for apidoc new_vstring
+
+Returns a pointer to the next character after the parsed
+vstring, as well as updating the passed in sv.
+ * 
+Function must be called like 
+ 	
+        sv = NEWSV(92,5);
+	s = new_vstring(s,sv);
+
+The sv must already be large enough to store the vstring
+passed in.
+
+=cut
+*/
+
+char *
+Perl_new_vstring(pTHX_ char *s, SV *sv)
+{
+    char *pos = s;
+    if (*pos == 'v') pos++;  /* get past 'v' */
+    while (isDIGIT(*pos) || *pos == '_')
+    pos++;
+    if (!isALPHA(*pos)) {
+	UV rev;
+	U8 tmpbuf[UTF8_MAXLEN+1];
+	U8 *tmpend;
+
+	if (*s == 'v') s++;  /* get past 'v' */
+
+	sv_setpvn(sv, "", 0);
+
+	for (;;) {
+	    rev = 0;
+	    {
+	    /* this is atoi() that tolerates underscores */
+	    char *end = pos;
+	    UV mult = 1;
+	    if ( *(s-1) == '_') {
+	    	mult = 10;
+	    }
+	    while (--end >= s) {
+		UV orev;
+		orev = rev;
+		rev += (*end - '0') * mult;
+		mult *= 10;
+		if (orev > rev && ckWARN_d(WARN_OVERFLOW))
+		Perl_warner(aTHX_ WARN_OVERFLOW,
+			"Integer overflow in decimal number");
+	    }
+	    }
+	    /* Append native character for the rev point */
+	    tmpend = uvchr_to_utf8(tmpbuf, rev);
+	    sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
+	    if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
+	    SvUTF8_on(sv);
+	    if ( (*pos == '.' || *pos == '_') && isDIGIT(pos[1]))
+	    s = ++pos;
+	    else {
+	    s = pos;
+	    break;
+	    }
+	    while (isDIGIT(*pos) )
+	    pos++;
+	}
+	SvPOK_on(sv);
+	SvREADONLY_on(sv);
+    }
+    return s;
+}
+
+