remove test numbering
[gitmo/Package-Stash-XS.git] / t / edge-cases.t
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use lib 't/lib';
5 use Test::More;
6 use Test::Fatal;
7
8 use Package::Stash;
9
10 {
11     package Foo;
12     use constant FOO => 1;
13     use constant BAR => \1;
14     use constant BAZ => [];
15     use constant QUUX => {};
16     use constant QUUUX => sub { };
17     sub normal { }
18     sub stub;
19     sub normal_with_proto () { }
20     sub stub_with_proto ();
21
22     our $SCALAR;
23     our $SCALAR_WITH_VALUE = 1;
24     our @ARRAY;
25     our %HASH;
26 }
27
28 my $stash = Package::Stash->new('Foo');
29 { local $TODO = ($] < 5.010 || $Package::Stash::IMPLEMENTATION eq 'PP')
30       ? "undef scalars aren't visible on 5.8, or from pure perl at all"
31       : undef;
32 ok($stash->has_symbol('$SCALAR'), '$SCALAR');
33 }
34 ok($stash->has_symbol('$SCALAR_WITH_VALUE'), '$SCALAR_WITH_VALUE');
35 ok($stash->has_symbol('@ARRAY'), '@ARRAY');
36 ok($stash->has_symbol('%HASH'), '%HASH');
37 is_deeply(
38     [sort $stash->list_all_symbols('CODE')],
39     [qw(BAR BAZ FOO QUUUX QUUX normal normal_with_proto stub stub_with_proto)],
40     "can see all code symbols"
41 );
42
43 $stash->add_symbol('%added', {});
44 ok(!$stash->has_symbol('$added'), '$added');
45 ok(!$stash->has_symbol('@added'), '@added');
46 ok($stash->has_symbol('%added'), '%added');
47
48 my $constant = $stash->get_symbol('&FOO');
49 is(ref($constant), 'CODE', "expanded a constant into a coderef");
50
51 # ensure get doesn't prevent subsequent vivification (not sure what the deal
52 # was here)
53 is(ref($stash->get_symbol('$glob')), '', "nothing yet");
54 is(ref($stash->get_or_add_symbol('$glob')), 'SCALAR', "got an empty scalar");
55
56 my $Bar = Package::Stash->new('Bar');
57 my $foo = 3;
58 $foo =~ s/3/4/;
59 my $bar = 4.5;
60 $bar =~ s/4/5/;
61
62 is(exception { $Bar->add_symbol('$foo', \$foo) }, undef,
63    "can add PVIV values");
64 is(exception { $Bar->add_symbol('$bar', \$bar) }, undef,
65    "can add PVNV values");
66 is(exception { bless \$bar, 'Foo'; $Bar->add_symbol('$bar2', $bar) }, undef,
67    "can add PVMG values");
68 is(exception { $Bar->add_symbol('$baz', qr/foo/) }, undef,
69    "can add regex values");
70 is(exception { undef $bar; $Bar->add_symbol('$quux', \$bar) }, undef,
71    "can add undef values that aren't NULL");
72
73 use_ok('CompileTime');
74
75 {
76     package Gets::Deleted;
77     sub bar { }
78 }
79
80 {
81     my $delete = Package::Stash->new('Gets::Deleted');
82     ok($delete->has_symbol('&bar'), "sees the method");
83     {
84         no strict 'refs';
85         delete ${'main::Gets::'}{'Deleted::'};
86     }
87     ok(!$delete->has_symbol('&bar'), "method goes away when stash is deleted");
88 }
89
90 done_testing;