t/315_magic.t

   1 # Testing magical scalars (using tied scalar)
   2 # Note that XSUBs do not handle magical scalars automatically.
   3
   4 use strict;
   5 use warnings;
   6
   7 use Test::More;
   8 use Test::Fatal;
   9
  10 use Class::MOP;
  11
  12 use Tie::Scalar;
  13
  14 {
  15     package Foo;
  16     use metaclass;
  17
  18     Foo->meta->add_attribute('bar' =>
  19         reader => 'get_bar',
  20         writer => 'set_bar',
  21     );
  22
  23     Foo->meta->add_attribute('baz' =>
  24         accessor => 'baz',
  25     );
  26
  27     Foo->meta->make_immutable();
  28 }
  29
  30 {
  31     tie my $foo, 'Tie::StdScalar', Foo->new(bar => 100, baz => 200);
  32
  33     is $foo->get_bar, 100, 'reader with tied self';
  34     is $foo->baz,     200, 'accessor/r with tied self';
  35
  36     $foo->set_bar(300);
  37     $foo->baz(400);
  38
  39     is $foo->get_bar, 300, 'writer with tied self';
  40     is $foo->baz,     400, 'accessor/w with tied self';
  41 }
  42
  43 {
  44     my $foo = Foo->new();
  45
  46     tie my $value, 'Tie::StdScalar', 42;
  47
  48     $foo->set_bar($value);
  49     $foo->baz($value);
  50
  51     is $foo->get_bar, 42, 'reader/writer with tied value';
  52     is $foo->baz,     42, 'accessor with tied value';
  53 }
  54
  55 {
  56     my $x = tie my $value, 'Tie::StdScalar', 'Class::MOP';
  57
  58     is( exception { Class::MOP::load_class($value) }, undef, 'load_class(tied scalar)' );
  59
  60     $value = undef;
  61     $x->STORE('Class::MOP'); # reset
  62
  63     is( exception {
  64         ok Class::MOP::is_class_loaded($value);
  65     }, undef, 'is_class_loaded(tied scalar)' );
  66
  67     $value = undef;
  68     $x->STORE(\&Class::MOP::get_code_info); # reset
  69
  70     is( exception {
  71         is_deeply [Class::MOP::get_code_info($value)], [qw(Class::MOP get_code_info)], 'get_code_info(tied scalar)';
  72     }, undef );
  73 }
  74
  75 done_testing;