1#!./perl
2
3# Tests for @{^COMPILE_SCOPE_CONTAINER}
4
5use strict;
6use warnings;
7use Test::More tests => 12;
8use XS::APItest;
9
10BEGIN {
11    # this has to be a full glob alias, since the GvAV gets replaced
12    *COMPILE_SCOPE_CONTAINER = \*XS::APItest::COMPILE_SCOPE_CONTAINER;
13}
14our @COMPILE_SCOPE_CONTAINER;
15
16my %destroyed;
17
18BEGIN {
19    package CounterObject;
20
21    sub new {
22        my ($class, $name) = @_;
23        return bless { name => $name }, $class;
24    }
25
26    sub name {
27        my ($self) = @_;
28        return $self->{name};
29    }
30
31    sub DESTROY {
32        my ($self) = @_;
33        $destroyed{ $self->name }++;
34    }
35
36
37    package ReplaceCounter;
38    $INC{'ReplaceCounter.pm'} = __FILE__;
39
40    sub import {
41        my ($self, $counter) = @_;
42        $COMPILE_SCOPE_CONTAINER[-1] = CounterObject->new($counter);
43    }
44
45    package InstallCounter;
46    $INC{'InstallCounter.pm'} = __FILE__;
47
48    sub import {
49        my ($class, $counter) = @_;
50        push @COMPILE_SCOPE_CONTAINER, CounterObject->new($counter);
51    }
52
53    package TestCounter;
54    $INC{'TestCounter.pm'} = __FILE__;
55
56    sub import {
57        my ($class, $counter, $number, $message) = @_;
58
59        $number = 1
60            unless defined $number;
61        $message = "counter $counter is found $number times"
62            unless defined $message;
63
64        ::is scalar(grep { $_->name eq $counter } @{COMPILE_SCOPE_CONTAINER}),
65            $number,
66            $message;
67    }
68}
69
70{
71    use InstallCounter 'root';
72    use InstallCounter '3rd-party';
73
74    {
75        BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); }
76
77        use ReplaceCounter 'replace';
78
79        BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); }
80
81        use TestCounter '3rd-party', 0, '3rd-party no longer visible';
82        use TestCounter 'replace',   1, 'replacement now visible';
83        use TestCounter 'root';
84
85        BEGIN { ok(!keys %destroyed, 'nothing destroyed yet'); }
86    }
87
88    BEGIN {
89        ok $destroyed{replace}, 'replacement has been destroyed after end of outer scope';
90    }
91
92    use TestCounter 'root',     1, 'root visible again';
93    use TestCounter 'replace',  0, 'lower replacement no longer visible';
94    use TestCounter '3rd-party';
95}
96
97ok $destroyed{ $_ }, "$_ has been destroyed after end of outer scope"
98    for 'root', '3rd-party';
99