X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=ab8356eab72d3bf335fe39c04dade4e489b6788f;hb=531b886104fed3302a6d671985aba5e2f6420dd5;hp=d0d8454b8644986ab11d4d6847f38452ed2b0cbc;hpb=03d70c897754d6af90de9d0ffe2857d000d6f2d7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index d0d8454..ab8356e 100644
--- a/util.c
+++ b/util.c
@@ -2051,7 +2051,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     return PerlIO_fdopen(p[This], mode);
 }
 #else
-#if defined(atarist) || defined(DJGPP)
+#if defined(atarist)
 FILE *popen();
 PerlIO *
 Perl_my_popen(pTHX_ char *cmd, char *mode)
@@ -2063,6 +2063,20 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     */
     return PerlIO_importFILE(popen(cmd, mode), 0);
 }
+#else
+#if defined(DJGPP)
+FILE *djgpp_popen();
+PerlIO *
+Perl_my_popen(pTHX_ char *cmd, char *mode)
+{
+    PERL_FLUSHALL_FOR_CHILD;
+    /* Call system's popen() to get a FILE *, then import it.
+       used 0 for 2nd parameter to PerlIO_importFILE;
+       apparently not used
+    */
+    return PerlIO_importFILE(djgpp_popen(cmd, mode), 0);
+}
+#endif
 #endif
 
 #endif /* !DOSISH */
@@ -2367,7 +2381,7 @@ Perl_pidgone(pTHX_ Pid_t pid, int status)
     return;
 }
 
-#if defined(atarist) || defined(OS2) || defined(DJGPP)
+#if defined(atarist) || defined(OS2)
 int pclose();
 #ifdef HAS_FORK
 int					/* Cannot prototype with I32
@@ -2381,9 +2395,20 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     /* Needs work for PerlIO ! */
     FILE *f = PerlIO_findFILE(ptr);
     I32 result = pclose(f);
+    PerlIO_releaseFILE(ptr,f);
+    return result;
+}
+#endif
+
 #if defined(DJGPP)
+int djgpp_pclose();
+I32
+Perl_my_pclose(pTHX_ PerlIO *ptr)
+{
+    /* Needs work for PerlIO ! */
+    FILE *f = PerlIO_findFILE(ptr);
+    I32 result = djgpp_pclose(f);
     result = (result << 8) & 0xff00;
-#endif
     PerlIO_releaseFILE(ptr,f);
     return result;
 }
@@ -3611,29 +3636,20 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 
 #ifdef HAS_GETCWD
     {
-	char* buf;
-
-	SvPOK_off(sv);
-	New(0, buf, MAXPATHLEN, char);
-	if (buf) {
-	    buf[MAXPATHLEN] = 0;
-	    /* Yes, some getcwd()s automatically allocate a buffer
-	     * if given a NULL one.  Portability is the problem.
-	     * XXX Configure probe needed. */
-	    if (getcwd(buf, MAXPATHLEN - 1)) {
-	        STRLEN len = strlen(buf);
-	        sv_setpvn(sv, buf, len);
-		SvPOK_only(sv);
-		SvCUR_set(sv, len);
-	    }
-	    else
-	        sv_setsv(sv, &PL_sv_undef);
-	    Safefree(buf);
-	}
-	else
-	    sv_setsv(sv, &PL_sv_undef);
-
-	return SvPOK(sv) ? TRUE : FALSE;
+	char buf[MAXPATHLEN];
+
+        /* Some getcwd()s automatically allocate a buffer of the given
+	 * size from the heap if they are given a NULL buffer pointer.
+	 * The problem is that this behaviour is not portable. */
+        if (getcwd(buf, sizeof(buf) - 1)) {
+            STRLEN len = strlen(buf);
+            sv_setpvn(sv, buf, len);
+            return TRUE;
+        }
+        else {
+            sv_setsv(sv, &PL_sv_undef);
+            return FALSE;
+        }
     }
 
 #else
@@ -3727,12 +3743,14 @@ Perl_sv_getcwd(pTHX_ register SV *sv)
 #endif
     }
 
-    SvCUR_set(sv, pathlen);
-    *SvEND(sv) = '\0';
-    SvPOK_only(sv);
+    if (pathlen) {
+        SvCUR_set(sv, pathlen);
+        *SvEND(sv) = '\0';
+        SvPOK_only(sv);
 
-    if (PerlDir_chdir(SvPVX(sv)) < 0) {
-        SV_CWD_RETURN_UNDEF;
+	if (PerlDir_chdir(SvPVX(sv)) < 0) {
+            SV_CWD_RETURN_UNDEF;
+        }
     }
     if (PerlLIO_stat(".", &statbuf) < 0) {
         SV_CWD_RETURN_UNDEF;