X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=djgpp%2Fdjgpp.c;h=f235421ae3630b145d5bd33323065b6ada6022dc;hb=1edbfb88dca645450f44e4bcbb3df8372f66c904;hp=07eb80e1f736bc5b51321eb6232bfe9375ac3c28;hpb=2d8e6c8d50eaf50f663a5fd184404c73944226e0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 07eb80e..f235421 100644 --- a/djgpp/djgpp.c +++ b/djgpp/djgpp.c @@ -1,3 +1,4 @@ +#define PERLIO_NOT_STDIO 0 #include #include #include @@ -27,7 +28,7 @@ struct pipe_list { static struct pipe_list *pl = NULL; FILE * -popen (const char *cm, const char *md) /* program name, pipe mode */ +djgpp_popen (const char *cm, const char *md) /* program name, pipe mode */ { struct pipe_list *l1; int fd; @@ -75,7 +76,7 @@ popen (const char *cm, const char *md) /* program name, pipe mode */ } int -pclose (FILE *pp) +djgpp_pclose (FILE *pp) { struct pipe_list *l1, **l2; /* list pointers */ int retval=-1; /* function return value */ @@ -117,21 +118,19 @@ pclose (FILE *pp) #define EXECF_EXEC 1 static int -convretcode (int rc,char *prog,int fl) +convretcode (pTHX_ int rc,char *prog,int fl) { - if (rc < 0 && PL_dowarn) - warn ("Can't %s \"%s\": %s",fl ? "exec" : "spawn",prog,Strerror (errno)); - if (rc > 0) - return rc <<= 8; - if (rc < 0) - return 255 << 8; - return 0; + if (rc < 0 && ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ WARN_EXEC,"Can't %s \"%s\": %s", + fl ? "exec" : "spawn",prog,Strerror (errno)); + if (rc >= 0) + return rc << 8; + return -1; } int -do_aspawn (SV *really,SV **mark,SV **sp) +do_aspawn (pTHX_ SV *really,SV **mark,SV **sp) { - dTHR; int rc; char **a,*tmps,**argv; STRLEN n_a; @@ -164,7 +163,7 @@ do_aspawn (SV *really,SV **mark,SV **sp) #define EXTRA "\x00\x00\x00\x00\x00\x00" int -do_spawn2 (char *cmd,int execf) +do_spawn2 (pTHX_ char *cmd,int execf) { char **a,*s,*shell,*metachars; int rc,unixysh; @@ -232,15 +231,15 @@ doshell: } int -do_spawn (char *cmd) +do_spawn (pTHX_ char *cmd) { - return do_spawn2 (cmd,EXECF_SPAWN); + return do_spawn2 (aTHX_ cmd,EXECF_SPAWN); } bool -do_exec (char *cmd) +Perl_do_exec (pTHX_ char *cmd) { - do_spawn2 (cmd,EXECF_EXEC); + do_spawn2 (aTHX_ cmd,EXECF_EXEC); return FALSE; } @@ -251,6 +250,7 @@ struct globinfo int fd; char *matches; size_t size; + fpos_t pos; }; #define MAXOPENGLOBS 10 @@ -285,6 +285,7 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args) if ((gi=searchfd (-1)) == NULL) break; + gi->pos=0; pattern=alloca (strlen (name+=13)+1); strcpy (pattern,name); if (!_USE_LFN) @@ -331,11 +332,10 @@ glob_handler (__FSEXT_Fnumber n,int *rv,va_list args) if ((gi=searchfd (fd))==NULL) break; - ic=tell (fd); - if (siz+ic>=gi->size) - siz=gi->size-ic; - memcpy (buf,ic+gi->matches,siz); - lseek (fd,siz,1); + if (siz+gi->pos > gi->size) + siz = gi->size - gi->pos; + memcpy (buf,gi->pos+gi->matches,siz); + gi->pos += siz; *rv=siz; return 1; } @@ -361,7 +361,7 @@ XS(dos_GetCwd) dXSARGS; if (items) - croak ("Usage: Dos::GetCwd()"); + Perl_croak (aTHX_ "Usage: Dos::GetCwd()"); { char tmp[PATH_MAX+2]; ST(0)=sv_newmortal (); @@ -379,7 +379,7 @@ XS(dos_UseLFN) } void -init_os_extras() +Perl_init_os_extras(pTHX) { char *file = __FILE__; @@ -433,3 +433,22 @@ Perl_DJGPP_init (int *argcp,char ***argvp) strcpy (perlprefix,".."); } +int +djgpp_fflush (FILE *fp) +{ + int res; + + if ((res = fflush(fp)) == 0 && fp) { + Stat_t s; + if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode)) + res = fsync(fileno(fp)); + } +/* + * If the flush succeeded but set end-of-file, we need to clear + * the error because our caller may check ferror(). BTW, this + * probably means we just flushed an empty file. + */ + if (res == 0 && fp && ferror(fp) == EOF) clearerr(fp); + + return res; +}