t/22-len.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 33;
   7
   8 use Variable::Magic qw/wizard cast VMG_COMPAT_SCALAR_LENGTH_NOLEN/;
   9
  10 my $c = 0;
  11
  12 my $n = 1 + int rand 1000;
  13 my $d;
  14 my $wiz = wizard len => sub { $d = $_[2]; ++$c; return $n };
  15 is $c, 0, 'len: wizard() doesn\'t trigger magic';
  16
  17 my @a = qw/a b c/;
  18
  19 $c = 0;
  20 cast @a, $wiz;
  21 is $c, 0, 'len: cast on array doesn\'t trigger magic';
  22
  23 $c = 0;
  24 $d = undef;
  25 my $b = scalar @a;
  26 is $c, 1,  'len: get array length triggers magic correctly';
  27 is $d, 3,  'len: get array length have correct default length';
  28 is $b, $n, 'len: get array length correctly';
  29
  30 $c = 0;
  31 $d = undef;
  32 $b = $#a;
  33 is $c, 1,      'len: get last array index triggers magic correctly';
  34 is $d, 3,      'len: get last array index have correct default length';
  35 is $b, $n - 1, 'len: get last array index correctly';
  36
  37 $n = 0;
  38
  39 $c = 0;
  40 $d = undef;
  41 $b = scalar @a;
  42 is $c, 1, 'len: get array length 0 triggers magic correctly';
  43 is $d, 3, 'len: get array length 0 have correct default length';
  44 is $b, 0, 'len: get array length 0 correctly';
  45
  46 $n = undef;
  47 @a = ();
  48 cast @a, $wiz;
  49
  50 $c = 0;
  51 $d = undef;
  52 $b = scalar @a;
  53 is $c, 1, 'len: get empty array length triggers magic correctly';
  54 is $d, 0, 'len: get empty array length have correct default length';
  55 is $b, 0, 'len: get empty array length correctly';
  56
  57 $c = 0;
  58 $d = undef;
  59 $b = $#a;
  60 is $c, 1,  'len: get last empty array index triggers magic correctly';
  61 is $d, 0,  'len: get last empty array index have correct default length';
  62 is $b, -1, 'len: get last empty array index correctly';
  63
  64 SKIP: {
  65  skip 'length() no longer calls mg_len magic' => 16 if VMG_COMPAT_SCALAR_LENGTH_NOLEN;
  66
  67  $c = 0;
  68  $n = 1 + int rand 1000;
  69  # length magic on scalars needs also get magic to be triggered.
  70  $wiz = wizard get => sub { return 'anything' },
  71                len => sub { $d = $_[2]; ++$c; return $n };
  72
  73  my $x = 6789;
  74
  75  $c = 0;
  76  cast $x, $wiz;
  77  is $c, 0, 'len: cast on scalar doesn\'t trigger magic';
  78
  79  $c = 0;
  80  $d = undef;
  81  $b = length $x;
  82  is $c, 1,  'len: get scalar length triggers magic correctly';
  83  is $d, 4,  'len: get scalar length have correct default length';
  84  is $b, $n, 'len: get scalar length correctly';
  85
  86  $n = 0;
  87
  88  $c = 0;
  89  $d = undef;
  90  $b = length $x;
  91  is $c, 1,  'len: get scalar length 0 triggers magic correctly';
  92  is $d, 4,  'len: get scalar length 0 have correct default length';
  93  is $b, $n, 'len: get scalar length 0 correctly';
  94
  95  $n = undef;
  96  $x = '';
  97  cast $x, $wiz;
  98
  99  $c = 0;
 100  $d = undef;
 101  $b = length $x;
 102  is $c, 1, 'len: get empty scalar length triggers magic correctly';
 103  is $d, 0, 'len: get empty scalar length have correct default length';
 104  is $b, 0, 'len: get empty scalar length correctly';
 105
 106  $x = "\x{20AB}ongs";
 107  cast $x, $wiz;
 108
 109  {
 110   use bytes;
 111
 112   $c = 0;
 113   $d = undef;
 114   $b = length $x;
 115   is $c, 1,  'len: get utf8 scalar length in bytes triggers magic correctly';
 116   is $d, 7,  'len: get utf8 scalar length in bytes have correct default length';
 117   is $b, $d, 'len: get utf8 scalar length in bytes correctly';
 118  }
 119
 120  $c = 0;
 121  $d = undef;
 122  $b = length $x;
 123  is $c, 1,  'len: get utf8 scalar length triggers magic correctly';
 124  is $d, 5,  'len: get utf8 scalar length have correct default length';
 125  is $b, $d, 'len: get utf8 scalar length correctly';
 126 }