X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=98ecfac5688768ce895169afdd7c6f7b2ccaa281;hb=11faa288e292c27cb2ddc4ccdc483b523d26ce19;hp=23d153535d0e47575ba0b7c0d15f7bbd97c276cf;hpb=1ff81528d9b685c68d4fe91564f636f46d635496;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index 23d1535..98ecfac 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -22,6 +22,11 @@ /* Shadow password support for solaris - pdo@cs.umd.edu * Not just Solaris: at least HP-UX, IRIX, Linux. * the API is from SysV. --jhi */ +#ifdef __hpux__ +/* There is a MAXINT coming from <- <- + * and another MAXINT from "perl.h" <- . */ +#undef MAXINT +#endif #include #endif @@ -187,6 +192,10 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; # include #endif +#if defined(HAS_FCNTL) && defined(F_SETFD) && !defined(FD_CLOEXEC) +# define FD_CLOEXEC 1 /* NeXT needs this */ +#endif + #undef PERL_EFF_ACCESS_R_OK /* EFFective uid/gid ACCESS R_OK */ #undef PERL_EFF_ACCESS_W_OK #undef PERL_EFF_ACCESS_X_OK @@ -230,7 +239,7 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; || defined(HAS_SETREGID) || defined(HAS_SETRESGID)) /* The Hard Way. */ STATIC int -S_emulate_eaccess(pTHX_ const char* path, int mode) +S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) { Uid_t ruid = getuid(); Uid_t euid = geteuid(); @@ -295,7 +304,7 @@ S_emulate_eaccess(pTHX_ const char* path, int mode) #if !defined(PERL_EFF_ACCESS_R_OK) STATIC int -S_emulate_eaccess(pTHX_ const char* path, int mode) +S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) { Perl_croak(aTHX_ "switching effective uid is not implemented"); /*NOTREACHED*/ @@ -402,7 +411,7 @@ PP(pp_indread) PP(pp_rcatline) { - PL_last_in_gv = cGVOP->op_gv; + PL_last_in_gv = cGVOP; return do_readline(); } @@ -466,8 +475,8 @@ PP(pp_die) HV *stash = SvSTASH(SvRV(error)); GV *gv = gv_fetchmethod(stash, "PROPAGATE"); if (gv) { - SV *file = sv_2mortal(newSVsv(GvSV(PL_curcop->cop_filegv))); - SV *line = sv_2mortal(newSViv(PL_curcop->cop_line)); + SV *file = sv_2mortal(newSVsv(CopFILESV(PL_curcop))); + SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop))); EXTEND(SP, 3); PUSHMARK(SP); PUSHs(error); @@ -523,22 +532,6 @@ PP(pp_open) if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; -#if 0 /* no undef means tmpfile() yet */ - if (sv == &PL_sv_undef) { -#ifdef PerlIO - PerlIO *fp = PerlIO_tmpfile(); -#else - PerlIO *fp = tmpfile(); -#endif - if (fp != Nullfp && do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) - PUSHi( (I32)PL_forkprocess ); - else - RETPUSHUNDEF; - RETURN; - } -#endif /* no undef means tmpfile() yet */ - - if (mg = SvTIED_mg((SV*)gv, 'q')) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); @@ -816,17 +809,10 @@ PP(pp_untie) if (ckWARN(WARN_UNTIE)) { MAGIC * mg ; if (mg = SvTIED_mg(sv, how)) { -#ifdef IV_IS_QUAD if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1) Perl_warner(aTHX_ WARN_UNTIE, - "untie attempted while %" PERL_PRIu64 " inner references still exist", + "untie attempted while %"UVuf" inner references still exist", (UV)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; -#else - if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1) - Perl_warner(aTHX_ WARN_UNTIE, - "untie attempted while %lu inner references still exist", - (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; -#endif } } @@ -1561,8 +1547,8 @@ PP(pp_sysread) length = -1; } if (length < 0) { - if (IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout() - || IoIFP(io) == PerlIO_stderr()) + if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout() + || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO)) { SV* sv = sv_newmortal(); gv_efullname3(sv, gv, Nullch); @@ -1667,6 +1653,7 @@ PP(pp_send) else #endif { + /* See the note at doio.c:do_print about filesize limits. --jhi */ length = PerlLIO_write(PerlIO_fileno(IoIFP(io)), buffer+offset, length); } @@ -1764,7 +1751,7 @@ PP(pp_sysseek) djSP; GV *gv; int whence = POPi; - Off_t offset = POPl; + Off_t offset = (Off_t)SvIVx(POPs); MAGIC *mg; gv = PL_last_in_gv = (GV*)POPs; @@ -1893,7 +1880,7 @@ PP(pp_ioctl) } else { retval = SvIV(argsv); - s = (char*)retval; /* ouch */ + s = INT2PTR(char*,retval); /* ouch */ } TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl"); @@ -2425,7 +2412,7 @@ PP(pp_stat) STRLEN n_a; if (PL_op->op_flags & OPf_REF) { - tmpgv = cGVOP->op_gv; + tmpgv = cGVOP; do_fstat: if (tmpgv != PL_defgv) { PL_laststype = OP_STAT; @@ -2485,9 +2472,9 @@ PP(pp_stat) #endif PUSHs(sv_2mortal(newSViv(PL_statcache.st_size))); #ifdef BIG_TIME - PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_atime))); - PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_mtime))); - PUSHs(sv_2mortal(newSVnv((U32)PL_statcache.st_ctime))); + PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime))); + PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime))); + PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime))); #else PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime))); PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime))); @@ -2718,7 +2705,7 @@ PP(pp_ftmtime) djSP; dTARGET; if (result < 0) RETPUSHUNDEF; - PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_mtime) / 86400.0 ); + PUSHn( (PL_basetime - PL_statcache.st_mtime) / 86400.0 ); RETURN; } @@ -2728,7 +2715,7 @@ PP(pp_ftatime) djSP; dTARGET; if (result < 0) RETPUSHUNDEF; - PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_atime) / 86400.0 ); + PUSHn( (PL_basetime - PL_statcache.st_atime) / 86400.0 ); RETURN; } @@ -2738,7 +2725,7 @@ PP(pp_ftctime) djSP; dTARGET; if (result < 0) RETPUSHUNDEF; - PUSHn( ((I32)PL_basetime - (I32)PL_statcache.st_ctime) / 86400.0 ); + PUSHn( (PL_basetime - PL_statcache.st_ctime) / 86400.0 ); RETURN; } @@ -2870,7 +2857,7 @@ PP(pp_fttty) STRLEN n_a; if (PL_op->op_flags & OPf_REF) - gv = cGVOP->op_gv; + gv = cGVOP; else if (isGV(TOPs)) gv = (GV*)POPs; else if (SvROK(TOPs) && isGV(SvRV(TOPs))) @@ -2911,7 +2898,7 @@ PP(pp_fttext) STRLEN n_a; if (PL_op->op_flags & OPf_REF) - gv = cGVOP->op_gv; + gv = cGVOP; else if (isGV(TOPs)) gv = (GV*)POPs; else if (SvROK(TOPs) && isGV(SvRV(TOPs))) @@ -2962,7 +2949,7 @@ PP(pp_fttext) else { if (ckWARN(WARN_UNOPENED)) Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>", - GvENAME(cGVOP->op_gv)); + GvENAME(cGVOP)); SETERRNO(EBADF,RMS$_IFI); RETPUSHUNDEF; } @@ -3647,7 +3634,7 @@ PP(pp_system) PerlLIO_close(pp[0]); if (n) { /* Error */ if (n != sizeof(int)) - Perl_croak(aTHX_ "panic: kid popen errno read"); + DIE(aTHX_ "panic: kid popen errno read"); errno = errkid; /* Propagate errno from kid */ STATUS_CURRENT = -1; } @@ -3764,21 +3751,21 @@ PP(pp_getpgrp) { #ifdef HAS_GETPGRP djSP; dTARGET; - int pid; - I32 value; + Pid_t pid; + Pid_t pgrp; if (MAXARG < 1) pid = 0; else pid = SvIVx(POPs); #ifdef BSD_GETPGRP - value = (I32)BSD_GETPGRP(pid); + pgrp = (I32)BSD_GETPGRP(pid); #else if (pid != 0 && pid != getpid()) DIE(aTHX_ "POSIX getpgrp can't take an argument"); - value = (I32)getpgrp(); + pgrp = getpgrp(); #endif - XPUSHi(value); + XPUSHi(pgrp); RETURN; #else DIE(aTHX_ PL_no_func, "getpgrp()"); @@ -3789,8 +3776,8 @@ PP(pp_setpgrp) { #ifdef HAS_SETPGRP djSP; dTARGET; - int pgrp; - int pid; + Pid_t pgrp; + Pid_t pid; if (MAXARG < 2) { pgrp = 0; pid = 0; @@ -3805,7 +3792,7 @@ PP(pp_setpgrp) SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); #else if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid())) - DIE(aTHX_ "POSIX setpgrp can't take an argument"); + DIE(aTHX_ "setpgrp can't take arguments"); SETi( setpgrp() >= 0 ); #endif /* USE_BSDPGRP */ RETURN; @@ -3939,25 +3926,25 @@ PP(pp_gmtime) if (!tmbuf) RETPUSHUNDEF; tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %d", - dayname[tmbuf->tm_wday], - monname[tmbuf->tm_mon], - tmbuf->tm_mday, - tmbuf->tm_hour, - tmbuf->tm_min, - tmbuf->tm_sec, - tmbuf->tm_year + 1900); + dayname[tmbuf->tm_wday], + monname[tmbuf->tm_mon], + tmbuf->tm_mday, + tmbuf->tm_hour, + tmbuf->tm_min, + tmbuf->tm_sec, + tmbuf->tm_year + 1900); PUSHs(sv_2mortal(tsv)); } else if (tmbuf) { - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday))); - PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_sec))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_min))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_hour))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_mday))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_mon))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_year))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_wday))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_yday))); + PUSHs(sv_2mortal(newSViv(tmbuf->tm_isdst))); } RETURN; } @@ -3972,7 +3959,7 @@ PP(pp_alarm) EXTEND(SP, 1); if (anum < 0) RETPUSHUNDEF; - PUSHi((I32)anum); + PUSHi(anum); RETURN; #else DIE(aTHX_ PL_no_func, "Unsupported function alarm"); @@ -4739,7 +4726,7 @@ PP(pp_gpwent) PP(pp_spwent) { djSP; -#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN) +#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) setpwent(); # ifdef HAS_SETSPENT setspent(); @@ -5000,7 +4987,7 @@ fcntl_emulate_flock(int fd, int operation) return -1; } flock.l_whence = SEEK_SET; - flock.l_start = flock.l_len = 0L; + flock.l_start = flock.l_len = (Off_t)0; return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock); }