X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=djgpp%2Fdjgpp.c;h=f235421ae3630b145d5bd33323065b6ada6022dc;hb=1edbfb88dca645450f44e4bcbb3df8372f66c904;hp=5a8fc5fa5c86f7f70fc120aec8214a5ea4366b72;hpb=c529f79d594c53d3968d464c57ac24a21137dd09;p=p5sagit%2Fp5-mst-13.2.git diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 5a8fc5f..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 */ @@ -122,17 +123,14 @@ convretcode (pTHX_ int rc,char *prog,int fl) 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) + if (rc >= 0) return rc << 8; - if (rc < 0) - return 255 << 8; - return 0; + return -1; } int do_aspawn (pTHX_ SV *really,SV **mark,SV **sp) { - dTHR; int rc; char **a,*tmps,**argv; STRLEN n_a; @@ -435,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; +}