Don't test the core XS code yet with PERL_DEBUG_COW > 1

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

diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c
index 0e465b0..d770cef 100644 (file)
--- a/djgpp/djgpp.c
+++ b/djgpp/djgpp.c
@@ -106,7 +106,7 @@ static int
 convretcode (pTHX_ int rc,char *prog,int fl)
 {
     if (rc < 0 && ckWARN(WARN_EXEC))
-        Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s",
+        Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't %s \"%s\": %s",
                    fl ? "exec" : "spawn",prog,Strerror (errno));
     if (rc >= 0)
         return rc << 8;
@@ -366,6 +366,24 @@ XS(dos_UseLFN)
     XSRETURN_IV (_USE_LFN);
 }
 
+XS(XS_Cwd_sys_cwd)
+{
+    dXSARGS;
+    if (items != 0)
+       Perl_croak_nocontext("Usage: Cwd::sys_cwd()");
+    {
+       char p[MAXPATHLEN];
+       char *  RETVAL;
+       RETVAL = getcwd(p, MAXPATHLEN);
+       ST(0) = sv_newmortal();
+       sv_setpv((SV*)ST(0), RETVAL);
+#ifndef INCOMPLETE_TAINTS
+       SvTAINTED_on(ST(0));
+#endif
+    }
+    XSRETURN(1);
+}
+
 void
 Perl_init_os_extras(pTHX)
 {
@@ -375,6 +393,7 @@ Perl_init_os_extras(pTHX)
     
     newXS ("Dos::GetCwd",dos_GetCwd,file);
     newXS ("Dos::UseLFN",dos_UseLFN,file);
+    newXS ("Cwd::sys_cwd",XS_Cwd_sys_cwd,file);
 
     /* install my File System Extension for globbing */
     __FSEXT_add_open_handler (glob_handler);
@@ -441,3 +460,16 @@ djgpp_fflush (FILE *fp)
 
     return res;
 }
+
+int djgpp_get_stream_mode(FILE *f)
+{
+    extern char *__file_handle_modes;
+
+    int mode = __file_handle_modes[fileno(f)];
+    if (f->_flag & _IORW)
+        return mode | O_RDWR;
+    if (f->_flag & _IOWRT)
+        return mode | O_WRONLY;
+    return mode | O_RDONLY;
+}
+