This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make &CORE::exit respect vmsish exit hint
authorFather Chrysostomos <sprout@cpan.org>
Sun, 3 Nov 2013 00:28:48 +0000 (17:28 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sat, 9 Nov 2013 01:55:52 +0000 (17:55 -0800)
by removing the hint from the exit op itself and just having pp_exit
look in the cop hint hash, where it is already stored (as a result of
having been in %^H at compile time).

&CORE:: subs intentionally lack a nextstate op (cop) so they can see
the hints in the caller’s nextstate op.

dump.c
embed.h
ext/B/B/Concise.pm
op.c
op.h
opcode.h
pp_ctl.c
proto.h
regen/opcodes

diff --git a/dump.c b/dump.c
index 20c0a83..409b975 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -764,10 +764,6 @@ const struct flag_to_name op_open_names[] = {
     {OPpOPEN_OUT_CRLF, ",OUT_CRLF"}
 };
 
-const struct flag_to_name op_exit_names[] = {
-    {OPpEXIT_VMSISH, ",EXIT_VMSISH"}
-};
-
 const struct flag_to_name op_sassign_names[] = {
     {OPpASSIGN_BACKWARDS, ",BACKWARDS"},
     {OPpASSIGN_CV_TO_GV,  ",CV2GV"}
@@ -810,7 +806,6 @@ const struct op_private_by_op op_private_names[] = {
     {OP_DIE, C_ARRAY_LENGTH(op_die_names), op_die_names },
     {OP_DELETE, C_ARRAY_LENGTH(op_delete_names), op_delete_names },
     {OP_EXISTS, C_ARRAY_LENGTH(op_exists_names), op_exists_names },
-    {OP_EXIT, C_ARRAY_LENGTH(op_exit_names), op_exit_names },
     {OP_FLIP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
     {OP_FLOP, C_ARRAY_LENGTH(op_flip_names), op_flip_names },
     {OP_GV, C_ARRAY_LENGTH(op_gv_names), op_gv_names },
diff --git a/embed.h b/embed.h
index 6b3f46f..9b04daf 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define ck_eval(a)             Perl_ck_eval(aTHX_ a)
 #define ck_exec(a)             Perl_ck_exec(aTHX_ a)
 #define ck_exists(a)           Perl_ck_exists(aTHX_ a)
-#define ck_exit(a)             Perl_ck_exit(aTHX_ a)
 #define ck_ftst(a)             Perl_ck_ftst(aTHX_ a)
 #define ck_fun(a)              Perl_ck_fun(aTHX_ a)
 #define ck_glob(a)             Perl_ck_glob(aTHX_ a)
index 12f37d3..5ad5a50 100644 (file)
@@ -646,7 +646,6 @@ $priv{threadsv}{64} = "SVREFd";
 @{$priv{$_}}{16,32,64,128} = qw(INBIN INCR OUTBIN OUTCR)
   for qw(open backtick);
 $priv{$_}{32} = "HUSH" for qw(nextstate dbstate);
-$priv{exit}{128} = "VMS";
 $priv{$_}{2} = "FTACCESS"
   for qw(ftrread ftrwrite ftrexec fteread ftewrite fteexec);
 @{$priv{entereval}}{2,4,8,16} = qw(HAS_HH UNI BYTES COPHH);
diff --git a/op.c b/op.c
index 47f1754..d9d1f8c 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8755,22 +8755,6 @@ Perl_ck_eval(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_exit(pTHX_ OP *o)
-{
-    PERL_ARGS_ASSERT_CK_EXIT;
-
-#ifdef VMS
-    HV * const table = GvHV(PL_hintgv);
-    if (table) {
-       SV * const * const svp = hv_fetchs(table, "vmsish_exit", FALSE);
-       if (svp && *svp && SvTRUE(*svp))
-           o->op_private |= OPpEXIT_VMSISH;
-    }
-#endif
-    return ck_fun(o);
-}
-
-OP *
 Perl_ck_exec(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_EXEC;
diff --git a/op.h b/op.h
index 6523df1..411b78a 100644 (file)
--- a/op.h
+++ b/op.h
@@ -331,9 +331,6 @@ is no conversion of op type.
                                128
  */
 
-/* Private for OP_EXIT */
-#define OPpEXIT_VMSISH         128     /* exit(0) vs. exit(1) vmsish mode*/
-
 /* Private for OP_FTXXX */
 #define OPpFT_ACCESS           2       /* use filetest 'access' */
 #define OPpFT_STACKED          4       /* stacked filetest, as "-f" in "-f -x $f" */
index ca948a9..fbc3fe1 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1533,7 +1533,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_null,           /* redo */
        Perl_ck_null,           /* dump */
        Perl_ck_null,           /* goto */
-       Perl_ck_exit,           /* exit */
+       Perl_ck_fun,            /* exit */
        Perl_ck_null,           /* method_named */
        Perl_ck_null,           /* entergiven */
        Perl_ck_null,           /* leavegiven */
index 1ef091d..f039e34 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3173,7 +3173,8 @@ PP(pp_exit)
     else {
        anum = SvIVx(POPs);
 #ifdef VMS
-        if (anum == 1 && (PL_op->op_private & OPpEXIT_VMSISH))
+       if (anum == 1
+        && SvTRUE(cop_hints_fetch_pvs(PL_curcop, "vmsish_exit", 0)))
            anum = 0;
         VMSISH_HUSHED  =
             VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH);
diff --git a/proto.h b/proto.h
index fdd6cb6..321a64f 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -457,12 +457,6 @@ PERL_CALLCONV OP * Perl_ck_exists(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_CK_EXISTS     \
        assert(o)
 
-PERL_CALLCONV OP *     Perl_ck_exit(pTHX_ OP *o)
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_CK_EXIT       \
-       assert(o)
-
 PERL_CALLCONV OP *     Perl_ck_ftst(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
index 80125e2..988b841 100644 (file)
@@ -306,7 +306,7 @@ next                next                    ck_null         ds}
 redo           redo                    ck_null         ds}     
 dump           dump                    ck_null         ds}     
 goto           goto                    ck_null         ds}     
-exit           exit                    ck_exit         ds%     S?
+exit           exit                    ck_fun          ds%     S?
 method_named   method with known name  ck_null         d$
 
 entergiven     given()                 ck_null         d|