diff options
Diffstat (limited to 'ext/XS-APItest/t/blockhooks.t')
| -rw-r--r-- | ext/XS-APItest/t/blockhooks.t | 318 |
1 files changed, 253 insertions, 65 deletions
diff --git a/ext/XS-APItest/t/blockhooks.t b/ext/XS-APItest/t/blockhooks.t index 54b3e5c837..a39c3f5274 100644 --- a/ext/XS-APItest/t/blockhooks.t +++ b/ext/XS-APItest/t/blockhooks.t @@ -1,98 +1,286 @@ -#!./perl +#!/usr/bin/perl -# Tests for @{^COMPILE_SCOPE_CONTAINER} - -use strict; use warnings; -use Test::More tests => 12; +use strict; +use Test::More tests => 17; + use XS::APItest; +use t::BHK (); # make sure it gets compiled early -BEGIN { - # this has to be a full glob alias, since the GvAV gets replaced - *COMPILE_SCOPE_CONTAINER = \*XS::APItest::COMPILE_SCOPE_CONTAINER; -} -our @COMPILE_SCOPE_CONTAINER; +BEGIN { package XS::APItest; *main::bhkav = \@XS::APItest::bhkav } -my %destroyed; +# 'use t::BHK' switches on recording hooks, and clears @bhkav. +# 'no t::BHK' switches recording off again. +# 'use t::BHK push => "foo"' pushes onto @bhkav -BEGIN { - package CounterObject; +BEGIN { diag "## COMPILE TIME ##" } +diag "## RUN TIME ##"; - sub new { - my ($class, $name) = @_; - return bless { name => $name }, $class; - } +use t::BHK; + 1; +no t::BHK; - sub name { - my ($self) = @_; - return $self->{name}; - } +BEGIN { is_deeply \@bhkav, [], "no blocks" } - sub DESTROY { - my ($self) = @_; - $destroyed{ $self->name }++; +use t::BHK; + { + 1; } +no t::BHK; +BEGIN { is_deeply \@bhkav, + [[start => 1], qw/pre_end post_end/], + "plain block"; +} + +use t::BHK; + if (1) { 1 } +no t::BHK; - package ReplaceCounter; - $INC{'ReplaceCounter.pm'} = __FILE__; +BEGIN { is_deeply \@bhkav, + [ + [start => 1], + [start => 0], + qw/pre_end post_end/, + qw/pre_end post_end/, + ], + "if block"; +} - sub import { - my ($self, $counter) = @_; - $COMPILE_SCOPE_CONTAINER[-1] = CounterObject->new($counter); +use t::BHK; + for (1) { 1 } +no t::BHK; + +BEGIN { is_deeply \@bhkav, + [ + [start => 1], + [start => 0], + qw/pre_end post_end/, + qw/pre_end post_end/, + ], + "for loop"; +} + +use t::BHK; + { + { 1; } } +no t::BHK; - package InstallCounter; - $INC{'InstallCounter.pm'} = __FILE__; +BEGIN { is_deeply \@bhkav, + [ + [start => 1], + [start => 1], + qw/pre_end post_end/, + qw/pre_end post_end/, + ], + "nested blocks"; +} - sub import { - my ($class, $counter) = @_; - push @COMPILE_SCOPE_CONTAINER, CounterObject->new($counter); +use t::BHK; + use t::BHK push => "before"; + { + use t::BHK push => "inside"; } + use t::BHK push => "after"; +no t::BHK; - package TestCounter; - $INC{'TestCounter.pm'} = __FILE__; +BEGIN { is_deeply \@bhkav, + [ + "before", + [start => 1], + "inside", + qw/pre_end post_end/, + "after" + ], + "hooks called in the correct places"; +} - sub import { - my ($class, $counter, $number, $message) = @_; +use t::BHK; + BEGIN { 1 } +no t::BHK; - $number = 1 - unless defined $number; - $message = "counter $counter is found $number times" - unless defined $message; +BEGIN { is_deeply \@bhkav, + [ + [start => 1], + qw/pre_end post_end/, + ], + "BEGIN block"; +} - ::is scalar(grep { $_->name eq $counter } @{COMPILE_SCOPE_CONTAINER}), - $number, - $message; - } +use t::BHK; t::BHK->import; + eval "1"; +no t::BHK; t::BHK->unimport; + +BEGIN { is_deeply \@bhkav, [], "string eval (compile)" } +is_deeply \@bhkav, + [ + [eval => "entereval"], + [start => 1], + qw/pre_end post_end/, + ], + "string eval (run)"; + +delete @INC{qw{t/Null.pm t/Block.pm}}; + +t::BHK->import; + do "t/Null.pm"; +t::BHK->unimport; + +is_deeply \@bhkav, + [ + [eval => "dofile"], + [start => 1], + qw/pre_end post_end/, + ], + "do file (null)"; + +t::BHK->import; + do "t/Block.pm"; +t::BHK->unimport; + +is_deeply \@bhkav, + [ + [eval => "dofile"], + [start => 1], + [start => 1], + qw/pre_end post_end/, + qw/pre_end post_end/, + ], + "do file (single block)"; + +delete @INC{qw{t/Null.pm t/Block.pm}}; + +t::BHK->import; + require t::Null; +t::BHK->unimport; + +is_deeply \@bhkav, + [ + [eval => "require"], + [start => 1], + qw/pre_end post_end/, + ], + "require (null)"; + +t::BHK->import; + require t::Block; +t::BHK->unimport; + +is_deeply \@bhkav, + [ + [eval => "require"], + [start => 1], + [start => 1], + qw/pre_end post_end/, + qw/pre_end post_end/, + ], + "require (single block)"; + +BEGIN { delete $INC{"t/Block.pm"} } + +use t::BHK; + use t::Block; +no t::BHK; + +BEGIN { is_deeply \@bhkav, + [ + [eval => "require"], + [start => 1], + [start => 1], + qw/pre_end post_end/, + qw/pre_end post_end/, + ], + "use (single block)"; } -{ - use InstallCounter 'root'; - use InstallCounter '3rd-party'; +BEGIN { delete $INC{"t/Markers.pm"} } - { - BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); } +use t::BHK; + use t::BHK push => "compile/main/before"; + use t::Markers; + use t::BHK push => "compile/main/after"; +no t::BHK; - use ReplaceCounter 'replace'; +BEGIN { is_deeply \@bhkav, + [ + "compile/main/before", + [eval => "require"], + [start => 1], + "compile/pm/before", + [start => 1], + "compile/pm/inside", + qw/pre_end post_end/, + "compile/pm/after", + qw/pre_end post_end/, + "run/pm", + "run/import", + "compile/main/after", + ], + "use with markers"; +} - BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); } +# OK, now some *really* evil stuff... - use TestCounter '3rd-party', 0, '3rd-party no longer visible'; - use TestCounter 'replace', 1, 'replacement now visible'; - use TestCounter 'root'; +BEGIN { + package EvalDestroy; - BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); } - } + sub DESTROY { $_[0]->() } +} - BEGIN { - ok $destroyed{replace}, 'replacement has been destroyed after end of outer scope'; +use t::BHK; + { + BEGIN { + # grumbleSCOPECHECKgrumble + push @XS::APItest::COMPILE_SCOPE_CONTAINER, + bless sub { + push @bhkav, "DESTROY"; + }, "EvalDestroy"; + } + 1; } +no t::BHK; - use TestCounter 'root', 1, 'root visible again'; - use TestCounter 'replace', 0, 'lower replacement no longer visible'; - use TestCounter '3rd-party'; +BEGIN { is_deeply \@bhkav, + [ + [start => 1], # block + [start => 1], # BEGIN + [start => 1], # sub + qw/pre_end post_end/, + qw/pre_end post_end/, + "pre_end", + "DESTROY", + "post_end", + ], + "compile-time DESTROY comes between pre_ and post_end"; } -ok $destroyed{ $_ }, "$_ has been destroyed after end of outer scope" - for 'root', '3rd-party'; +use t::BHK; + { + BEGIN { + push @XS::APItest::COMPILE_SCOPE_CONTAINER, + bless sub { + eval "{1}"; + }, "EvalDestroy"; + } + 1; + } +no t::BHK; + +BEGIN { is_deeply \@bhkav, + [ + [start => 1], # block + [start => 1], # BEGIN + [start => 1], # sub + qw/pre_end post_end/, + qw/pre_end post_end/, + "pre_end", + [eval => "entereval"], + [start => 1], # eval + [start => 1], # block inside eval + qw/pre_end post_end/, + qw/pre_end post_end/, + "post_end", + ], + "evil eval-in-DESTROY tricks"; +} |