t/magic.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More tests => 18;
   5 use Devel::Size ':all';
   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
  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;
  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 }
  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 }
  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 }