1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use meta;
no warnings qw( meta::experimental );
my $metapkg = meta::package->get( "main" );
# scalar
{
our $SCALAR_VAR;
$metapkg->remove_symbol( '$SCALAR_VAR' );
ok( !$metapkg->try_get_symbol( '$SCALAR_VAR' ),
'$metapkg no longer has scalar symbol after remove' );
ok( !$metapkg->try_get_glob( 'SCALAR_VAR' ),
'$metapkg no longer has old glob after remove' );
like( dies { $metapkg->remove_symbol( '$SCALAR_VAR' ) },
qr/^Cannot remove non-existing symbol from package: "\$SCALAR_VAR" /,
'->remove_symbol on same name throws exception' );
}
# array
{
our @ARRAY_VAR;
$metapkg->remove_symbol( '@ARRAY_VAR' );
ok( !$metapkg->try_get_symbol( '@ARRAY_VAR' ),
'$metapkg no longer has array symbol after remove' );
ok( !$metapkg->try_get_glob( 'ARRAY_VAR' ),
'$metapkg no longer has old glob after remove' );
}
# hash
{
our %HASH_VAR;
$metapkg->remove_symbol( '%HASH_VAR' );
ok( !$metapkg->try_get_symbol( '%HASH_VAR' ),
'$metapkg no longer has hash symbol after remove' );
ok( !$metapkg->try_get_glob( 'HASH_VAR' ),
'$metapkg no longer has old glob after remove' );
}
# hash
{
sub FUNCTION { }
$metapkg->remove_symbol( '&FUNCTION' );
ok( !$metapkg->try_get_symbol( '&FUNCTION' ),
'$metapkg no longer has code symbol after remove' );
ok( !$metapkg->try_get_glob( 'FUNCTION' ),
'$metapkg no longer has old glob after remove' );
}
# can delete one slot without losing them all
{
our $SHARED;
our @SHARED;
our %SHARED;
$metapkg->remove_symbol( '@SHARED' );
ok( !$metapkg->try_get_symbol( '@SHARED' ),
'$metapkg no longer has @SHARED after remove' );
ok( $metapkg->try_get_symbol( '$SHARED' ),
'$metapkg still has $SHARED after remove array' );
ok( $metapkg->try_get_symbol( '%SHARED' ),
'$metapkg still has %SHARED after remove array' );
like( dies { $metapkg->remove_symbol( '@SHARED' ) },
qr/^Cannot remove non-existing symbol from package: "\@SHARED" /,
'->remove_symbol on same name throws exception' );
}
done_testing;
|
