X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=a953d54dd21bc42731627fd70be104dd8cc2d6ba;hb=b0ce926a45891e83ffb4badae874161f93c0eb49;hp=8162e53aba65417166e50953fa5d11a4fc5a266b;hpb=6dce6b70b85ef184fc8b4432d2436d1be5f0b117;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index 8162e53..a953d54 100644 --- a/doio.c +++ b/doio.c @@ -282,7 +282,10 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, goto say_false; } if (IoIFP(thatio)) { - fd = PerlIO_fileno(IoIFP(thatio)); + PerlIO *fp = IoIFP(thatio); + /* Flush stdio buffer before dup */ + PerlIO_seek(fp, 0, SEEK_CUR); + fd = PerlIO_fileno(fp); if (IoTYPE(thatio) == 's') IoTYPE(io) = 's'; } @@ -413,7 +416,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } if (fd != PerlIO_fileno(fp)) { - int pid; + Pid_t pid; SV *sv; PerlLIO_dup2(PerlIO_fileno(fp), fd); @@ -1001,10 +1004,17 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) if (SvIOK(sv)) { if (SvGMAGICAL(sv)) mg_get(sv); - if (SvIsUV(sv)) /* XXXX 64-bit? */ +#ifdef IV_IS_QUAD + if (SvIsUV(sv)) + PerlIO_printf(fp, "%" PERL_PRIu64, (UV)SvUVX(sv)); + else + PerlIO_printf(fp, "%" PERL_PRId64, (IV)SvIVX(sv)); +#else + if (SvIsUV(sv)) PerlIO_printf(fp, "%lu", (unsigned long)SvUVX(sv)); else PerlIO_printf(fp, "%ld", (long)SvIVX(sv)); +#endif return !PerlIO_error(fp); } /* FALL THROUGH */ @@ -1480,8 +1490,10 @@ nothing in the core. /* Do the permissions allow some operation? Assumes statcache already set. */ #ifndef VMS /* VMS' cando is in vms.c */ -I32 -Perl_cando(pTHX_ I32 bit, I32 effective, register struct stat *statbufp) +bool +Perl_cando(pTHX_ Mode_t mode, Uid_t effective, register Stat_t *statbufp) +/* Note: we use `effective' both for uids and gids. + * Here we are betting on Uid_t being equal or wider than Gid_t. */ { #ifdef DOSISH /* [Comments and code from Len Reed] @@ -1505,11 +1517,11 @@ Perl_cando(pTHX_ I32 bit, I32 effective, register struct stat *statbufp) /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat * too so it will actually look into the files for magic numbers */ - return (bit & statbufp->st_mode) ? TRUE : FALSE; + return (mode & statbufp->st_mode) ? TRUE : FALSE; #else /* ! DOSISH */ if ((effective ? PL_euid : PL_uid) == 0) { /* root is special */ - if (bit == S_IXUSR) { + if (mode == S_IXUSR) { if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode)) return TRUE; } @@ -1518,22 +1530,22 @@ Perl_cando(pTHX_ I32 bit, I32 effective, register struct stat *statbufp) return FALSE; } if (statbufp->st_uid == (effective ? PL_euid : PL_uid) ) { - if (statbufp->st_mode & bit) + if (statbufp->st_mode & mode) return TRUE; /* ok as "user" */ } - else if (ingroup((I32)statbufp->st_gid,effective)) { - if (statbufp->st_mode & bit >> 3) + else if (ingroup(statbufp->st_gid,effective)) { + if (statbufp->st_mode & mode >> 3) return TRUE; /* ok as "group" */ } - else if (statbufp->st_mode & bit >> 6) + else if (statbufp->st_mode & mode >> 6) return TRUE; /* ok as "other" */ return FALSE; #endif /* ! DOSISH */ } #endif /* ! VMS */ -I32 -Perl_ingroup(pTHX_ I32 testgid, I32 effective) +bool +Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective) { if (testgid == (effective ? PL_egid : PL_gid)) return TRUE;