In perl.git, the branch sprout/vmsish has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/161dcfde920a52f3affadb52368146d7ba033b00?hp=5832e44d19d5f899d3d7fb1237a9faed7a7aecfc>
- Log -----------------------------------------------------------------
commit 161dcfde920a52f3affadb52368146d7ba033b00
Author: Father Chrysostomos <spr...@cpan.org>
Date: Fri Nov 8 12:51:34 2013 -0800
Try to make &CORE::exit respect vmsish exit hint
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).
-----------------------------------------------------------------------
Summary of changes:
dump.c | 1 -
embed.h | 1 -
ext/B/B/Concise.pm | 1 -
op.c | 17 -----------------
op.h | 3 ---
opcode.h | 2 +-
pp_ctl.c | 3 ++-
proto.h | 6 ------
regen/opcodes | 2 +-
9 files changed, 4 insertions(+), 32 deletions(-)
diff --git a/dump.c b/dump.c
index 78e9aa9..d1fee26 100644
--- a/dump.c
+++ b/dump.c
@@ -765,7 +765,6 @@ const struct flag_to_name op_open_names[] = {
};
const struct flag_to_name op_exit_names[] = {
- {OPpEXIT_VMSISH, ",EXIT_VMSISH"},
{OPpHUSH_VMSISH, ",HUSH_VMSISH"}
};
diff --git a/embed.h b/embed.h
index 5ec251e..4ad1ac1 100644
--- a/embed.h
+++ b/embed.h
@@ -1043,7 +1043,6 @@
#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)
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 2c5f64c..76eb85d 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -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 887c981..c8e482d 100644
--- a/op.c
+++ b/op.c
@@ -8678,23 +8678,6 @@ Perl_ck_eval(pTHX_ OP *o)
}
OP *
-Perl_ck_exit(pTHX_ OP *o)
-{
- PERL_ARGS_ASSERT_CK_EXIT;
-
-#ifdef VMS
- HV * const table =
- PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;
- 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 af0c697..ead97bc 100644
--- 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" */
diff --git a/opcode.h b/opcode.h
index c1733dc..2ffd6a1 100644
--- 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 */
diff --git a/pp_ctl.c b/pp_ctl.c
index 1ef091d..f039e34 100644
--- 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 e16e2ed..4273fe4 100644
--- a/proto.h
+++ b/proto.h
@@ -451,12 +451,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);
diff --git a/regen/opcodes b/regen/opcodes
index 2b96d50..93f069c 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -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|
--
Perl5 Master Repository
