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';