use strict; use warnings; use Keyword::Simple; sub no_begin ($&){ warn "no_begin(@_) called"; } my @code; BEGIN{ my @compile_blocks = qw(BEGIN UNITCHECK CHECK INIT END); for my $block (@compile_blocks) { # bend parser Keyword::Simple::define $block, sub { my ($ref) = @_; substr($$ref, 0, 0) = "no_begin '$block', sub"; }; # test code push @code , <<__CODE__; $block { die "owened by $block" } __CODE__ } } BEGIN { die "owened by BEGIN" }; UNITCHECK { die "owened by UNITCHECK" }; CHECK { die "owened by CHECK" }; INIT { die "owened by INIT" }; END { die "owened by END" }; eval join "\n", @code;