In perl.git, the branch sprout/vmsish has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/6523874d0ff429f7cdba5c09e662cb4321debe1a?hp=637acd959631d2a4df9a03c2f0bf0b4cb4eb1841>
- Log -----------------------------------------------------------------
commit 6523874d0ff429f7cdba5c09e662cb4321debe1a
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 7 05:56:19 2013 -0800
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.
-----------------------------------------------------------------------
Summary of changes:
embed.h | 1 -
op.c | 15 +++------------
op.h | 11 +++++++++--
opcode.h | 2 +-
proto.h | 6 ------
regen/opcodes | 2 +-
6 files changed, 14 insertions(+), 23 deletions(-)
diff --git a/embed.h b/embed.h
index e012306..5ec251e 100644
--- a/embed.h
+++ b/embed.h
@@ -1038,7 +1038,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 2d6a76d..887c981 100644
--- a/op.c
+++ b/op.c
@@ -5898,6 +5898,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;
@@ -8579,17 +8582,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;
@@ -8698,7 +8690,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 1c59ca8..af0c697 100644
--- 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 4406782..c1733dc 100644
--- 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/proto.h b/proto.h
index fef0bd4..e16e2ed 100644
--- a/proto.h
+++ b/proto.h
@@ -395,12 +395,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 b15fa20..2b96d50 100644
--- 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 @
--
Perl5 Master Repository
