diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | pp_ctl.c | 13 | ||||
| -rw-r--r-- | scope.c | 13 | ||||
| -rw-r--r-- | scope.h | 15 | ||||
| -rw-r--r-- | t/comp/require.t | 36 | ||||
| -rw-r--r-- | toke.c | 4 |
6 files changed, 67 insertions, 15 deletions
@@ -684,6 +684,7 @@ t/comp/multiline.t See if multiline strings work t/comp/package.t See if packages work t/comp/proto.t See if function prototypes work t/comp/redef.t See if we get correct warnings on redefined subs +t/comp/require.t See if require works t/comp/script.t See if script invokation works t/comp/term.t See if more terms work t/comp/use.t See if pragmas work @@ -2629,6 +2629,7 @@ PP(pp_leaveeval) assert(CvDEPTH(compcv) == 1); #endif CvDEPTH(compcv) = 0; + lex_end(); if (optype == OP_REQUIRE && !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) @@ -2637,13 +2638,13 @@ PP(pp_leaveeval) char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); retop = die("%s did not return a true value", name); + /* die_where() did LEAVE, or we won't be here */ + } + else { + LEAVE; + if (!(save_flags & OPf_SPECIAL)) + sv_setpv(ERRSV,""); } - - lex_end(); - LEAVE; - - if (!(save_flags & OPf_SPECIAL)) - sv_setpv(ERRSV,""); RETURNOP(retop); } @@ -258,12 +258,11 @@ void save_item(register SV *item) { dTHR; - register SV *sv; + register SV *sv = NEWSV(0,0); + sv_setsv(sv,item); SSCHECK(3); SSPUSHPTR(item); /* remember the pointer */ - sv = NEWSV(0,0); - sv_setsv(sv,item); SSPUSHPTR(sv); /* remember the value */ SSPUSHINT(SAVEt_ITEM); } @@ -440,11 +439,11 @@ save_list(register SV **sarg, I32 maxsarg) register SV *sv; register I32 i; - SSCHECK(3 * maxsarg); for (i = 1; i <= maxsarg; i++) { - SSPUSHPTR(sarg[i]); /* remember the pointer */ sv = NEWSV(0,0); sv_setsv(sv,sarg[i]); + SSCHECK(3); + SSPUSHPTR(sarg[i]); /* remember the pointer */ SSPUSHPTR(sv); /* remember the value */ SSPUSHINT(SAVEt_ITEM); } @@ -607,14 +606,14 @@ leave_scope(I32 base) case SAVEt_GP: /* scalar reference */ ptr = SSPOPPTR; gv = (GV*)SSPOPPTR; - gp_free(gv); - GvGP(gv) = (GP*)ptr; if (SvPOK(gv) && SvLEN(gv) > 0) { Safefree(SvPVX(gv)); } SvPVX(gv) = (char *)SSPOPPTR; SvCUR(gv) = (STRLEN)SSPOPIV; SvLEN(gv) = (STRLEN)SSPOPIV; + gp_free(gv); + GvGP(gv) = (GP*)ptr; SvREFCNT_dec(gv); break; case SAVEt_FREESV: @@ -39,8 +39,23 @@ #define SAVETMPS save_int((int*)&tmps_floor), tmps_floor = tmps_ix #define FREETMPS if (tmps_ix > tmps_floor) free_tmps() +#ifdef DEBUGGING +#define ENTER \ + STMT_START { \ + push_scope(); \ + DEBUG_l(deb("ENTER scope %ld at %s:%d\n", \ + scopestack_ix, __FILE__, __LINE__)); \ + } STMT_END +#define LEAVE \ + STMT_START { \ + DEBUG_l(deb("LEAVE scope %ld at %s:%d\n", \ + scopestack_ix, __FILE__, __LINE__)); \ + pop_scope(); \ + } STMT_END +#else #define ENTER push_scope() #define LEAVE pop_scope() +#endif #define LEAVE_SCOPE(old) if (savestack_ix > old) leave_scope(old) /* diff --git a/t/comp/require.t b/t/comp/require.t new file mode 100644 index 0000000000..bae0712dfa --- /dev/null +++ b/t/comp/require.t @@ -0,0 +1,36 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = ('.'); +} + +# don't make this lexical +$i = 1; +print "1..3\n"; + +sub do_require { + %INC = (); + open(REQ,">bleah.pm") or die "Can't write 'bleah.pm': $!"; + print REQ @_; + close REQ; + eval { require "bleah.pm" }; + my @a; # magic guard for scope violations (must be first lexical in file) +} + +# run-time failure in require +do_require "0;\n"; +print "# $@\nnot " unless $@ =~ /did not return a true/; +print "ok ",$i++,"\n"; + +# compile-time failure in require +do_require "1)\n"; +print "# $@\nnot " unless $@ =~ /syntax error/; +print "ok ",$i++,"\n"; + +# successful require +do_require "1"; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +unlink 'bleah.pm'; @@ -672,7 +672,7 @@ static I32 sublex_push(void) { dTHR; - push_scope(); + ENTER; lex_state = sublex_info.super_state; SAVEI32(lex_dojoin); @@ -758,7 +758,7 @@ sublex_done(void) return ','; } else { - pop_scope(); + LEAVE; bufend = SvPVX(linestr); bufend += SvCUR(linestr); expect = XOPERATOR; |