X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=c127b64fdb1b16a33f02f07e334a5aecb6d333d6;hb=2af232bd5d3f6bd1ea08b47ef83cc57f75149871;hp=edb69c29afb11665998af67ca01fec7b39769f25;hpb=1dd30107ebac37cf465e5225a00d367454a7cb84;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index edb69c2..c127b64 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1,7 +1,7 @@ /* pp_sys.c * * Copyright (C) 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -45,12 +45,6 @@ # include #endif -#ifdef HAS_SYSCALL -#ifdef __cplusplus -extern "C" int syscall(unsigned long,...); -#endif -#endif - #ifdef I_SYS_WAIT # include #endif @@ -125,6 +119,12 @@ extern int h_errno; # undef my_chsize # endif # define my_chsize PerlLIO_chsize +#else +# ifdef HAS_TRUNCATE +# define my_chsize PerlLIO_chsize +# else +I32 my_chsize(int fd, Off_t length); +# endif #endif #ifdef HAS_FLOCK @@ -173,7 +173,7 @@ extern int h_errno; #endif /* no flock() */ #define ZBTLEN 10 -static char zero_but_true[ZBTLEN + 1] = "0 but true"; +static const char zero_but_true[ZBTLEN + 1] = "0 but true"; #if defined(I_SYS_ACCESS) && !defined(R_OK) # include @@ -322,16 +322,16 @@ PP(pp_backtick) STRLEN n_a; char *tmps = POPpx; I32 gimme = GIMME_V; - char *mode = "r"; + const char *mode = "r"; TAINT_PROPER("``"); if (PL_op->op_private & OPpOPEN_IN_RAW) mode = "rb"; else if (PL_op->op_private & OPpOPEN_IN_CRLF) mode = "rt"; - fp = PerlProc_popen(tmps, mode); + fp = PerlProc_popen(tmps, (char *)mode); if (fp) { - char *type = NULL; + const char *type = NULL; if (PL_curcop->cop_io) { type = SvPV_nolen(PL_curcop->cop_io); } @@ -345,13 +345,14 @@ PP(pp_backtick) ; } else if (gimme == G_SCALAR) { - SV *oldrs = PL_rs; + ENTER; + SAVESPTR(PL_rs); PL_rs = &PL_sv_undef; sv_setpv(TARG, ""); /* note that this preserves previous buffer */ while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch) /*SUPPRESS 530*/ ; - PL_rs = oldrs; + LEAVE; XPUSHs(TARG); SvTAINTED_on(TARG); } @@ -366,8 +367,7 @@ PP(pp_backtick) } XPUSHs(sv_2mortal(sv)); if (SvLEN(sv) - SvCUR(sv) > 20) { - SvLEN_set(sv, SvCUR(sv)+1); - Renew(SvPVX(sv), SvLEN(sv), char); + SvPV_shrink_to_cur(sv); } SvTAINTED_on(sv); } @@ -386,6 +386,7 @@ PP(pp_backtick) PP(pp_glob) { + dVAR; OP *result; tryAMAGICunTARGET(iter, -1); @@ -432,7 +433,7 @@ PP(pp_warn) { dSP; dMARK; SV *tmpsv; - char *tmps; + const char *tmps; STRLEN len; if (SP - MARK != 1) { dTARGET; @@ -462,7 +463,7 @@ PP(pp_warn) PP(pp_die) { dSP; dMARK; - char *tmps; + const char *tmps; SV *tmpsv; STRLEN len; bool multiarg = 0; @@ -504,7 +505,7 @@ PP(pp_die) sv_setsv(error,*PL_stack_sp--); } } - DIE(aTHX_ Nullformat); + DIE_NULL; } else { if (SvPOK(error) && SvCUR(error)) @@ -523,7 +524,7 @@ PP(pp_die) PP(pp_open) { - dSP; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; GV *gv; @@ -574,7 +575,7 @@ PP(pp_open) PP(pp_close) { - dSP; + dVAR; dSP; GV *gv; IO *io; MAGIC *mg; @@ -659,7 +660,7 @@ badexit: PP(pp_fileno) { - dSP; dTARGET; + dVAR; dSP; dTARGET; GV *gv; IO *io; PerlIO *fp; @@ -697,8 +698,9 @@ PP(pp_fileno) PP(pp_umask) { - dSP; dTARGET; + dSP; #ifdef HAS_UMASK + dTARGET; Mode_t anum; if (MAXARG < 1) { @@ -722,7 +724,7 @@ PP(pp_umask) PP(pp_binmode) { - dSP; + dVAR; dSP; GV *gv; IO *io; PerlIO *fp; @@ -782,14 +784,13 @@ PP(pp_binmode) PP(pp_tie) { - dSP; - dMARK; + dVAR; dSP; dMARK; SV *varsv; HV* stash; GV *gv; SV *sv; I32 markoff = MARK - PL_stack_base; - char *methname; + const char *methname; int how = PERL_MAGIC_tied; U32 items; @@ -872,7 +873,7 @@ PP(pp_tie) PP(pp_untie) { - dSP; + dVAR; dSP; MAGIC *mg; SV *sv = POPs; char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) @@ -932,7 +933,7 @@ PP(pp_tied) PP(pp_dbmopen) { - dSP; + dVAR; dSP; HV *hv; dPOPPOPssrl; HV* stash; @@ -1134,7 +1135,10 @@ PP(pp_sselect) } } - PUSHi(nfound); + if (nfound == -1) + PUSHs(&PL_sv_undef); + else + PUSHi(nfound); if (GIMME == G_ARRAY && tbuf) { value = (NV)(timebuf.tv_sec) + (NV)(timebuf.tv_usec) / 1000000.0; @@ -1193,7 +1197,7 @@ PP(pp_select) PP(pp_getc) { - dSP; dTARGET; + dVAR; dSP; dTARGET; GV *gv; IO *io = NULL; MAGIC *mg; @@ -1250,6 +1254,7 @@ PP(pp_read) STATIC OP * S_doform(pTHX_ CV *cv, GV *gv, OP *retop) { + dVAR; register PERL_CONTEXT *cx; I32 gimme = GIMME_V; @@ -1311,7 +1316,7 @@ PP(pp_enterwrite) PP(pp_leavewrite) { - dSP; + dVAR; dSP; GV *gv = cxstack[cxstack_ix].blk_sub.gv; register IO *io = GvIOp(gv); PerlIO *ofp = IoOFP(io); @@ -1337,16 +1342,16 @@ PP(pp_leavewrite) if (!IoFMT_NAME(io)) IoFMT_NAME(io) = savepv(GvNAME(gv)); topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv))); - topgv = gv_fetchpv(SvPVX(topname), FALSE, SVt_PVFM); + topgv = gv_fetchsv(topname, FALSE, SVt_PVFM); if ((topgv && GvFORM(topgv)) || !gv_fetchpv("top",FALSE,SVt_PVFM)) - IoTOP_NAME(io) = savepv(SvPVX(topname)); + IoTOP_NAME(io) = savesvpv(topname); else - IoTOP_NAME(io) = savepv("top"); + IoTOP_NAME(io) = savepvn("top", 3); } topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM); if (!topgv || !GvFORM(topgv)) { - IoLINES_LEFT(io) = 100000000; + IoLINES_LEFT(io) = IoPAGE_LEN(io); goto forget_top; } IoTOP_GV(io) = topgv; @@ -1439,7 +1444,7 @@ PP(pp_leavewrite) PP(pp_prtf) { - dSP; dMARK; dORIGMARK; + dVAR; dSP; dMARK; dORIGMARK; GV *gv; IO *io; PerlIO *fp; @@ -1543,7 +1548,7 @@ PP(pp_sysopen) PP(pp_sysread) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; int offset; GV *gv; IO *io; @@ -1604,6 +1609,7 @@ PP(pp_sysread) buffer = SvPVutf8_force(bufsv, blen); /* UTF-8 may not have been set if they are all low bytes */ SvUTF8_on(bufsv); + buffer_utf8 = 0; } else { buffer = SvPV_force(bufsv, blen); @@ -1681,7 +1687,7 @@ PP(pp_sysread) (should be 2 * length + offset + 1, or possibly something longer if PL_encoding is true) */ buffer = SvGROW(bufsv, (STRLEN)(length+offset+1)); - if (offset > bufsize) { /* Zero any newly allocated space */ + if (offset > 0 && (Sock_size_t)offset > bufsize) { /* Zero any newly allocated space */ Zero(buffer+bufsize, offset-bufsize, char); } buffer = buffer + offset; @@ -1696,8 +1702,8 @@ PP(pp_sysread) SvCUR_set(bufsv, offset); read_target = sv_newmortal(); - SvUPGRADE(read_target, SVt_PV); - buffer = SvGROW(read_target, length + 1); + (void)SvUPGRADE(read_target, SVt_PV); + buffer = SvGROW(read_target, (STRLEN)(length + 1)); } if (PL_op->op_type == OP_SYSREAD) { @@ -1796,7 +1802,7 @@ PP(pp_sysread) PP(pp_syswrite) { - dSP; + dVAR; dSP; int items = (SP - PL_stack_base) - TOPMARK; if (items == 2) { SV *sv; @@ -1810,7 +1816,7 @@ PP(pp_syswrite) PP(pp_send) { - dSP; dMARK; dORIGMARK; dTARGET; + dVAR; dSP; dMARK; dORIGMARK; dTARGET; GV *gv; IO *io; SV *bufsv; @@ -1952,7 +1958,7 @@ PP(pp_recv) PP(pp_eof) { - dSP; + dVAR; dSP; GV *gv; IO *io; MAGIC *mg; @@ -1966,7 +1972,7 @@ PP(pp_eof) if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) { IoLINES(io) = 0; IoFLAGS(io) &= ~IOf_START; - do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp); + do_open(gv, (char *)"-", 1, FALSE, O_RDONLY, 0, Nullfp); sv_setpvn(GvSV(gv), "-", 1); SvSETMAGIC(GvSV(gv)); } @@ -1999,7 +2005,7 @@ PP(pp_eof) PP(pp_tell) { - dSP; dTARGET; + dVAR; dSP; dTARGET; GV *gv; IO *io; MAGIC *mg; @@ -2037,7 +2043,7 @@ PP(pp_seek) PP(pp_sysseek) { - dSP; + dVAR; dSP; GV *gv; IO *io; int whence = POPi; @@ -2108,15 +2114,13 @@ PP(pp_truncate) * might not be signed: if it is not, clever compilers will moan. */ /* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */ SETERRNO(0,0); -#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP) { - STRLEN n_a; int result = 1; GV *tmpgv; IO *io; if (PL_op->op_flags & OPf_SPECIAL) { - tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO); + tmpgv = gv_fetchsv(POPs, FALSE, SVt_PVIO); do_ftruncate_gv: if (!GvIO(tmpgv)) @@ -2143,7 +2147,8 @@ PP(pp_truncate) else { SV *sv = POPs; char *name; - + STRLEN n_a; + if (SvTYPE(sv) == SVt_PVGV) { tmpgv = (GV*)sv; /* *main::FRED for example */ goto do_ftruncate_gv; @@ -2183,9 +2188,6 @@ PP(pp_truncate) SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } -#else - DIE(aTHX_ "truncate not implemented"); -#endif } PP(pp_fcntl) @@ -2198,7 +2200,7 @@ PP(pp_ioctl) dSP; dTARGET; SV *argsv = POPs; unsigned int func = POPu; - int optype = PL_op->op_type; + const int optype = PL_op->op_type; char *s; IV retval; GV *gv = (GV*)POPs; @@ -2845,12 +2847,10 @@ PP(pp_stat) } sv_setpv(PL_statname, SvPV(sv,n_a)); PL_statgv = Nullgv; -#ifdef HAS_LSTAT PL_laststype = PL_op->op_type; if (PL_op->op_type == OP_LSTAT) PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache); else -#endif PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache); if (PL_laststatval < 0) { if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n')) @@ -3347,8 +3347,7 @@ PP(pp_fttty) dSP; int fd; GV *gv; - char *tmps = Nullch; - STRLEN n_a; + SV *tmpsv = Nullsv; STACKED_FTEST_CHECK; @@ -3359,12 +3358,18 @@ PP(pp_fttty) else if (SvROK(TOPs) && isGV(SvRV(TOPs))) gv = (GV*)SvRV(POPs); else - gv = gv_fetchpv(tmps = POPpx, FALSE, SVt_PVIO); + gv = gv_fetchsv(tmpsv = POPs, FALSE, SVt_PVIO); if (GvIO(gv) && IoIFP(GvIOp(gv))) fd = PerlIO_fileno(IoIFP(GvIOp(gv))); - else if (tmps && isDIGIT(*tmps)) - fd = atoi(tmps); + else if (tmpsv && SvOK(tmpsv)) { + STRLEN n_a; + char *tmps = SvPV(tmpsv, n_a); + if (isDIGIT(*tmps)) + fd = atoi(tmps); + else + RETPUSHUNDEF; + } else RETPUSHUNDEF; if (PerlLIO_isatty(fd)) @@ -3459,7 +3464,6 @@ PP(pp_fttext) sv = POPs; really_filename: PL_statgv = Nullgv; - PL_laststatval = -1; PL_laststype = OP_STAT; sv_setpv(PL_statname, SvPV(sv, n_a)); if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) { @@ -3967,7 +3971,7 @@ nope: PP(pp_telldir) { #if defined(HAS_TELLDIR) || defined(telldir) - dSP; dTARGET; + dVAR; dSP; dTARGET; /* XXX does _anyone_ need this? --AD 2/20/1998 */ /* XXX netbsd still seemed to. XXX HAS_TELLDIR_PROTO is new style, NEED_TELLDIR_PROTO is old style. @@ -4178,7 +4182,6 @@ PP(pp_system) I32 value; STRLEN n_a; int result; - I32 did_pipes = 0; if (PL_tainting) { TAINT_ENV(); @@ -4195,6 +4198,7 @@ PP(pp_system) { Pid_t childpid; int pp[2]; + I32 did_pipes = 0; if (PerlProc_pipe(pp) >= 0) did_pipes = 1; @@ -4276,14 +4280,14 @@ PP(pp_system) result = 0; if (PL_op->op_flags & OPf_STACKED) { SV *really = *++MARK; -# if defined(WIN32) || defined(OS2) +# if defined(WIN32) || defined(OS2) || defined(SYMBIAN) value = (I32)do_aspawn(really, MARK, SP); # else value = (I32)do_aspawn(really, (void **)MARK, (void **)SP); # endif } else if (SP - MARK != 1) { -# if defined(WIN32) || defined(OS2) +# if defined(WIN32) || defined(OS2) || defined(SYMBIAN) value = (I32)do_aspawn(Nullsv, MARK, SP); # else value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP); @@ -4527,10 +4531,12 @@ PP(pp_gmtime) { dSP; Time_t when; - struct tm *tmbuf; - static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; - static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; + const struct tm *tmbuf; + static const char * const dayname[] = + {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; + static const char * const monname[] = + {"Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; if (MAXARG < 1) (void)time(&when); @@ -5863,3 +5869,13 @@ lockf_emulate_flock(int fd, int operation) } #endif /* LOCKF_EMULATE_FLOCK */ + +/* + * Local variables: + * c-indentation-style: bsd + * c-basic-offset: 4 + * indent-tabs-mode: t + * End: + * + * vim: shiftwidth=4: +*/