Server IP : 80.87.202.40 / Your IP : 216.73.216.169 Web Server : Apache System : Linux rospirotorg.ru 5.14.0-539.el9.x86_64 #1 SMP PREEMPT_DYNAMIC Thu Dec 5 22:26:13 UTC 2024 x86_64 User : bitrix ( 600) PHP Version : 8.2.27 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : OFF | Sudo : ON | Pkexec : ON Directory : /usr/share/doc/perl-namespace-clean/t/ |
Upload File : |
use warnings; use strict; use lib 't/lib'; use Test::More tests => 2019; use_ok('CleaneeTarget'); ok CleaneeTarget->can('IGNORED'), 'symbol in exception list still there'; ok CleaneeTarget->can('NOTAWAY'), 'symbol after import call still there'; ok !CleaneeTarget->can('AWAY'), 'normal symbol has disappeared'; ok !CleaneeTarget->can('x_foo'), 'explicitely removed disappeared (1/2)'; ok CleaneeTarget->can('x_bar'), 'not in explicit removal and still there'; ok !CleaneeTarget->can('x_baz'), 'explicitely removed disappeared (2/2)'; ok !CleaneeTarget->can('d_foo'), 'directly removed disappeared (1/2)'; ok CleaneeTarget->can('d_bar'), 'not in direct removal and still there'; ok !CleaneeTarget->can('d_baz'), 'directly removed disappeared (2/2)'; my @values = qw( 23 27 17 XFOO XBAR XBAZ 7 8 9 ); is(CleaneeTarget->summary->[ $_ ], $values[ $_ ], sprintf('testing sub in cleanee (%d/%d)', $_ + 1, scalar @values)) for 0 .. $#values; # some torture { local @INC = @INC; my @code; unshift @INC, sub { if ($_[1] =~ /CleaneeTarget\/No(\d+)/) { my @code = ( "package CleaneeTarget::No${1};", "sub x_foo { 'XFOO' }", "sub x_bar { 'XBAR' }", "use CleaneeBridgeExplicit;", "1;", ); return sub { return 0 unless @code; $_ = shift @code; 1; } } else { return (); } }; for (1..1000) { my $pkg = "CleaneeTarget::No${_}"; require "CleaneeTarget/No${_}.pm"; ok !$pkg->can('x_foo'), 'explicitely removed disappeared'; ok $pkg->can('x_bar'), 'not in explicit removal and still there'; } }