X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d791f93ffabd1e893895f262d34999ccc589f7a0..5c9f4bd2be62c07fee7298eec0ab8253d15b297a:/doio.c diff --git a/doio.c b/doio.c index c2b1102..94f2003 100644 --- a/doio.c +++ b/doio.c @@ -66,7 +66,7 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, I32 num_svs) { dVAR; - register IO * const io = GvIOn(gv); + IO * const io = GvIOn(gv); PerlIO *saveifp = NULL; PerlIO *saveofp = NULL; int savefd = -1; @@ -320,7 +320,10 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw, } while (isSPACE(*type)) type++; - if (num_svs && (SvIOK(*svp) || (SvPOK(*svp) && looks_like_number(*svp)))) { + if (num_svs && ( + SvIOK(*svp) + || (SvPOKp(*svp) && looks_like_number(*svp)) + )) { fd = SvUV(*svp); num_svs = 0; } @@ -706,7 +709,7 @@ PerlIO * Perl_nextargv(pTHX_ register GV *gv) { dVAR; - register SV *sv; + SV *sv; #ifndef FLEXFILENAMES int filedev; int fileino; @@ -744,6 +747,7 @@ Perl_nextargv(pTHX_ register GV *gv) STRLEN oldlen; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); + SvTAINTED_off(GvSVn(gv)); /* previous tainting irrelevant */ sv_setsv(GvSVn(gv),sv); SvSETMAGIC(GvSV(gv)); PL_oldname = SvPVx(GvSV(gv), oldlen); @@ -990,7 +994,7 @@ bool Perl_do_eof(pTHX_ GV *gv) { dVAR; - register IO * const io = GvIO(gv); + IO * const io = GvIO(gv); PERL_ARGS_ASSERT_DO_EOF; @@ -1036,7 +1040,7 @@ Perl_do_tell(pTHX_ GV *gv) { dVAR; IO *const io = GvIO(gv); - register PerlIO *fp; + PerlIO *fp; PERL_ARGS_ASSERT_DO_TELL; @@ -1057,7 +1061,7 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) { dVAR; IO *const io = GvIO(gv); - register PerlIO *fp; + PerlIO *fp; if (io && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH @@ -1076,7 +1080,7 @@ Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) { dVAR; IO *const io = GvIO(gv); - register PerlIO *fp; + PerlIO *fp; PERL_ARGS_ASSERT_DO_SYSSEEK; @@ -1433,8 +1437,8 @@ bool Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) { dVAR; - register const char **a; - register char *s; + const char **a; + char *s; char *buf; char *cmd; /* Make a copy so we can change it */ @@ -1562,16 +1566,21 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) #endif /* OS2 || WIN32 */ +#ifdef VMS +#include /* for sys$delprc */ +#endif + I32 Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) { dVAR; - register I32 val; - register I32 tot = 0; + I32 val; + I32 tot = 0; const char *const what = PL_op_name[type]; const char *s; STRLEN len; SV ** const oldmark = mark; + bool killgp = FALSE; PERL_ARGS_ASSERT_APPLY; @@ -1639,7 +1648,7 @@ Perl_apply(pTHX_ I32 type, register SV **mark, register SV **sp) case OP_CHOWN: APPLY_TAINT_PROPER(); if (sp - mark > 2) { - register I32 val2; + I32 val2; val = SvIVx(*++mark); val2 = SvIVx(*++mark); APPLY_TAINT_PROPER(); @@ -1682,6 +1691,12 @@ nothing in the core. if (mark == sp) break; s = SvPVx_const(*++mark, len); + if (*s == '-' && isALPHA(s[1])) + { + s++; + len--; + killgp = TRUE; + } if (isALPHA(*s)) { if (*s == 'S' && s[1] == 'I' && s[2] == 'G') { s += 3; @@ -1691,21 +1706,26 @@ nothing in the core. Perl_croak(aTHX_ "Unrecognized signal name \"%"SVf"\"", SVfARG(*mark)); } else + { val = SvIV(*mark); + if (val < 0) + { + killgp = TRUE; + val = -val; + } + } APPLY_TAINT_PROPER(); tot = sp - mark; #ifdef VMS /* kill() doesn't do process groups (job trees?) under VMS */ - if (val < 0) val = -val; if (val == SIGKILL) { -# include /* Use native sys$delprc() to insure that target process is * deleted; supervisor-mode images don't pay attention to * CRTL's emulation of Unix-style signals and kill() */ while (++mark <= sp) { I32 proc; - register unsigned long int __vmssts; + unsigned long int __vmssts; SvGETMAGIC(*mark); if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark))) Perl_croak(aTHX_ "Can't kill a non-numeric process ID"); @@ -1730,34 +1750,19 @@ nothing in the core. break; } #endif - if (val < 0) { - val = -val; - while (++mark <= sp) { - I32 proc; - SvGETMAGIC(*mark); - if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark))) - Perl_croak(aTHX_ "Can't kill a non-numeric process ID"); - proc = SvIV_nomg(*mark); - APPLY_TAINT_PROPER(); -#ifdef HAS_KILLPG - if (PerlProc_killpg(proc,val)) /* BSD */ -#else - if (PerlProc_kill(-proc,val)) /* SYSV */ -#endif - tot--; - } - } - else { - while (++mark <= sp) { - I32 proc; - SvGETMAGIC(*mark); - if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark))) - Perl_croak(aTHX_ "Can't kill a non-numeric process ID"); - proc = SvIV_nomg(*mark); - APPLY_TAINT_PROPER(); - if (PerlProc_kill(proc, val)) - tot--; + while (++mark <= sp) { + Pid_t proc; + SvGETMAGIC(*mark); + if (!(SvNIOK(*mark) || looks_like_number(*mark))) + Perl_croak(aTHX_ "Can't kill a non-numeric process ID"); + proc = SvIV_nomg(*mark); + if (killgp) + { + proc = -proc; } + APPLY_TAINT_PROPER(); + if (PerlProc_kill(proc, val)) + tot--; } PERL_ASYNC_CHECK(); break; @@ -2279,9 +2284,10 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) if (optype == OP_SHMREAD) { char *mbuf; /* suppress warning when reading into undef var (tchrist 3/Mar/00) */ + SvGETMAGIC(mstr); + SvUPGRADE(mstr, SVt_PV); if (! SvOK(mstr)) sv_setpvs(mstr, ""); - SvUPGRADE(mstr, SVt_PV); SvPOK_only(mstr); mbuf = SvGROW(mstr, (STRLEN)msize+1); @@ -2381,9 +2387,12 @@ Perl_vms_start_glob { GV * const envgv = gv_fetchpvs("ENV", 0, SVt_PVHV); SV ** const home = hv_fetchs(GvHV(envgv), "HOME", 0); + SV ** const path = hv_fetchs(GvHV(envgv), "PATH", 0); if (home && *home) SvGETMAGIC(*home); + if (path && *path) SvGETMAGIC(*path); save_hash(gv_fetchpvs("ENV", 0, SVt_PVHV)); if (home && *home) SvSETMAGIC(*home); + if (path && *path) SvSETMAGIC(*path); } (void)do_open(PL_last_in_gv, (char*)SvPVX_const(tmpcmd), SvCUR(tmpcmd), FALSE, O_RDONLY, 0, NULL); @@ -2397,8 +2406,8 @@ Perl_vms_start_glob * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */