Fix &CORE::exit/die under vmsish "hushed"

This commit makes them behave like exit and die without the ampersand
by moving the OPpHUSH_VMSISH hint from exit/die op to the current
statement (nextstate/cop) instead.  &CORE:: subs intentionally lack a
nextstate op, so they can see the hints in the caller’s nextstate op.

diff --git a/embed.h b/embed.h
index eb9b3bf..6b3f46f 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1039,7 +1039,6 @@
 #define ck_concat(a)           Perl_ck_concat(aTHX_ a)
 #define ck_defined(a)          Perl_ck_defined(aTHX_ a)
 #define ck_delete(a)           Perl_ck_delete(aTHX_ a)
-#define ck_die(a)              Perl_ck_die(aTHX_ a)
 #define ck_each(a)             Perl_ck_each(aTHX_ a)
 #define ck_eof(a)              Perl_ck_eof(aTHX_ a)
 #define ck_eval(a)             Perl_ck_eval(aTHX_ a)

diff --git a/op.c b/op.c
index 5f7e875..47f1754 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5915,6 +5915,9 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
+#ifdef VMS
+    if (VMSISH_HUSHED) cop->op_private |= OPpHUSH_VMSISH;
+#endif
     cop->op_next = (OP*)cop;
 
     cop->cop_seq = seq;
@@ -8656,17 +8659,6 @@ Perl_ck_delete(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_die(pTHX_ OP *o)
-{
-    PERL_ARGS_ASSERT_CK_DIE;
-
-#ifdef VMS
-    if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH;
-#endif
-    return ck_fun(o);
-}
-
-OP *
 Perl_ck_eof(pTHX_ OP *o)
 {
     dVAR;
@@ -8774,7 +8766,6 @@ Perl_ck_exit(pTHX_ OP *o)
        if (svp && *svp && SvTRUE(*svp))
            o->op_private |= OPpEXIT_VMSISH;
     }
-    if (VMSISH_HUSHED) o->op_private |= OPpHUSH_VMSISH;
 #endif
     return ck_fun(o);
 }

diff --git a/op.h b/op.h
index 8672e4b..6523df1 100644 (file)
--- a/op.h
+++ b/op.h
@@ -323,8 +323,15 @@ is no conversion of op type.
 #define OPpOPEN_OUT_RAW                64      /* binmode(F,":raw") on output fh */
 #define OPpOPEN_OUT_CRLF       128     /* binmode(F,":crlf") on output fh */
 
-/* Private for OP_EXIT, HUSH also for OP_DIE */
-#define OPpHUSH_VMSISH         64      /* hush DCL exit msg vmsish mode*/
+/* Private for COPs */
+#define OPpHUSH_VMSISH         32      /* hush DCL exit msg vmsish mode*/
+/* Note: Used for NATIVE_HINTS (shifted from the values in PL_hints),
+        currently defined by vms/vmsish.h:
+                               64
+                               128
+ */
+
+/* Private for OP_EXIT */
 #define OPpEXIT_VMSISH         128     /* exit(0) vs. exit(1) vmsish mode*/
 
 /* Private for OP_FTXXX */

diff --git a/opcode.h b/opcode.h
index 9a9ef1e..ca948a9 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1514,7 +1514,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_null,           /* leavesublv */
        Perl_ck_fun,            /* caller */
        Perl_ck_fun,            /* warn */
-       Perl_ck_die,            /* die */
+       Perl_ck_fun,            /* die */
        Perl_ck_fun,            /* reset */
        Perl_ck_null,           /* lineseq */
        Perl_ck_null,           /* nextstate */

diff --git a/pp_ctl.c b/pp_ctl.c
index 1653c17..1ef091d 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3175,7 +3175,8 @@ PP(pp_exit)
 #ifdef VMS
         if (anum == 1 && (PL_op->op_private & OPpEXIT_VMSISH))
            anum = 0;
-        VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+        VMSISH_HUSHED  =
+            VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH);
 #endif
     }
     PL_exit_flags |= PERL_EXIT_EXPECTED;

diff --git a/pp_sys.c b/pp_sys.c
index b5ed33f..78308f4 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -476,7 +476,8 @@ PP(pp_die)
     SV *exsv;
     STRLEN len;
 #ifdef VMS
-    VMSISH_HUSHED  = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
+    VMSISH_HUSHED  =
+       VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH);
 #endif
     if (SP - MARK != 1) {
        dTARGET;

diff --git a/proto.h b/proto.h
index 2406508..fdd6cb6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -401,12 +401,6 @@ PERL_CALLCONV OP * Perl_ck_delete(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_CK_DELETE     \
        assert(o)
 
-PERL_CALLCONV OP *     Perl_ck_die(pTHX_ OP *o)
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_CK_DIE        \
-       assert(o)
-
 PERL_CALLCONV OP *     Perl_ck_each(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);

diff --git a/regen/opcodes b/regen/opcodes
index f904b06..80125e2 100644 (file)
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -286,7 +286,7 @@ leavesub    subroutine exit         ck_null         1
 leavesublv     lvalue subroutine return        ck_null         1       
 caller         caller                  ck_fun          t%      S?
 warn           warn                    ck_fun          imst@   L
-die            die                     ck_die          dimst@  L
+die            die                     ck_fun          dimst@  L
 reset          symbol reset            ck_fun          is%     S?
 
 lineseq                line sequence           ck_null         @