diff options
author | David Mitchell <davem@iabyn.com> | 2010-10-02 11:13:09 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2010-10-03 20:52:10 +0100 |
commit | 4aca2f62efca883199d7975f34b7fb876c280366 (patch) | |
tree | 578ea7884fd21e514009d504531c2483228fd998 /perl.c | |
parent | 95f567513aaa04ffb8bb9d148aff1a85b1eff161 (diff) | |
download | perl-4aca2f62efca883199d7975f34b7fb876c280366.tar.gz |
eval_sv() and eval_pv() don't fail on syntax err
[perl #3719] eval_sv("some syntax err") cleared $@ and didn't return
a failure indication. This also affected eval_pv() which calls eval_sv().
Fix this and add lots of tests.
Diffstat (limited to 'perl.c')
-rw-r--r-- | perl.c | 13 |
1 files changed, 6 insertions, 7 deletions
@@ -80,12 +80,6 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen); # define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp) #endif -#define CALL_BODY_EVAL(myop) \ - if (PL_op == (myop)) \ - PL_op = PL_ppaddr[OP_ENTEREVAL](aTHX); \ - if (PL_op) \ - CALLRUNOPS(aTHX); - #define CALL_BODY_SUB(myop) \ if (PL_op == (myop)) \ PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); \ @@ -2715,7 +2709,11 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) switch (ret) { case 0: redo_body: - CALL_BODY_EVAL((OP*)&myop); + assert(PL_op == (OP*)(&myop)); + PL_op = PL_ppaddr[OP_ENTEREVAL](aTHX); + if (!PL_op) + goto fail; /* failed in compilation */ + CALLRUNOPS(aTHX); retval = PL_stack_sp - (PL_stack_base + oldmark); if (!(flags & G_KEEPERR)) { CLEAR_ERRSV(); @@ -2738,6 +2736,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) PL_restartop = 0; goto redo_body; } + fail: PL_stack_sp = PL_stack_base + oldmark; if ((flags & G_WANT) == G_ARRAY) retval = 0; |