Commit | Line | Data |
---|---|---|
26ab20ee FR |
1 | use strict; |
2 | use warnings; | |
3 | use Test::More; | |
4 | ||
5 | use XS::APItest; | |
6 | ||
7 | my $sv = bless {}, 'Moo'; | |
8 | my $foo = 'affe'; | |
9 | my $bar = 'tiger'; | |
10 | ||
11 | ok !mg_find_foo($sv), 'no foo magic yet'; | |
12 | ok !mg_find_bar($sv), 'no bar magic yet'; | |
13 | ||
14 | sv_magic_foo($sv, $foo); | |
15 | is mg_find_foo($sv), $foo, 'foo magic attached'; | |
16 | ok !mg_find_bar($sv), '... but still no bar magic'; | |
17 | ||
18 | sv_magic_bar($sv, $bar); | |
19 | is mg_find_foo($sv), $foo, 'foo magic still attached'; | |
20 | is mg_find_bar($sv), $bar, '... and bar magic is there too'; | |
21 | ||
22 | sv_unmagic_foo($sv); | |
23 | ok !mg_find_foo($sv), 'foo magic removed'; | |
24 | is mg_find_bar($sv), $bar, '... but bar magic is still there'; | |
25 | ||
26 | sv_unmagic_bar($sv); | |
27 | ok !mg_find_foo($sv), 'foo magic still removed'; | |
28 | ok !mg_find_bar($sv), '... and bar magic is removed too'; | |
29 | ||
406700cc NC |
30 | is(test_get_vtbl(), 0, 'get_vtbl(-1) returns NULL'); |
31 | ||
1d5686ec FC |
32 | use Scalar::Util 'weaken'; |
33 | eval { sv_magic(\!0, $foo) }; | |
34 | is $@, "", 'PERL_MAGIC_ext is permitted on read-only things'; | |
35 | ||
80c1439f DM |
36 | # assigning to an array/hash with only set magic should call that magic |
37 | ||
38 | { | |
39 | my (@a, %h, $i); | |
40 | ||
41 | sv_magic_myset(\@a, $i); | |
42 | sv_magic_myset(\%h, $i); | |
43 | ||
44 | $i = 0; | |
45 | @a = (1,2); | |
46 | is($i, 2, "array with set magic"); | |
47 | ||
48 | $i = 0; | |
49 | @a = (); | |
50 | is($i, 0, "array () with set magic"); | |
51 | ||
52 | { | |
53 | local $TODO = "HVs don't call set magic - not sure if should"; | |
54 | ||
55 | $i = 0; | |
56 | %h = qw(a 1 b 2); | |
57 | is($i, 4, "hash with set magic"); | |
58 | } | |
59 | ||
60 | $i = 0; | |
61 | %h = qw(); | |
62 | is($i, 0, "hash () with set magic"); | |
63 | } | |
64 | ||
26ab20ee | 65 | done_testing; |