(perl #134177) add G_RETHROW flag to eval_sv()

and update eval_pv() to use it.

1 files changed, 16 insertions, 9 deletions

diff --git a/perl.c b/perl.c
index 2e80cfe940..e642f2e76d 100644
--- a/perl.c
+++ b/perl.c
@@ -3097,6 +3097,9 @@ Perl_call_sv(pTHX_ SV *sv, volatile I32 flags)
 Tells Perl to C<eval> the string in the SV.  It supports the same flags
 as C<call_sv>, with the obvious exception of C<G_EVAL>.  See L<perlcall>.
 
+The C<G_RETHROW> flag can be used if you only need eval_sv() to
+execute code specified by a string, but not catch any errors.
+
 =cut
 */
 
@@ -3178,6 +3181,11 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	    goto redo_body;
 	}
       fail:
+        if (flags & G_RETHROW) {
+            JMPENV_POP;
+            croak_sv(ERRSV);
+        }
+
 	PL_stack_sp = PL_stack_base + oldmark;
 	if ((flags & G_WANT) == G_ARRAY)
 	    retval = 0;
@@ -3214,8 +3222,14 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 
     PERL_ARGS_ASSERT_EVAL_PV;
 
-    eval_sv(sv, G_SCALAR);
-    SvREFCNT_dec(sv);
+    if (croak_on_error) {
+        sv_2mortal(sv);
+        eval_sv(sv, G_SCALAR | G_RETHROW);
+    }
+    else {
+        eval_sv(sv, G_SCALAR);
+        SvREFCNT_dec(sv);
+    }
 
     {
         dSP;
@@ -3223,13 +3237,6 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
         PUTBACK;
     }
 
-    /* just check empty string or undef? */
-    if (croak_on_error) {
-	SV * const errsv = ERRSV;
-	if(SvTRUE_NN(errsv))
-            croak_sv(errsv);
-    }
-
     return sv;
 }