|
47
|
0 |
0 |
unless eval qq[\nuse B ();\n\nmy \$global_phase = 'START';\nif (B::main_start()->isa('B::NULL')) {\n # loaded during initial compile\n eval <<'END_EVAL' or die \$\@;\n\n CHECK { \$global_phase = 'CHECK' }\n # try to install an END block as late as possible so it will run first.\n INIT { eval q( END { \$global_phase = 'END' } ) }\n # INIT is FIFO so we can force our sub to be first\n unshift \@{ B::init_av()->object_2svref }, sub { \$global_phase = 'INIT' };\n\n 1;\n\nEND_EVAL\n}\nelse {\n # loaded during runtime\n \$global_phase = 'RUN';\n}\nEND { \$global_phase = 'END' }\n\nsub global_phase () {\n if (\$global_phase eq 'DESTRUCT') {\n # no need for extra checks at this point\n }\n elsif (\$global_phase eq 'START') {\n # we use a CHECK block to set this as well, but we can't force\n # ours to run before other CHECKS\n if (!B::main_root()->isa('B::NULL') && B::main_cv()->DEPTH == 0) {\n \$global_phase = 'CHECK';\n }\n }\n elsif (\${B::main_cv()} == 0) {\n \$global_phase = 'DESTRUCT';\n }\n elsif (\$global_phase eq 'INIT' && B::main_cv()->DEPTH > 0) {\n \$global_phase = 'RUN';\n }\n\n if (\$global_phase eq 'RUN' && \$^S) {\n # END blocks are FILO so we can't install one to run first.\n # only way to detect END reliably seems to be by using caller.\n # I hate this but it seems to be the best available option.\n # The top two frames will be an eval and the END block.\n my \$i = 0;\n \$i++ while CORE::caller(\$i + 1);\n if (\$i < 1) {\n # there should always be the sub call and an eval frame (\$^S is true).\n # this will only happen if we're in END, but the outer frames are broken.\n \$global_phase = 'END';\n }\n elsif (\$i > 1) {\n # If we're ENDing due to an exit or die in a sub generated in an eval,\n # these caller calls can cause a segfault. I can't find a way to detect\n # this.\n my \@top = CORE::caller(\$i);\n my \@next = CORE::caller(\$i - 1);\n if (\n \$top[3] eq '(eval)'\n && \$next[3] =~ /::END\$/\n && \$top[2] == \$next[2]\n && \$top[1] eq \$next[1]\n && \$top[0] eq 'main'\n && \$next[0] eq 'main'\n ) {\n \$global_phase = 'END';\n }\n }\n }\n\n return \$global_phase;\n}\n\n{\n package # hide\n Devel::GlobalPhase::_Tie;\n\n sub TIESCALAR { bless \\(my \$s), \$_[0]; }\n sub STORE { die sprintf "Modification of a read-only value attempted at %s line %s.\\n", (caller(0))[1,2]; }\n *FETCH = \\&Devel::GlobalPhase::global_phase;\n sub DESTROY {\n my \$tied = tied \${^GLOBAL_PHASE};\n if (\$tied && \$tied == \$_[0]) {\n untie \${^GLOBAL_PHASE};\n my \$phase = Devel::GlobalPhase::global_phase;\n Internals::SvREADONLY(\$phase, 1) if defined &Internals::SvREADONLY;\n *{^GLOBAL_PHASE} = \\\$phase;\n }\n }\n}\n\nsub tie_global_phase {\n unless ('Devel::GlobalPhase::_Tie' eq ref tied \${^GLOBAL_PHASE}) {\n tie \${^GLOBAL_PHASE}, 'Devel::GlobalPhase::_Tie';\n }\n 1;\n}\n\n1;\n] |