t/22-magic.t

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