Change 30080 by [EMAIL PROTECTED] on 2007/01/30 23:53:56
Refactor the code used to check/execute BEGIN/UNITCHECK/CHECK/INIT/END
duplicated in newATTRSUB and newXS into a new static function
process_special_blocks()
Affected files ...
... //depot/perl/embed.fnc#460 edit
... //depot/perl/embed.h#662 edit
... //depot/perl/op.c#887 edit
... //depot/perl/proto.h#798 edit
Differences ...
==== //depot/perl/embed.fnc#460 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#459~30064~ 2007-01-29 10:28:16.000000000 -0800
+++ perl/embed.fnc 2007-01-30 15:53:56.000000000 -0800
@@ -1211,6 +1211,8 @@
|I32 enter_opcode|I32 leave_opcode \
|PADOFFSET entertarg
s |OP* |ref_array_or_hash|NULLOK OP* cond
+s |void |process_special_blocks |NN const char *const fullname\
+ |NN GV *const gv|NN CV *const cv
#endif
#if defined(PL_OP_SLAB_ALLOC)
Apa |void* |Slab_Alloc |int m|size_t sz
==== //depot/perl/embed.h#662 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#661~30032~ 2007-01-27 07:36:49.000000000 -0800
+++ perl/embed.h 2007-01-30 15:53:56.000000000 -0800
@@ -1194,6 +1194,7 @@
#define looks_like_bool S_looks_like_bool
#define newGIVWHENOP S_newGIVWHENOP
#define ref_array_or_hash S_ref_array_or_hash
+#define process_special_blocks S_process_special_blocks
#endif
#endif
#if defined(PL_OP_SLAB_ALLOC)
@@ -3400,6 +3401,7 @@
#define looks_like_bool(a) S_looks_like_bool(aTHX_ a)
#define newGIVWHENOP(a,b,c,d,e) S_newGIVWHENOP(aTHX_ a,b,c,d,e)
#define ref_array_or_hash(a) S_ref_array_or_hash(aTHX_ a)
+#define process_special_blocks(a,b,c) S_process_special_blocks(aTHX_ a,b,c)
#endif
#endif
#if defined(PL_OP_SLAB_ALLOC)
==== //depot/perl/op.c#887 (text) ====
Index: perl/op.c
--- perl/op.c#886~30072~ 2007-01-29 14:40:01.000000000 -0800
+++ perl/op.c 2007-01-30 15:53:56.000000000 -0800
@@ -5368,7 +5368,6 @@
}
if (name || aname) {
- const char *s;
const char * const tname = (name ? name : aname);
if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
@@ -5396,15 +5395,25 @@
}
}
- if ((s = strrchr(tname,':')))
- s++;
- else
- s = tname;
+ if (!PL_error_count)
+ process_special_blocks(tname, gv, cv);
+ }
+
+ done:
+ PL_copline = NOLINE;
+ LEAVE_SCOPE(floor);
+ return cv;
+}
- if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I' && *s != 'U')
- goto done;
+STATIC void
+S_process_special_blocks(pTHX_ const char *const fullname, GV *const gv,
+ CV *const cv)
+{
+ const char *const colon = strrchr(fullname,':');
+ const char *const name = colon ? colon + 1 : fullname;
- if (strEQ(s, "BEGIN") && !PL_error_count) {
+ if (*name == 'B') {
+ if (memEQ(name, "BEGIN", 5)) {
const I32 oldscope = PL_scopestack_ix;
ENTER;
SAVECOPFILE(&PL_compiling);
@@ -5419,37 +5428,45 @@
CopHINTS_set(&PL_compiling, PL_hints);
LEAVE;
}
- else if (strEQ(s, "END") && !PL_error_count) {
- DEBUG_x( dump_sub(gv) );
- Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
- else if (strEQ(s, "UNITCHECK") && !PL_error_count) {
- /* It's never too late to run a unitcheck block */
- DEBUG_x( dump_sub(gv) );
- Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
- else if (strEQ(s, "CHECK") && !PL_error_count) {
- DEBUG_x( dump_sub(gv) );
- if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK
block");
- Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
- else if (strEQ(s, "INIT") && !PL_error_count) {
- DEBUG_x( dump_sub(gv) );
- if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT
block");
- Perl_av_create_and_push(aTHX_ &PL_initav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
+ else
+ return;
+ } else {
+ if (*name == 'E') {
+ if strEQ(name, "END") {
+ DEBUG_x( dump_sub(gv) );
+ Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
+ } else
+ return;
+ } else if (*name == 'U') {
+ if (strEQ(name, "UNITCHECK")) {
+ /* It's never too late to run a unitcheck block */
+ Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, (SV*)cv);
+ }
+ else
+ return;
+ } else if (*name == 'C') {
+ if (strEQ(name, "CHECK")) {
+ if (PL_main_start && ckWARN(WARN_VOID))
+ Perl_warner(aTHX_ packWARN(WARN_VOID),
+ "Too late to run CHECK block");
+ Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
+ }
+ else
+ return;
+ } else if (*name == 'I') {
+ if (strEQ(name, "INIT")) {
+ if (PL_main_start && ckWARN(WARN_VOID))
+ Perl_warner(aTHX_ packWARN(WARN_VOID),
+ "Too late to run INIT block");
+ Perl_av_create_and_push(aTHX_ &PL_initav, (SV*)cv);
+ }
+ else
+ return;
+ } else
+ return;
+ DEBUG_x( dump_sub(gv) );
+ GvCV(gv) = 0; /* cv has been hijacked */
}
-
- done:
- PL_copline = NOLINE;
- LEAVE_SCOPE(floor);
- return cv;
}
/* XXX unsafe for threads if eval_owner isn't held */
@@ -5627,56 +5644,11 @@
CvISXSUB_on(cv);
CvXSUB(cv) = subaddr;
- if (name) {
- const char *s = strrchr(name,':');
- if (s)
- s++;
- else
- s = name;
-
- if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I' && *s != 'U')
- goto done;
-
- if (strEQ(s, "BEGIN")) {
- const I32 oldscope = PL_scopestack_ix;
- ENTER;
- SAVECOPFILE(&PL_compiling);
- SAVECOPLINE(&PL_compiling);
-
- Perl_av_create_and_push(aTHX_ &PL_beginav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- call_list(oldscope, PL_beginav);
-
- PL_curcop = &PL_compiling;
- CopHINTS_set(&PL_compiling, PL_hints);
- LEAVE;
- }
- else if (strEQ(s, "END")) {
- Perl_av_create_and_unshift_one(aTHX_ &PL_endav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
- else if (strEQ(s, "CHECK")) {
- if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run CHECK
block");
- Perl_av_create_and_unshift_one(aTHX_ &PL_checkav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
- else if (strEQ(s, "UNITCHECK")) {
- /* It's never too late to run a unitcheck block */
- Perl_av_create_and_unshift_one(aTHX_ &PL_unitcheckav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
- else if (strEQ(s, "INIT")) {
- if (PL_main_start && ckWARN(WARN_VOID))
- Perl_warner(aTHX_ packWARN(WARN_VOID), "Too late to run INIT
block");
- Perl_av_create_and_push(aTHX_ &PL_initav, (SV*)cv);
- GvCV(gv) = 0; /* cv has been hijacked */
- }
- }
+ if (name)
+ process_special_blocks(name, gv, cv);
else
CvANON_on(cv);
-done:
return cv;
}
==== //depot/perl/proto.h#798 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#797~30064~ 2007-01-29 10:28:16.000000000 -0800
+++ perl/proto.h 2007-01-30 15:53:56.000000000 -0800
@@ -3293,6 +3293,11 @@
__attribute__nonnull__(pTHX_2);
STATIC OP* S_ref_array_or_hash(pTHX_ OP* cond);
+STATIC void S_process_special_blocks(pTHX_ const char *const fullname, GV
*const gv, CV *const cv)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2)
+ __attribute__nonnull__(pTHX_3);
+
#endif
#if defined(PL_OP_SLAB_ALLOC)
PERL_CALLCONV void* Perl_Slab_Alloc(pTHX_ int m, size_t sz)
End of Patch.
