t/22-magic.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 BEGIN {
   9  plan skip_all => 'Variable::Magic required to test magic'
  10                                       unless eval "use Variable::Magic; 1";
  11 }
  12
  13 {
  14  package Lexical::Types::Test::Str;
  15
  16  use Variable::Magic qw<wizard cast>;
  17
  18  our $wiz;
  19  BEGIN {
  20   $wiz = wizard data => sub { +{ } },
  21                 get  => sub { ++$_[1]->{get}; () },
  22                 set  => sub { ++$_[1]->{set}; () };
  23  }
  24
  25  sub TYPEDSCALAR { cast $_[1], $wiz, $_[2]; () }
  26 }
  27
  28 { package Str; }
  29
  30 BEGIN {
  31  plan tests => 2 * 8;
  32  defined and diag "Using Variable::Magic $_" for $Variable::Magic::VERSION;
  33 }
  34
  35 use Lexical::Types as => 'Lexical::Types::Test';
  36
  37 sub check (&$$;$) {
  38  my $got = Variable::Magic::getdata($_[1], $Lexical::Types::Test::Str::wiz);
  39  my ($test, $exp, $desc) = @_[0, 2, 3];
  40  my $want = wantarray;
  41  my @ret;
  42  {
  43   local @{$got}{qw<get set>};
  44   delete @{$got}{qw<get set>};
  45   if ($want) {
  46    @ret = eval { $test->() };
  47   } elsif (defined $want) {
  48    $ret[0] = eval { $test->() };
  49   } else {
  50    eval { $test->() };
  51   }
  52   local $Test::Builder::Level = $Test::Builder::Level + 1;
  53   is_deeply $got, $exp, $desc;
  54  }
  55  return $want ? @ret : $ret[0];
  56 }
  57
  58 sub zzz {
  59  my $d = Variable::Magic::getdata($_[0], $Lexical::Types::Test::Str::wiz);
  60  isnt $d,    undef,  'typed lexicals are tagged';
  61  is ref($d), 'HASH', 'typed lexicals are correctly tagged';
  62 }
  63
  64 for (1 .. 2) {
  65  my Str $x = "abc";
  66
  67  my $y = check { "$x" } $x, { get => 1 }, 'interpolate';
  68  is $y, 'abc', 'interpolate correctly';
  69
  70  check { $x .= "foo" } $x, { get => 1, set => 1 }, 'append';
  71  is $x, 'abcfoo', 'append correctly';
  72
  73  my Str $z;
  74  check { $z = "bar" . $x } $z, { set => 1 }, 'scalar assign';
  75  is $z, 'barabcfoo', 'scalar assign correctly';
  76
  77  zzz($z);
  78 }