X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=291021c913a3eaf4761bea1e5fe17a6ed10ce608;hb=597c4554ca87aa4325a00c70a0fbb22acbfcfa07;hp=1abb48dbcfc70e181e471825ea6f45426102a929;hpb=0544e6df68c5534300178fdd73628d687be1a6b2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 1abb48d..291021c 100644 --- a/perl.c +++ b/perl.c @@ -1127,18 +1127,11 @@ perl_destruct(pTHXx) } /* Now absolutely destruct everything, somehow or other, loops or no. */ - SvFLAGS(PL_fdpid) |= SVTYPEMASK; /* don't clean out pid table now */ - SvFLAGS(PL_strtab) |= SVTYPEMASK; /* don't clean out strtab now */ /* the 2 is for PL_fdpid and PL_strtab */ - while (PL_sv_count > 2 && sv_clean_all()) + while (sv_clean_all() > 2) ; - SvFLAGS(PL_fdpid) &= ~SVTYPEMASK; - SvFLAGS(PL_fdpid) |= SVt_PVAV; - SvFLAGS(PL_strtab) &= ~SVTYPEMASK; - SvFLAGS(PL_strtab) |= SVt_PVHV; - AvREAL_off(PL_fdpid); /* no surviving entries */ SvREFCNT_dec(PL_fdpid); /* needed in io_close() */ PL_fdpid = NULL; @@ -1984,7 +1977,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #endif (s = PerlEnv_getenv("PERL5OPT"))) { - const char *popt = s; while (isSPACE(*s)) s++; if (*s == '-' && *(s+1) == 'T') { @@ -1995,7 +1987,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) else { char *popt_copy = NULL; while (s && *s) { - char *d; + const char *d; while (isSPACE(*s)) s++; if (*s == '-') { @@ -2011,9 +2003,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) while (++s && *s) { if (isSPACE(*s)) { if (!popt_copy) { - popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0))); - s = popt_copy + (s - popt); - d = popt_copy + (d - popt); + popt_copy = SvPVX(sv_2mortal(newSVpv(d,0))); + s = popt_copy + (s - d); + d = popt_copy; } *s++ = '\0'; break; @@ -3247,7 +3239,7 @@ Perl_moreswitches(pTHX_ const char *s) if (colon) Perl_croak(aTHX_ "Invalid module name %.*s with -%c option: " "contains single ':'", - s - start, start, option); + (int)(s - start), start, option); end = s + strlen(s); if (*s != '=') { sv_catpvn(sv, start, end - start); @@ -4252,6 +4244,8 @@ S_validate_suid(pTHX_ PerlIO *rsfp) if (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */ # ifndef SETUID_SCRIPTS_ARE_SECURE_NOW + dVAR; + PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */ if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID) ||