#!./perl # Tests for @{^COMPILE_SCOPE_CONTAINER} use strict; use warnings; use Test::More tests => 12; use XS::APItest; 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; my %destroyed; BEGIN { package CounterObject; sub new { my ($class, $name) = @_; return bless { name => $name }, $class; } sub name { my ($self) = @_; return $self->{name}; } sub DESTROY { my ($self) = @_; $destroyed{ $self->name }++; } package ReplaceCounter; $INC{'ReplaceCounter.pm'} = __FILE__; sub import { my ($self, $counter) = @_; $COMPILE_SCOPE_CONTAINER[-1] = CounterObject->new($counter); } package InstallCounter; $INC{'InstallCounter.pm'} = __FILE__; sub import { my ($class, $counter) = @_; push @COMPILE_SCOPE_CONTAINER, CounterObject->new($counter); } package TestCounter; $INC{'TestCounter.pm'} = __FILE__; sub import { my ($class, $counter, $number, $message) = @_; $number = 1 unless defined $number; $message = "counter $counter is found $number times" unless defined $message; ::is scalar(grep { $_->name eq $counter } @{COMPILE_SCOPE_CONTAINER}), $number, $message; } } { use InstallCounter 'root'; use InstallCounter '3rd-party'; { BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); } use ReplaceCounter 'replace'; BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); } use TestCounter '3rd-party', 0, '3rd-party no longer visible'; use TestCounter 'replace', 1, 'replacement now visible'; use TestCounter 'root'; BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); } } BEGIN { ok $destroyed{replace}, 'replacement has been destroyed after end of outer scope'; } use TestCounter 'root', 1, 'root visible again'; use TestCounter 'replace', 0, 'lower replacement no longer visible'; use TestCounter '3rd-party'; } ok $destroyed{ $_ }, "$_ has been destroyed after end of outer scope" for 'root', '3rd-party';