From: Dave Mitchell Date: Fri, 11 May 2007 23:22:24 +0000 (+0000) Subject: move PL_rsfp into the PL_parser struct X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2f9285f84584cb56950bf07de6ded6ebcdc3d302;p=p5sagit%2Fp5-mst-13.2.git move PL_rsfp into the PL_parser struct and simplify its creation and destruction p4raw-id: //depot/perl@31199 --- diff --git a/embed.fnc b/embed.fnc index fcb5b56..97e3422 100644 --- a/embed.fnc +++ b/embed.fnc @@ -403,7 +403,7 @@ p |OP* |jmaybe |NN OP* arg pP |I32 |keyword |NN const char* d|I32 len|bool all_keywords Ap |void |leave_scope |I32 base EXp |void |lex_end -p |void |lex_start |NULLOK SV* line +p |void |lex_start |NULLOK SV* line|NULLOK PerlIO *rsfp Ap |void |op_null |NN OP* o EXp |void |op_clear |NN OP* o Ap |void |op_refcnt_lock @@ -1244,7 +1244,7 @@ s |void |Slab_to_rw |NN void *op #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) -s |void |find_beginning |NN SV* linestr_sv +s |void |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp s |void |forbid_setid |const char flag|const int suidscript s |void |incpush |NULLOK const char *dir|bool addsubdirs|bool addoldvers|bool usesep|bool canrelocate s |void |init_interp @@ -1256,11 +1256,13 @@ s |void |init_predump_symbols rs |void |my_exit_jump s |void |nuke_stacks s |int |open_script |NN const char *scriptname|bool dosearch \ - |NN SV *sv|NN int *suidscript + |NN SV *sv|NN int *suidscript|NN PerlIO **rsfpp s |void |usage |NN const char *name s |void |validate_suid |NN const char *validarg \ |NN const char *scriptname|int fdscript \ - |int suidscript|NN SV* linestr_sv + |int suidscript|NN SV* linestr_sv \ + |NN PerlIO *rsfp + # if defined(IAMSUID) s |int |fd_on_nosuid_fs|int fd # endif diff --git a/embed.h b/embed.h index c076e84..1737ad3 100644 --- a/embed.h +++ b/embed.h @@ -2661,7 +2661,7 @@ #define lex_end() Perl_lex_end(aTHX) #endif #ifdef PERL_CORE -#define lex_start(a) Perl_lex_start(aTHX_ a) +#define lex_start(a,b) Perl_lex_start(aTHX_ a,b) #endif #define op_null(a) Perl_op_null(aTHX_ a) #if defined(PERL_CORE) || defined(PERL_EXT) @@ -3517,7 +3517,7 @@ #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) #ifdef PERL_CORE -#define find_beginning(a) S_find_beginning(aTHX_ a) +#define find_beginning(a,b) S_find_beginning(aTHX_ a,b) #define forbid_setid(a,b) S_forbid_setid(aTHX_ a,b) #define incpush(a,b,c,d,e) S_incpush(aTHX_ a,b,c,d,e) #define init_interp() S_init_interp(aTHX) @@ -3528,9 +3528,9 @@ #define init_predump_symbols() S_init_predump_symbols(aTHX) #define my_exit_jump() S_my_exit_jump(aTHX) #define nuke_stacks() S_nuke_stacks(aTHX) -#define open_script(a,b,c,d) S_open_script(aTHX_ a,b,c,d) +#define open_script(a,b,c,d,e) S_open_script(aTHX_ a,b,c,d,e) #define usage(a) S_usage(aTHX_ a) -#define validate_suid(a,b,c,d,e) S_validate_suid(aTHX_ a,b,c,d,e) +#define validate_suid(a,b,c,d,e,f) S_validate_suid(aTHX_ a,b,c,d,e,f) #endif # if defined(IAMSUID) #ifdef PERL_CORE diff --git a/embedvar.h b/embedvar.h index f5334b5..338db265 100644 --- a/embedvar.h +++ b/embedvar.h @@ -298,7 +298,6 @@ #define PL_rehash_seed (vTHX->Irehash_seed) #define PL_rehash_seed_set (vTHX->Irehash_seed_set) #define PL_replgv (vTHX->Ireplgv) -#define PL_rsfp (vTHX->Irsfp) #define PL_rsfp_filters (vTHX->Irsfp_filters) #define PL_runops (vTHX->Irunops) #define PL_runops_dbg (vTHX->Irunops_dbg) @@ -548,7 +547,6 @@ #define PL_Irehash_seed PL_rehash_seed #define PL_Irehash_seed_set PL_rehash_seed_set #define PL_Ireplgv PL_replgv -#define PL_Irsfp PL_rsfp #define PL_Irsfp_filters PL_rsfp_filters #define PL_Irunops PL_runops #define PL_Irunops_dbg PL_runops_dbg diff --git a/ext/Devel/PPPort/parts/inc/variables b/ext/Devel/PPPort/parts/inc/variables index 8901509..1011b1a 100644 --- a/ext/Devel/PPPort/parts/inc/variables +++ b/ext/Devel/PPPort/parts/inc/variables @@ -97,6 +97,7 @@ __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT; # define PL_PARSER_EXISTS # define PL_expect (PL_parser ? PL_parser->expect : 0) # define PL_copline (PL_parser ? PL_parser->copline : 0) +# define PL_rsfp (PL_parser ? PL_parser->rsfp : 0) #endif =xsinit @@ -227,7 +228,11 @@ other_variables() ppp_TESTVAR(PL_perl_destruct_level); ppp_TESTVAR(PL_perldb); ppp_TESTVAR(PL_rsfp_filters); +#ifdef PL_PARSER_EXISTS + ppp_TESTVAR(PL_parser); /* just any var that isn't PL_expect */ +#else ppp_TESTVAR(PL_rsfp); +#endif ppp_TESTVAR(PL_stack_base); ppp_TESTVAR(PL_stack_sp); ppp_TESTVAR(PL_statcache); diff --git a/intrpvar.h b/intrpvar.h index e2c7b19..6f88ca7 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -214,7 +214,6 @@ PERLVAR(Imodglobal, HV *) /* per-interp module data */ /* these used to be in global before 5.004_68 */ PERLVARI(Iprofiledata, U32 *, NULL) /* table of ops, counts */ -PERLVARI(Irsfp, PerlIO * VOL, NULL) /* current source file pointer */ PERLVARI(Irsfp_filters, AV *, NULL) /* keeps active source filters */ PERLVAR(Icompiling, COP) /* compiling/done executing marker */ diff --git a/op.c b/op.c index 40b415d..7015695 100644 --- a/op.c +++ b/op.c @@ -3866,7 +3866,7 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args) ENTER; SAVEVPTR(PL_curcop); - lex_start(NULL); + lex_start(NULL, NULL); utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), veop, modname, imop); LEAVE; diff --git a/parser.h b/parser.h index 1df14b4..082e493 100644 --- a/parser.h +++ b/parser.h @@ -70,6 +70,7 @@ typedef struct yy_parser { char *last_uni; /* position of last named-unary op */ char *last_lop; /* position of last list operator */ U8 lex_state; /* next token is determined */ + PerlIO *rsfp; /* current source file pointer */ #ifdef PERL_MAD SV *endwhite; diff --git a/perl.c b/perl.c index da52f85..d4abea8 100644 --- a/perl.c +++ b/perl.c @@ -868,9 +868,10 @@ perl_destruct(pTHXx) /* loosen bonds of global variables */ - if(PL_rsfp) { - (void)PerlIO_close(PL_rsfp); - PL_rsfp = NULL; + /* XXX can PL_parser still be non-null here? */ + if(PL_parser && PL_parser->rsfp) { + (void)PerlIO_close(PL_parser->rsfp); + PL_parser->rsfp = NULL; } /* Filters for program text */ @@ -1654,7 +1655,7 @@ STATIC void * S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { dVAR; - PerlIO *tmpfp; + PerlIO *rsfp; int argc = PL_origargc; char **argv = PL_origargv; const char *scriptname = NULL; @@ -2112,9 +2113,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) { int suidscript; const int fdscript - = open_script(scriptname, dosearch, sv, &suidscript); + = open_script(scriptname, dosearch, sv, &suidscript, &rsfp); - validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv); + validate_suid(validarg, scriptname, fdscript, suidscript, + linestr_sv, rsfp); #ifndef PERL_MICRO # if defined(SIGCHLD) || defined(SIGCLD) @@ -2144,7 +2146,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) forbid_setid('x', suidscript); /* Hence you can't get here if suidscript >= 0 */ - find_beginning(linestr_sv); + find_beginning(linestr_sv, rsfp); if (cddir && PerlDir_chdir( (char *)cddir ) < 0) Perl_croak(aTHX_ "Can't chdir to %s",cddir); } @@ -2259,10 +2261,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } #endif - tmpfp = PL_rsfp; - PL_rsfp = NULL; - lex_start(linestr_sv); - PL_rsfp = tmpfp; + lex_start(linestr_sv, rsfp); PL_subname = newSVpvs("main"); /* now parse the script */ @@ -3584,7 +3583,7 @@ S_init_main_stash(pTHX) STATIC int S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, - int *suidscript) + int *suidscript, PerlIO **rsfpp) { #ifndef IAMSUID const char *quote; @@ -3642,11 +3641,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, if (*PL_origfilename == '-' && PL_origfilename[1] == '\0') scriptname = (char *)""; if (fdscript >= 0) { - PL_rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE); + *rsfpp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE); # if defined(HAS_FCNTL) && defined(F_SETFD) - if (PL_rsfp) + if (*rsfpp) /* ensure close-on-exec */ - fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1); + fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1); # endif } #ifdef IAMSUID @@ -3728,24 +3727,24 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, "PL_preprocess: cmd=\"%s\"\n", SvPVX_const(cmd))); - PL_rsfp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r"); + *rsfpp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r"); SvREFCNT_dec(cmd); SvREFCNT_dec(cpp); } else if (!*scriptname) { forbid_setid(0, *suidscript); - PL_rsfp = PerlIO_stdin(); + *rsfpp = PerlIO_stdin(); } else { - PL_rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE); + *rsfpp = PerlIO_open(scriptname,PERL_SCRIPT_MODE); # if defined(HAS_FCNTL) && defined(F_SETFD) - if (PL_rsfp) + if (*rsfpp) /* ensure close-on-exec */ - fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1); + fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1); # endif } #endif /* IAMSUID */ - if (!PL_rsfp) { + if (!*rsfpp) { /* PSz 16 Sep 03 Keep neat error message */ if (PL_e_script) Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno)); @@ -3892,7 +3891,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd) STATIC void S_validate_suid(pTHX_ const char *validarg, const char *scriptname, - int fdscript, int suidscript, SV *linestr_sv) + int fdscript, int suidscript, SV *linestr_sv, PerlIO *rsfp) { dVAR; #ifdef IAMSUID @@ -3929,7 +3928,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname, #ifdef DOSUID const char *s, *s2; - if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */ + if (PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf) < 0) /* normal stat is insecure */ Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename); if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) { I32 len; @@ -4018,7 +4017,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname, * Seems safe enough to do as root. */ #if !defined(NO_NOSUID_CHECK) - if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) { + if (fd_on_nosuid_fs(PerlIO_fileno(rsfp))) { Perl_croak(aTHX_ "Setuid script on nosuid or noexec filesystem\n"); } #endif @@ -4032,7 +4031,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname, PL_doswitches = FALSE; /* -s is insecure in suid */ /* PSz 13 Nov 03 But -s was caught elsewhere ... so unsetting it here is useless(?!) */ CopLINE_inc(PL_curcop); - if (sv_gets(linestr_sv, PL_rsfp, 0) == NULL) + if (sv_gets(linestr_sv, rsfp, 0) == NULL) Perl_croak(aTHX_ "No #! line"); linestr = SvPV_nolen_const(linestr_sv); /* required even on Sys V */ @@ -4120,8 +4119,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n"); * in fact will use that to distinguish this from "normal" * usage, see comments above. */ - PerlIO_rewind(PL_rsfp); - PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0); /* just in case rewind didn't */ + PerlIO_rewind(rsfp); + PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */ /* PSz 27 Feb 04 Sanity checks on scriptname */ if ((!scriptname) || (!*scriptname) ) { Perl_croak(aTHX_ "No setuid script name\n"); @@ -4138,9 +4137,9 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n"); Perl_croak(aTHX_ "Can't change argv to have fd script\n"); } PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s", - PerlIO_fileno(PL_rsfp), PL_origargv[which])); + PerlIO_fileno(rsfp), PL_origargv[which])); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */ + fcntl(PerlIO_fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */ #endif PERL_FPU_PRE_EXEC PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP, @@ -4257,8 +4256,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n"); * #endif * into the perly bits. */ - PerlIO_rewind(PL_rsfp); - PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0); /* just in case rewind didn't */ + PerlIO_rewind(rsfp); + PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0); /* just in case rewind didn't */ /* PSz 11 Nov 03 * Keep original arguments: suidperl already has fd script. */ @@ -4268,9 +4267,9 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n"); /* Perl_croak(aTHX_ "Permission denied\n"); */ /* } */ /* PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s", */ -/* PerlIO_fileno(PL_rsfp), PL_origargv[which])); */ +/* PerlIO_fileno(rsfp), PL_origargv[which])); */ #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */ + fcntl(PerlIO_fileno(rsfp),F_SETFD,0); /* ensure no close-on-exec */ #endif PERL_FPU_PRE_EXEC PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP, @@ -4284,7 +4283,7 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n"); PERL_UNUSED_ARG(suidscript); if (PL_euid != PL_uid || PL_egid != PL_gid) { /* (suidperl doesn't exist, in fact) */ #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW - PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf); /* may be either wrapped or real suid */ + 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) || (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID) @@ -4302,7 +4301,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); } STATIC void -S_find_beginning(pTHX_ SV* linestr_sv) +S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) { dVAR; register char *s; @@ -4317,7 +4316,7 @@ S_find_beginning(pTHX_ SV* linestr_sv) /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */ while (PL_doextract || gMacPerl_AlwaysExtract) { - if ((s = sv_gets(linestr_sv, PL_rsfp, 0)) == NULL) { + if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) { if (!gMacPerl_AlwaysExtract) Perl_croak(aTHX_ "No Perl script found in input\n"); @@ -4328,18 +4327,18 @@ S_find_beginning(pTHX_ SV* linestr_sv) PL_doextract = FALSE; /* Pater peccavi, file does not have #! */ - PerlIO_rewind(PL_rsfp); + PerlIO_rewind(rsfp); break; } #else while (PL_doextract) { - if ((s = sv_gets(linestr_sv, PL_rsfp, 0)) == NULL) + if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) Perl_croak(aTHX_ "No Perl script found in input\n"); #endif s2 = s; if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) { - PerlIO_ungetc(PL_rsfp, '\n'); /* to keep line count right */ + PerlIO_ungetc(rsfp, '\n'); /* to keep line count right */ PL_doextract = FALSE; while (*s && !(isSPACE (*s) || *s == '#')) s++; s2 = s; @@ -4357,7 +4356,7 @@ S_find_beginning(pTHX_ SV* linestr_sv) * by counting lines we already skipped over */ for (; maclines > 0 ; maclines--) - PerlIO_ungetc(PL_rsfp, '\n'); + PerlIO_ungetc(rsfp, '\n'); break; diff --git a/perlapi.h b/perlapi.h index 98dd3aa..a3e3721 100644 --- a/perlapi.h +++ b/perlapi.h @@ -472,8 +472,6 @@ END_EXTERN_C #define PL_rehash_seed_set (*Perl_Irehash_seed_set_ptr(aTHX)) #undef PL_replgv #define PL_replgv (*Perl_Ireplgv_ptr(aTHX)) -#undef PL_rsfp -#define PL_rsfp (*Perl_Irsfp_ptr(aTHX)) #undef PL_rsfp_filters #define PL_rsfp_filters (*Perl_Irsfp_filters_ptr(aTHX)) #undef PL_runops diff --git a/pp_ctl.c b/pp_ctl.c index 26e1cb8..60b6b0a 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2745,7 +2745,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) STRLEN len; ENTER; - lex_start(sv); + lex_start(sv, NULL); SAVETMPS; /* switch to eval mode */ @@ -3377,11 +3377,10 @@ PP(pp_require) ENTER; SAVETMPS; - lex_start(NULL); + lex_start(NULL, tryrsfp); SAVEGENERICSV(PL_rsfp_filters); PL_rsfp_filters = NULL; - PL_rsfp = tryrsfp; SAVEHINTS(); PL_hints = 0; SAVECOMPILEWARNINGS(); @@ -3449,7 +3448,7 @@ PP(pp_entereval) TAINT_PROPER("eval"); ENTER; - lex_start(sv); + lex_start(sv, NULL); SAVETMPS; /* switch to eval mode */ diff --git a/proto.h b/proto.h index a27ad79..cbd261c 100644 --- a/proto.h +++ b/proto.h @@ -1025,7 +1025,7 @@ PERL_CALLCONV I32 Perl_keyword(pTHX_ const char* d, I32 len, bool all_keywords) PERL_CALLCONV void Perl_leave_scope(pTHX_ I32 base); PERL_CALLCONV void Perl_lex_end(pTHX); -PERL_CALLCONV void Perl_lex_start(pTHX_ SV* line); +PERL_CALLCONV void Perl_lex_start(pTHX_ SV* line, PerlIO *rsfp); PERL_CALLCONV void Perl_op_null(pTHX_ OP* o) __attribute__nonnull__(pTHX_1); @@ -3357,8 +3357,9 @@ STATIC void S_Slab_to_rw(pTHX_ void *op) #endif #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) -STATIC void S_find_beginning(pTHX_ SV* linestr_sv) - __attribute__nonnull__(pTHX_1); +STATIC void S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp) + __attribute__nonnull__(pTHX_1) + __attribute__nonnull__(pTHX_2); STATIC void S_forbid_setid(pTHX_ const char flag, const int suidscript); STATIC void S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, bool canrelocate); @@ -3374,18 +3375,21 @@ STATIC void S_my_exit_jump(pTHX) __attribute__noreturn__; STATIC void S_nuke_stacks(pTHX); -STATIC int S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, int *suidscript) +STATIC int S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, int *suidscript, PerlIO **rsfpp) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_3) - __attribute__nonnull__(pTHX_4); + __attribute__nonnull__(pTHX_4) + __attribute__nonnull__(pTHX_5); STATIC void S_usage(pTHX_ const char *name) __attribute__nonnull__(pTHX_1); -STATIC void S_validate_suid(pTHX_ const char *validarg, const char *scriptname, int fdscript, int suidscript, SV* linestr_sv) +STATIC void S_validate_suid(pTHX_ const char *validarg, const char *scriptname, int fdscript, int suidscript, SV* linestr_sv, PerlIO *rsfp) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) - __attribute__nonnull__(pTHX_5); + __attribute__nonnull__(pTHX_5) + __attribute__nonnull__(pTHX_6); + # if defined(IAMSUID) STATIC int S_fd_on_nosuid_fs(pTHX_ int fd); diff --git a/sv.c b/sv.c index 4b27b29..71fdd43 100644 --- a/sv.c +++ b/sv.c @@ -9576,6 +9576,7 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param) parser->copline = proto->copline; parser->last_lop_op = proto->last_lop_op; parser->lex_state = proto->lex_state; + parser->rsfp = fp_dup(proto->rsfp, '<', param); parser->linestr = sv_dup_inc(proto->linestr, param); @@ -9600,6 +9601,7 @@ Perl_parser_dup(pTHX_ const yy_parser *proto, CLONE_PARAMS* param) parser->bufend = ls + SvCUR(parser->linestr); } + #ifdef PERL_MAD parser->endwhite = proto->endwhite; parser->faketokens = proto->faketokens; @@ -11214,7 +11216,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_custom_op_descs = hv_dup_inc(proto_perl->Icustom_op_descs,param); PL_profiledata = NULL; - PL_rsfp = fp_dup(proto_perl->Irsfp, '<', param); /* PL_rsfp_filters entries have fake IoDIRP() */ PL_rsfp_filters = av_dup_inc(proto_perl->Irsfp_filters, param); diff --git a/toke.c b/toke.c index 9726a31..40eeb2a 100644 --- a/toke.c +++ b/toke.c @@ -61,6 +61,7 @@ #define PL_last_lop (PL_parser->last_lop) #define PL_last_lop_op (PL_parser->last_lop_op) #define PL_lex_state (PL_parser->lex_state) +#define PL_rsfp (PL_parser->rsfp) #ifdef PERL_MAD # define PL_endwhite (PL_parser->endwhite) @@ -638,7 +639,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) */ void -Perl_lex_start(pTHX_ SV *line) +Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp) { dVAR; const char *s = NULL; @@ -665,7 +666,6 @@ Perl_lex_start(pTHX_ SV *line) /* initialise lexer state */ SAVECOPLINE(PL_curcop); - SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp); #ifdef PERL_MAD parser->curforce = -1; @@ -675,6 +675,8 @@ Perl_lex_start(pTHX_ SV *line) parser->copline = NOLINE; PL_lex_state = LEX_NORMAL; parser->expect = XSTATE; + parser->rsfp = rsfp; + Newx(parser->lex_brackstack, 120, char); Newx(parser->lex_casestack, 12, char); *parser->lex_casestack = '\0'; @@ -702,7 +704,6 @@ Perl_lex_start(pTHX_ SV *line) parser->linestart = SvPVX(parser->linestr); parser->bufend = parser->bufptr + SvCUR(parser->linestr); parser->last_lop = parser->last_uni = NULL; - PL_rsfp = 0; } @@ -713,6 +714,12 @@ Perl_parser_free(pTHX_ const yy_parser *parser) { SvREFCNT_dec(parser->linestr); + if (parser->rsfp == PerlIO_stdin()) + PerlIO_clearerr(parser->rsfp); + else if (parser->rsfp && parser->old_parser + && parser->rsfp != parser->old_parser->rsfp) + PerlIO_close(parser->rsfp); + Safefree(parser->stack); Safefree(parser->lex_brackstack); Safefree(parser->lex_casestack); @@ -12659,23 +12666,6 @@ S_swallow_bom(pTHX_ U8 *s) return (char*)s; } -/* - * restore_rsfp - * Restore a source filter. - */ - -static void -restore_rsfp(pTHX_ void *f) -{ - dVAR; - PerlIO * const fp = (PerlIO*)f; - - if (PL_rsfp == PerlIO_stdin()) - PerlIO_clearerr(PL_rsfp); - else if (PL_rsfp && (PL_rsfp != fp)) - PerlIO_close(PL_rsfp); - PL_rsfp = fp; -} #ifndef PERL_NO_UTF16_FILTER static I32