summaryrefslogtreecommitdiff
path: root/perl.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2010-10-02 11:13:09 +0100
committerDavid Mitchell <davem@iabyn.com>2010-10-03 20:52:10 +0100
commit4aca2f62efca883199d7975f34b7fb876c280366 (patch)
tree578ea7884fd21e514009d504531c2483228fd998 /perl.c
parent95f567513aaa04ffb8bb9d148aff1a85b1eff161 (diff)
downloadperl-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.c13
1 files changed, 6 insertions, 7 deletions
diff --git a/perl.c b/perl.c
index cf42087be2..0a58b7c76b 100644
--- a/perl.c
+++ b/perl.c
@@ -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;