Hi,
I'm looking for help regarding the documentation of the new variable
${^GLOBAL_PHASE} in the perl core.
All that variable will do is expose the current global interpreter phase
to Perl space, similar to how things like Devel::GlobalDestruction
currently expose "Am I under global destruction?"
Most of the patch, which I'll attach for your convenience, is already
vetted by p5p. What I'm looking for specifically is a place to document
it. Obviously it needs an entry in perlvar, but I don't think explaining
all the details of it there is appropriate. "BEGIN, UNITCHECK, CHECK,
INIT and END" in perlmod explains many things related to
${^GLOBAL_PHASE}, but it does so from the perspective of a single
module, i.e. one compilation unit, for which most of the behaviour of
the new variable is irrelevant, as that's only concert with global
phases. Also it'd seem somewhat unlikely that anyone would look up
"perlmod - Perl modules (packages and symbol tables)" to read about the
phases of the interpreter.
Also, once a place for documenting this is found, I'd also very much
appreciate suggestions on how to actually document it.
Here's some details of the new variable.
Possible values include:
1. CONSTRUCT
The PerlInterpreter* is being constructed via perl_construct. This
value is mostly there for completeness and for use via the
underlying C variable PL_phase. It's not really possible for Perl
code to be executed unless construction of the interpreter is
finished.
2. START
This is the global compile-time. That includes, basically, every
BEGIN block executed directly or indirectly from during the
compile-time of the top-level program.
This phase is not called "BEGIN" to avoid confusion with
BEGIN-blocks, as those are executed during compile-time of any
compilation unit, not just the top-level program. A new, localised
compile-time entered at run-time, for example by constructs as
`eval "use SomeModule"' are not global interpreter phases, and
therefore aren't reflected by ${^GLOBAL_PHASE}.
3. CHECK
Execution of any CHECK-blocks.
4. INIT
Similar to "CHECK", but for INIT-blocks, not CHECK-blocks.
5. RUN
The main run-time, i.e. the execution of PL_main_root.
6. END
Execution of any END-blocks.
7. DESTRUCT
Global destruction.
Also note that there's no value for UNITCHECK-blocks. That's because
those are run for each compilation unit individually, and therefore is
not a global interpreter phase.
Not every program has to go through each of the possible phases, but
transition from one phase to another can only happen in the order
described in the above list.
The patch also includes some basic tests, if you prefer actual working
examples of how ${^GLOBAL_PHASE} behaves.
From a973dc835b2af6f8b0acb0dfa63839c399474efe Mon Sep 17 00:00:00 2001
From: Florian Ragwitz <r...@debian.org>
Date: Tue, 28 Sep 2010 03:49:48 +0200
Subject: [PATCH 1/2] Add ${^GLOBAL_PHASE}
This exposes the current top-level interpreter phase to perl space.
---
MANIFEST | 1 +
embedvar.h | 2 ++
globvar.sym | 1 +
gv.c | 7 ++++++-
intrpvar.h | 3 +++
mg.c | 8 +++++++-
perl.c | 31 ++++++++++++++++++++++++-------
perl.h | 26 ++++++++++++++++++++++++++
sv.c | 1 +
t/op/magic_phase.t | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
10 files changed, 119 insertions(+), 9 deletions(-)
create mode 100644 t/op/magic_phase.t
diff --git a/MANIFEST b/MANIFEST
index e28bb8a..fe163de 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4662,6 +4662,7 @@ t/op/localref.t See if local ${deref} works
t/op/local.t See if local works
t/op/loopctl.t See if next/last/redo work
t/op/lop.t See if logical operators work
+t/op/magic_phase.t See if ${^GLOBAL_PHASE} works
t/op/magic.t See if magic variables work
t/op/method.t See if method calls work
t/op/mkdir.t See if mkdir works
diff --git a/embedvar.h b/embedvar.h
index 262ddb0..4a70d4c 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -232,6 +232,7 @@
#define PL_perl_destruct_level (vTHX->Iperl_destruct_level)
#define PL_perldb (vTHX->Iperldb)
#define PL_perlio (vTHX->Iperlio)
+#define PL_phase (vTHX->Iphase)
#define PL_pidstatus (vTHX->Ipidstatus)
#define PL_ppid (vTHX->Ippid)
#define PL_preambleav (vTHX->Ipreambleav)
@@ -561,6 +562,7 @@
#define PL_Iperl_destruct_level PL_perl_destruct_level
#define PL_Iperldb PL_perldb
#define PL_Iperlio PL_perlio
+#define PL_Iphase PL_phase
#define PL_Ipidstatus PL_pidstatus
#define PL_Ippid PL_ppid
#define PL_Ipreambleav PL_preambleav
diff --git a/globvar.sym b/globvar.sym
index fe1a7ee..dc91e0c 100644
--- a/globvar.sym
+++ b/globvar.sym
@@ -27,6 +27,7 @@ no_wrongref
op_desc
op_name
opargs
+phase_names
ppaddr
regkind
reg_name
diff --git a/gv.c b/gv.c
index ab43177..4e46ab2 100644
--- a/gv.c
+++ b/gv.c
@@ -1349,6 +1349,10 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
if (strEQ(name2, "NCODING"))
goto magicalize;
break;
+ case '\007': /* $^GLOBAL_PHASE */
+ if (strEQ(name2, "LOBAL_PHASE"))
+ goto ro_magicalize;
+ break;
case '\015': /* $^MATCH */
if (strEQ(name2, "ATCH"))
goto magicalize;
@@ -1358,7 +1362,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
break;
case '\020': /* $^PREMATCH $^POSTMATCH */
if (strEQ(name2, "REMATCH") || strEQ(name2, "OSTMATCH"))
- goto magicalize;
+ goto magicalize;
+ break;
case '\024': /* ${^TAINT} */
if (strEQ(name2, "AINT"))
goto ro_magicalize;
diff --git a/intrpvar.h b/intrpvar.h
index d919e1d..ee8b6dd 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -253,6 +253,9 @@ PERLVARI(Idirty, bool, FALSE) /* in the middle of tearing things
PERLVAR(Iin_eval, U8) /* trap "fatal" errors? */
PERLVAR(Itainted, bool) /* using variables controlled by $< */
+/* current phase the interpreter is in */
+PERLVARI(Iphase, enum perl_phase, PERL_PHASE_CONSTRUCT)
+
/* This value may be set when embedding for full cleanup */
/* 0=none, 1=full, 2=full with checks */
/* mod_perl is special, and also assigns a meaning -1 */
diff --git a/mg.c b/mg.c
index 4a1a72b..cb57335 100644
--- a/mg.c
+++ b/mg.c
@@ -877,6 +877,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
case '\006': /* ^F */
sv_setiv(sv, (IV)PL_maxsysfd);
break;
+ case '\007': /* ^GLOBAL_PHASE */
+ if (strEQ(remaining, "LOBAL_PHASE")) {
+ sv_setpvn(sv, PL_phase_names[PL_phase],
+ strlen(PL_phase_names[PL_phase]));
+ }
+ break;
case '\010': /* ^H */
sv_setiv(sv, (IV)PL_hints);
break;
@@ -892,7 +898,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
Perl_emulate_cop_io(aTHX_ &PL_compiling, sv);
}
break;
- case '\020':
+ case '\020':
if (nextchar == '\0') { /* ^P */
sv_setiv(sv, (IV)PL_perldb);
} else if (strEQ(remaining, "REMATCH")) { /* $^PREMATCH */
diff --git a/perl.c b/perl.c
index 157cd6b..209d345 100644
--- a/perl.c
+++ b/perl.c
@@ -557,8 +557,10 @@ perl_destruct(pTHXx)
JMPENV_PUSH(x);
PERL_UNUSED_VAR(x);
- if (PL_endav && !PL_minus_c)
+ if (PL_endav && !PL_minus_c) {
+ PL_phase = PERL_PHASE_END;
call_list(PL_scopestack_ix, PL_endav);
+ }
JMPENV_POP;
}
LEAVE;
@@ -751,6 +753,7 @@ perl_destruct(pTHXx)
* destruct_level > 0 */
SvREFCNT_dec(PL_main_cv);
PL_main_cv = NULL;
+ PL_phase = PERL_PHASE_DESTRUCT;
PL_dirty = TRUE;
/* Tell PerlIO we are about to tear things apart in case
@@ -1603,10 +1606,13 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
switch (ret) {
case 0:
parse_body(env,xsinit);
- if (PL_unitcheckav)
+ if (PL_unitcheckav) {
call_list(oldscope, PL_unitcheckav);
- if (PL_checkav)
+ }
+ if (PL_checkav) {
+ PL_phase = PERL_PHASE_CHECK;
call_list(oldscope, PL_checkav);
+ }
ret = 0;
break;
case 1:
@@ -1618,10 +1624,13 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
LEAVE;
FREETMPS;
PL_curstash = PL_defstash;
- if (PL_unitcheckav)
+ if (PL_unitcheckav) {
call_list(oldscope, PL_unitcheckav);
- if (PL_checkav)
+ }
+ if (PL_checkav) {
+ PL_phase = PERL_PHASE_CHECK;
call_list(oldscope, PL_checkav);
+ }
ret = STATUS_EXIT;
break;
case 3:
@@ -1753,6 +1762,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
SV *linestr_sv = newSV_type(SVt_PVIV);
bool add_read_e_script = FALSE;
+ PL_phase = PERL_PHASE_START;
+
SvGROW(linestr_sv, 80);
sv_setpvs(linestr_sv,"");
@@ -2243,8 +2254,10 @@ perl_run(pTHXx)
FREETMPS;
PL_curstash = PL_defstash;
if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
- PL_endav && !PL_minus_c)
+ PL_endav && !PL_minus_c) {
+ PL_phase = PERL_PHASE_END;
call_list(oldscope, PL_endav);
+ }
#ifdef MYMALLOC
if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
dump_mstats("after execution: ");
@@ -2293,8 +2306,10 @@ S_run_body(pTHX_ I32 oldscope)
}
if (PERLDB_SINGLE && PL_DBsingle)
sv_setiv(PL_DBsingle, 1);
- if (PL_initav)
+ if (PL_initav) {
+ PL_phase = PERL_PHASE_INIT;
call_list(oldscope, PL_initav);
+ }
#ifdef PERL_DEBUG_READONLY_OPS
Perl_pending_Slabs_to_ro(aTHX);
#endif
@@ -2302,6 +2317,8 @@ S_run_body(pTHX_ I32 oldscope)
/* do it */
+ PL_phase = PERL_PHASE_RUN;
+
if (PL_restartop) {
PL_restartjmpenv = NULL;
PL_op = PL_restartop;
diff --git a/perl.h b/perl.h
index be0c8ff..fc7cf07 100644
--- a/perl.h
+++ b/perl.h
@@ -4712,6 +4712,32 @@ EXTCONST char PL_bincompat_options[] =
EXTCONST char PL_bincompat_options[];
#endif
+/* The interpreter phases. If these ever change, PL_phase_names right below will
+ * need to be updated accordingly. */
+enum perl_phase {
+ PERL_PHASE_CONSTRUCT = 0,
+ PERL_PHASE_START = 1,
+ PERL_PHASE_CHECK = 2,
+ PERL_PHASE_INIT = 3,
+ PERL_PHASE_RUN = 4,
+ PERL_PHASE_END = 5,
+ PERL_PHASE_DESTRUCT = 6
+};
+
+#ifdef DOINIT
+EXTCONST char *const PL_phase_names[] = {
+ "CONSTRUCT",
+ "START",
+ "CHECK",
+ "INIT",
+ "RUN",
+ "END",
+ "DESTRUCT"
+};
+#else
+EXTCONST char *const PL_phase_names[];
+#endif
+
END_EXTERN_C
/*****************************************************************************/
diff --git a/sv.c b/sv.c
index 2d4e2ab..b4f76b0 100644
--- a/sv.c
+++ b/sv.c
@@ -13084,6 +13084,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_in_eval = proto_perl->Iin_eval;
PL_delaymagic = proto_perl->Idelaymagic;
PL_dirty = proto_perl->Idirty;
+ PL_phase = proto_perl->Iphase;
PL_localizing = proto_perl->Ilocalizing;
PL_errors = sv_dup_inc(proto_perl->Ierrors, param);
diff --git a/t/op/magic_phase.t b/t/op/magic_phase.t
new file mode 100644
index 0000000..07b4c19
--- /dev/null
+++ b/t/op/magic_phase.t
@@ -0,0 +1,48 @@
+#!./perl
+
+use strict;
+use warnings;
+
+# Test ${^GLOBAL_PHASE}
+#
+# Test::More, test.pl, etc assert plans in END, which happens before global
+# destruction, so we don't want to use those here.
+
+BEGIN { print "1..7\n" }
+
+sub ok ($$) {
+ print "not " if !$_[0];
+ print "ok";
+ print " - $_[1]" if defined $_[1];
+ print "\n";
+}
+
+BEGIN {
+ ok ${^GLOBAL_PHASE} eq 'START', 'START';
+}
+
+CHECK {
+ ok ${^GLOBAL_PHASE} eq 'CHECK', 'CHECK';
+}
+
+INIT {
+ ok ${^GLOBAL_PHASE} eq 'INIT', 'INIT';
+}
+
+ok ${^GLOBAL_PHASE} eq 'RUN', 'RUN';
+
+sub Moo::DESTROY {
+ ok ${^GLOBAL_PHASE} eq 'RUN', 'DESTROY is run-time too, usually';
+}
+
+my $tiger = bless {}, Moo::;
+
+sub Kooh::DESTROY {
+ ok ${^GLOBAL_PHASE} eq 'DESTRUCT', 'DESTRUCT';
+}
+
+our $affe = bless {}, Kooh::;
+
+END {
+ ok ${^GLOBAL_PHASE} eq 'END', 'END';
+}
--
1.7.2.3
Any suggestions will be hugely appreciated. Thanks.
pgp772VZhPZpQ.pgp
Description: PGP signature
