From: Gurusamy Sarathy Date: Wed, 26 Jan 2000 19:10:26 +0000 (+0000) Subject: s/STOP/CHECK/ blocks X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7d30b5c4c60a798b772f5d7bd3b85d21016359c7;p=p5sagit%2Fp5-mst-13.2.git s/STOP/CHECK/ blocks p4raw-id: //depot/perl@4905 --- diff --git a/embedvar.h b/embedvar.h index 837c030..342f543 100644 --- a/embedvar.h +++ b/embedvar.h @@ -199,6 +199,7 @@ #define PL_bitcount (PERL_GET_INTERP->Ibitcount) #define PL_bufend (PERL_GET_INTERP->Ibufend) #define PL_bufptr (PERL_GET_INTERP->Ibufptr) +#define PL_checkav (PERL_GET_INTERP->Icheckav) #define PL_collation_ix (PERL_GET_INTERP->Icollation_ix) #define PL_collation_name (PERL_GET_INTERP->Icollation_name) #define PL_collation_standard (PERL_GET_INTERP->Icollation_standard) @@ -367,7 +368,6 @@ #define PL_statusvalue_vms (PERL_GET_INTERP->Istatusvalue_vms) #define PL_stderrgv (PERL_GET_INTERP->Istderrgv) #define PL_stdingv (PERL_GET_INTERP->Istdingv) -#define PL_stopav (PERL_GET_INTERP->Istopav) #define PL_strtab (PERL_GET_INTERP->Istrtab) #define PL_strtab_mutex (PERL_GET_INTERP->Istrtab_mutex) #define PL_sub_generation (PERL_GET_INTERP->Isub_generation) @@ -463,6 +463,7 @@ #define PL_bitcount (vTHX->Ibitcount) #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) +#define PL_checkav (vTHX->Icheckav) #define PL_collation_ix (vTHX->Icollation_ix) #define PL_collation_name (vTHX->Icollation_name) #define PL_collation_standard (vTHX->Icollation_standard) @@ -631,7 +632,6 @@ #define PL_statusvalue_vms (vTHX->Istatusvalue_vms) #define PL_stderrgv (vTHX->Istderrgv) #define PL_stdingv (vTHX->Istdingv) -#define PL_stopav (vTHX->Istopav) #define PL_strtab (vTHX->Istrtab) #define PL_strtab_mutex (vTHX->Istrtab_mutex) #define PL_sub_generation (vTHX->Isub_generation) @@ -864,6 +864,7 @@ #define PL_bitcount (aTHXo->interp.Ibitcount) #define PL_bufend (aTHXo->interp.Ibufend) #define PL_bufptr (aTHXo->interp.Ibufptr) +#define PL_checkav (aTHXo->interp.Icheckav) #define PL_collation_ix (aTHXo->interp.Icollation_ix) #define PL_collation_name (aTHXo->interp.Icollation_name) #define PL_collation_standard (aTHXo->interp.Icollation_standard) @@ -1032,7 +1033,6 @@ #define PL_statusvalue_vms (aTHXo->interp.Istatusvalue_vms) #define PL_stderrgv (aTHXo->interp.Istderrgv) #define PL_stdingv (aTHXo->interp.Istdingv) -#define PL_stopav (aTHXo->interp.Istopav) #define PL_strtab (aTHXo->interp.Istrtab) #define PL_strtab_mutex (aTHXo->interp.Istrtab_mutex) #define PL_sub_generation (aTHXo->interp.Isub_generation) @@ -1129,6 +1129,7 @@ #define PL_Ibitcount PL_bitcount #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr +#define PL_Icheckav PL_checkav #define PL_Icollation_ix PL_collation_ix #define PL_Icollation_name PL_collation_name #define PL_Icollation_standard PL_collation_standard @@ -1297,7 +1298,6 @@ #define PL_Istatusvalue_vms PL_statusvalue_vms #define PL_Istderrgv PL_stderrgv #define PL_Istdingv PL_stdingv -#define PL_Istopav PL_stopav #define PL_Istrtab PL_strtab #define PL_Istrtab_mutex PL_strtab_mutex #define PL_Isub_generation PL_sub_generation diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm index d992a89..fca3443 100644 --- a/ext/B/B/Stash.pm +++ b/ext/B/B/Stash.pm @@ -4,7 +4,7 @@ package B::Stash; BEGIN { %Seen = %INC } -STOP { +CHECK { my @arr=scan($main::{"main::"}); @arr=map{s/\:\:$//;$_;} @arr; print "-umain,-u", join (",-u",@arr) ,"\n"; diff --git a/ext/B/NOTES b/ext/B/NOTES index 8309892..89d03ba 100644 --- a/ext/B/NOTES +++ b/ext/B/NOTES @@ -161,8 +161,8 @@ O module it should return a sub ref (usually a closure) to perform the actual compilation. When O regains control, it ensures that the "-c" option is forced (so that the program being compiled doesn't - end up running) and registers a STOP block to call back the sub ref + end up running) and registers a CHECK block to call back the sub ref returned from the backend's compile(). Perl then continues by parsing prog.pl (just as it would with "perl -c prog.pl") and after - doing so, assuming there are no parse-time errors, the STOP block + doing so, assuming there are no parse-time errors, the CHECK block of O gets called and the actual backend compilation happens. Phew. diff --git a/ext/B/O.pm b/ext/B/O.pm index d07c4a5..352f8d4 100644 --- a/ext/B/O.pm +++ b/ext/B/O.pm @@ -11,7 +11,7 @@ sub import { my $compilesub = &{"B::${backend}::compile"}(@options); if (ref($compilesub) eq "CODE") { minus_c; - eval 'STOP { &$compilesub() }'; + eval 'CHECK { &$compilesub() }'; } else { die $compilesub; } @@ -59,7 +59,7 @@ C module and calls the C function in that package, passing it OPTIONS. That function is expected to return a sub reference which we'll call CALLBACK. Next, the "compile-only" flag is switched on (equivalent to the command-line option C<-c>) -and a STOP block is registered which calls CALLBACK. Thus the main +and a CHECK block is registered which calls CALLBACK. Thus the main Perl program mentioned on the command-line is read in, parsed and compiled into internal syntax tree form. Since the C<-c> flag is set, the program does not start running (excepting BEGIN blocks of diff --git a/intrpvar.h b/intrpvar.h index 606a892..f110b32 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -93,7 +93,7 @@ PERLVAR(Iglobalstash, HV *) /* global keyword overrides imported here */ PERLVAR(Icurstname, SV *) /* name of current package */ PERLVAR(Ibeginav, AV *) /* names of BEGIN subroutines */ PERLVAR(Iendav, AV *) /* names of END subroutines */ -PERLVAR(Istopav, AV *) /* names of STOP subroutines */ +PERLVAR(Icheckav, AV *) /* names of CHECK subroutines */ PERLVAR(Iinitav, AV *) /* names of INIT subroutines */ PERLVAR(Istrtab, HV *) /* shared string table */ PERLVARI(Isub_generation,U32,1) /* incr to invalidate method cache */ diff --git a/keywords.h b/keywords.h index 972240f..3343041 100644 --- a/keywords.h +++ b/keywords.h @@ -16,7 +16,7 @@ #define KEY_LE 15 #define KEY_LT 16 #define KEY_NE 17 -#define KEY_STOP 18 +#define KEY_CHECK 18 #define KEY_abs 19 #define KEY_accept 20 #define KEY_alarm 21 diff --git a/keywords.pl b/keywords.pl index acdf807..46dd53d 100755 --- a/keywords.pl +++ b/keywords.pl @@ -42,7 +42,7 @@ INIT LE LT NE -STOP +CHECK abs accept alarm diff --git a/lib/constant.pm b/lib/constant.pm index 01570ca..bbfdb78 100644 --- a/lib/constant.pm +++ b/lib/constant.pm @@ -9,7 +9,7 @@ $VERSION = '1.01'; #======================================================================= # Some names are evil choices. -my %keywords = map +($_, 1), qw{ BEGIN INIT STOP END DESTROY AUTOLOAD }; +my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; my %forced_into_main = map +($_, 1), qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; diff --git a/op.c b/op.c index 42e2994..f5938c3 100644 --- a/op.c +++ b/op.c @@ -4547,7 +4547,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) else s = name; - if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I') + if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I') goto done; if (strEQ(s, "BEGIN")) { @@ -4577,12 +4577,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) av_store(PL_endav, 0, SvREFCNT_inc(cv)); GvCV(gv) = 0; } - else if (strEQ(s, "STOP") && !PL_error_count) { - if (!PL_stopav) - PL_stopav = newAV(); + else if (strEQ(s, "CHECK") && !PL_error_count) { + if (!PL_checkav) + PL_checkav = newAV(); DEBUG_x( dump_sub(gv) ); - av_unshift(PL_stopav, 1); - av_store(PL_stopav, 0, SvREFCNT_inc(cv)); + av_unshift(PL_checkav, 1); + av_store(PL_checkav, 0, SvREFCNT_inc(cv)); GvCV(gv) = 0; } else if (strEQ(s, "INIT") && !PL_error_count) { @@ -4693,7 +4693,7 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) else s = name; - if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I') + if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I') goto done; if (strEQ(s, "BEGIN")) { @@ -4709,11 +4709,11 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) av_store(PL_endav, 0, SvREFCNT_inc(cv)); GvCV(gv) = 0; } - else if (strEQ(s, "STOP")) { - if (!PL_stopav) - PL_stopav = newAV(); - av_unshift(PL_stopav, 1); - av_store(PL_stopav, 0, SvREFCNT_inc(cv)); + else if (strEQ(s, "CHECK")) { + if (!PL_checkav) + PL_checkav = newAV(); + av_unshift(PL_checkav, 1); + av_store(PL_checkav, 0, SvREFCNT_inc(cv)); GvCV(gv) = 0; } else if (strEQ(s, "INIT")) { diff --git a/perl.c b/perl.c index 4b912e9..7f1e3f6 100644 --- a/perl.c +++ b/perl.c @@ -453,11 +453,11 @@ perl_destruct(pTHXx) /* startup and shutdown function lists */ SvREFCNT_dec(PL_beginav); SvREFCNT_dec(PL_endav); - SvREFCNT_dec(PL_stopav); + SvREFCNT_dec(PL_checkav); SvREFCNT_dec(PL_initav); PL_beginav = Nullav; PL_endav = Nullav; - PL_stopav = Nullav; + PL_checkav = Nullav; PL_initav = Nullav; /* shortcuts just get cleared */ @@ -742,8 +742,8 @@ setuid perl scripts securely.\n"); env, xsinit); switch (ret) { case 0: - if (PL_stopav) - call_list(oldscope, PL_stopav); + if (PL_checkav) + call_list(oldscope, PL_checkav); return 0; case 1: STATUS_ALL_FAILURE; @@ -754,8 +754,8 @@ setuid perl scripts securely.\n"); LEAVE; FREETMPS; PL_curstash = PL_defstash; - if (PL_stopav) - call_list(oldscope, PL_stopav); + if (PL_checkav) + call_list(oldscope, PL_checkav); return STATUS_NATIVE_EXPORT; case 3: PerlIO_printf(Perl_error_log, "panic: top_env\n"); @@ -3180,7 +3180,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) else Perl_sv_catpvf(aTHX_ atsv, "%s failed--call queue aborted", - paramList == PL_stopav ? "STOP" + paramList == PL_checkav ? "CHECK" : paramList == PL_initav ? "INIT" : "END"); while (PL_scopestack_ix > oldscope) @@ -3204,7 +3204,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) Perl_croak(aTHX_ "BEGIN failed--compilation aborted"); else Perl_croak(aTHX_ "%s failed--call queue aborted", - paramList == PL_stopav ? "STOP" + paramList == PL_checkav ? "CHECK" : paramList == PL_initav ? "INIT" : "END"); } diff --git a/perlapi.h b/perlapi.h index 769d4ca..b2b8a32 100644 --- a/perlapi.h +++ b/perlapi.h @@ -136,6 +136,8 @@ START_EXTERN_C #define PL_bufend (*Perl_Ibufend_ptr(aTHXo)) #undef PL_bufptr #define PL_bufptr (*Perl_Ibufptr_ptr(aTHXo)) +#undef PL_checkav +#define PL_checkav (*Perl_Icheckav_ptr(aTHXo)) #undef PL_collation_ix #define PL_collation_ix (*Perl_Icollation_ix_ptr(aTHXo)) #undef PL_collation_name @@ -472,8 +474,6 @@ START_EXTERN_C #define PL_stderrgv (*Perl_Istderrgv_ptr(aTHXo)) #undef PL_stdingv #define PL_stdingv (*Perl_Istdingv_ptr(aTHXo)) -#undef PL_stopav -#define PL_stopav (*Perl_Istopav_ptr(aTHXo)) #undef PL_strtab #define PL_strtab (*Perl_Istrtab_ptr(aTHXo)) #undef PL_strtab_mutex diff --git a/perly.c b/perly.c index 2e47b11..36b51c0 100644 --- a/perly.c +++ b/perly.c @@ -1826,7 +1826,7 @@ case 59: #line 338 "perly.y" { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "STOP") || strEQ(name, "INIT")) + || strEQ(name, "INIT") || strEQ(name, "CHECK")) CvSPECIAL_on(PL_compcv); yyval.opval = yyvsp[0].opval; } break; diff --git a/perly.y b/perly.y index b238276..e6ee287 100644 --- a/perly.y +++ b/perly.y @@ -337,7 +337,7 @@ startformsub: /* NULL */ /* start a format subroutine scope */ subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "STOP") || strEQ(name, "INIT")) + || strEQ(name, "INIT") || strEQ(name, "CHECK")) CvSPECIAL_on(PL_compcv); $$ = $1; } ; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index a48aa04..495e2ff 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -24,10 +24,10 @@ responsibility to ensure that warnings are enabled judiciously. =over 4 -=item STOP is a new keyword +=item CHECK is a new keyword In addition to C, C, C, C and C, -subroutines named C are now special. These are queued up during +subroutines named C are now special. These are queued up during compilation and behave similar to END blocks, except they are called at the end of compilation rather than at the end of execution. They cannot be called directly. @@ -925,7 +925,7 @@ run in compile-only mode. Since this is typically not the expected behavior, END blocks are not executed anymore when the C<-c> switch is used. -See L for how to run things when the compile phase ends. +See L for how to run things when the compile phase ends. =head2 Potential to leak DATA filehandles diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 9c5b33e..f3d7260 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1342,7 +1342,7 @@ unlikely to be what you want. =item %s failed--call queue aborted -(F) An untrapped exception was raised while executing a STOP, INIT, or +(F) An untrapped exception was raised while executing a CHECK, INIT, or END subroutine. Processing of the remainder of the queue of such routines has been prematurely ended. diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index dbefd85..905c444 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3902,7 +3902,7 @@ array by 1 and moving everything down. If there are no elements in the array, returns the undefined value. If ARRAY is omitted, shifts the C<@_> array within the lexical scope of subroutines and formats, and the C<@ARGV> array at file scopes or within the lexical scopes established by -the C, C, C, C, and C +the C, C, C, C, and C constructs. See also C, C, and C. C and C do the diff --git a/pod/perlmod.pod b/pod/perlmod.pod index 351ba73..994c3eb 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -213,7 +213,7 @@ This also has implications for the use of the SUPER:: qualifier =head2 Package Constructors and Destructors Four special subroutines act as package constructors and destructors. -These are the C, C, C, and C routines. The +These are the C, C, C, and C routines. The C is optional for these routines. A C subroutine is executed as soon as possible, that is, the moment @@ -245,9 +245,9 @@ Perl runtime begins execution, in "first in, first out" (FIFO) order. For example, the code generators documented in L make use of C blocks to initialize and resolve pointers to XSUBs. -Similar to C blocks, C blocks are run just after the +Similar to C blocks, C blocks are run just after the Perl compile phase ends and before the run time begins, in -LIFO order. C blocks are again useful in the Perl compiler +LIFO order. C blocks are again useful in the Perl compiler suite to save the compiled state of the program. When you use the B<-n> and B<-p> switches to Perl, C and diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 5eb3b82..f668d53 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -268,7 +268,7 @@ An alternate delimiter may be specified using B<-F>. =item B<-c> causes Perl to check the syntax of the program and then exit without -executing it. Actually, it I execute C, C, and +executing it. Actually, it I execute C, C, and C blocks, because these are considered as occurring outside the execution of your program. C and C blocks, however, will be skipped. diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 4ec11f9..ebb9e55 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -207,7 +207,7 @@ core, as are modules whose names are in all lower case. A function in all capitals is a loosely-held convention meaning it will be called indirectly by the run-time system itself, usually due to a triggered event. Functions that do special, pre-defined -things include C, C, C, C, C, and +things include C, C, C, C, C, and C--plus all functions mentioned in L. =head2 Private Variables via my() @@ -454,7 +454,7 @@ starts to run: } See L about the -special triggered functions, C, C, C and C. +special triggered functions, C, C, C and C. If declared at the outermost scope (the file scope), then lexicals work somewhat like C's file statics. They are available to all diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 7836acf..016d533 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -824,7 +824,7 @@ Workarounds to help Win32 dynamic loading. =head2 END blocks -END blocks need saving in compiled output, now that STOP blocks +END blocks need saving in compiled output, now that CHECK blocks are available. =head2 _AUTOLOAD diff --git a/sv.c b/sv.c index 2d075b8..7d837d2 100644 --- a/sv.c +++ b/sv.c @@ -6832,7 +6832,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_beginav = av_dup_inc(proto_perl->Ibeginav); PL_endav = av_dup_inc(proto_perl->Iendav); - PL_stopav = av_dup_inc(proto_perl->Istopav); + PL_checkav = av_dup_inc(proto_perl->Icheckav); PL_initav = av_dup_inc(proto_perl->Iinitav); PL_sub_generation = proto_perl->Isub_generation; diff --git a/t/op/misc.t b/t/op/misc.t index 9f8c7de..6ffc04c 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -357,11 +357,11 @@ BEGIN { @ARGV = qw(a b c d e) } BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" } END { print "end <",shift,">\nargv <@ARGV>\n" } INIT { print "init <",shift,">\n" } -STOP { print "stop <",shift,">\n" } +CHECK { print "check <",shift,">\n" } EXPECT argv begin -stop +check init end argv diff --git a/toke.c b/toke.c index 6f28ee1..f2f8fa5 100644 --- a/toke.c +++ b/toke.c @@ -3858,9 +3858,9 @@ Perl_yylex(pTHX) case KEY_AUTOLOAD: case KEY_DESTROY: case KEY_BEGIN: - case KEY_END: - case KEY_STOP: + case KEY_CHECK: case KEY_INIT: + case KEY_END: if (PL_expect == XSTATE) { s = PL_bufptr; goto really_sub; @@ -4921,6 +4921,7 @@ Perl_keyword(pTHX_ register char *d, I32 len) break; case 'C': if (strEQ(d,"CORE")) return -KEY_CORE; + if (strEQ(d,"CHECK")) return KEY_CHECK; break; case 'c': switch (len) { @@ -5304,9 +5305,6 @@ Perl_keyword(pTHX_ register char *d, I32 len) break; } break; - case 'S': - if (strEQ(d,"STOP")) return KEY_STOP; - break; case 's': switch (d[1]) { case 0: return KEY_s; diff --git a/vms/perly_c.vms b/vms/perly_c.vms index ebc7d57..b17faea 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1828,7 +1828,7 @@ case 59: #line 338 "perly.y" { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "STOP") || strEQ(name, "INIT")) + || strEQ(name, "INIT") || strEQ(name, "CHECK")) CvSPECIAL_on(PL_compcv); yyval.opval = yyvsp[0].opval; } break;