Commit | Line | Data |
72e2658d |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
d1888d0b |
4 | use Test::More tests => 18; |
d3b8a135 |
5 | use Devel::Memory ':all'; |
72e2658d |
6 | require Tie::Scalar; |
7 | |
8 | { |
9 | my $string = 'Perl Rules'; |
10 | my $before_size = total_size($string); |
11 | is($string =~ /Perl/g, 1, 'It had better match'); |
12 | cmp_ok($before_size, '>', length $string, |
13 | 'Our string has a non-zero length'); |
14 | cmp_ok(total_size($string), '>', $before_size, |
15 | 'size increases due to magic'); |
16 | } |
17 | |
dc1ab564 |
18 | SKIP: { |
19 | # bug in perl added in blead by commit 815f25c6e302f84e, fixed in commit |
20 | # f5c235e79ea25787, merged to maint-5.8 as 0710cc63c26afd0c and |
21 | # 8298b2e171ce84cf respectively. |
22 | skip("This triggers a formline assertion on $]", 4) |
23 | if $] > 5.008000 && $] < 5.008003; |
72e2658d |
24 | my $string = 'Perl Rules'; |
25 | my $before_size = total_size($string); |
26 | formline $string; |
27 | my $compiled_size = total_size($string); |
28 | cmp_ok($before_size, '>', length $string, |
29 | 'Our string has a non-zero length'); |
30 | cmp_ok($compiled_size, '>', $before_size, |
31 | 'size increases due to magic (and the compiled state)'); |
32 | # Not fully sure why (didn't go grovelling) but need to use a temporary to |
33 | # avoid the magic being copied. |
34 | $string = '' . $string; |
35 | my $after_size = total_size($string); |
36 | cmp_ok($after_size, '>', $before_size, 'Still larger than initial size'); |
37 | cmp_ok($after_size, '<', $compiled_size, 'size decreases due to unmagic'); |
38 | } |
b7130948 |
39 | |
40 | { |
41 | my $string = 'Perl Rules'; |
42 | my $before_size = total_size($string); |
43 | cmp_ok($before_size, '>', length $string, |
44 | 'Our string has a non-zero length'); |
45 | tie $string, 'Tie::StdScalar'; |
46 | my $after_size = total_size($string); |
47 | cmp_ok($after_size, '>', $before_size, 'size increases due to magic'); |
48 | is($string, undef, 'No value yet'); |
49 | # This is defineately cheating, in that we're poking inside the |
50 | # implementation of Tie::StdScalar, but if we just write to $string, the way |
51 | # magic works, the (nice long) value is first written to the regular scalar, |
52 | # then picked up by the magic. So it grows, which defeats the purpose of the |
53 | # test. |
54 | ${tied $string} = 'X' x 1024; |
55 | cmp_ok(total_size($string), '>', $after_size + 1024, |
56 | 'the magic object is counted'); |
57 | } |
d1888d0b |
58 | |
59 | SKIP: { |
60 | skip("v-strings didn't use magic before 5.8.1", 2) if $] < 5.008001; |
61 | my $v = eval 'v' . (0 x 1024); |
62 | is($v, "\0", 'v-string is \0'); |
63 | cmp_ok(total_size($v), '>', 1024, 'total_size follows MG_PTR'); |
64 | } |
65 | |
66 | SKIP: { |
67 | skip("no UTF-8 caching before 5.8.1", 5) if $] < 5.008001; |
68 | my $string = "a\x{100}b"; |
69 | my $before_size = total_size($string); |
70 | cmp_ok($before_size, '>', 0, 'Our string has a non-zero length'); |
71 | is(length $string, 3, 'length is sane'); |
72 | my $with_magic = total_size($string); |
73 | cmp_ok($with_magic, '>', $before_size, 'UTF-8 caching fired and counted'); |
74 | is(index($string, "b"), 2, 'b is where we expect it'); |
75 | cmp_ok(total_size($string), '>', $with_magic, |
76 | 'UTF-8 caching length table now present'); |
77 | } |