This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Systematic tests for the block hooks.
[perl5.git] / ext / XS-APItest / t / blockhooks-csc.t
1 #!./perl
2
3 # Tests for @{^COMPILE_SCOPE_CONTAINER}
4
5 use strict;
6 use warnings;
7 use Test::More tests => 12;
8 use XS::APItest;
9
10 BEGIN { 
11     # this has to be a full glob alias, since the GvAV gets replaced
12     *COMPILE_SCOPE_CONTAINER = \*XS::APItest::COMPILE_SCOPE_CONTAINER;
13 }
14 our @COMPILE_SCOPE_CONTAINER;
15
16 my %destroyed;
17
18 BEGIN {
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
97 ok $destroyed{ $_ }, "$_ has been destroyed after end of outer scope"
98     for 'root', '3rd-party';