t/700_xs/001_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8
   9 BEGIN {
  10     plan skip_all => "no XSLoader" unless eval { require XSLoader };
  11
  12     plan skip_all => $@ unless eval {
  13         require Moose;
  14         Moose->XSLoader::load($Moose::VERSION);
  15         1;
  16     };
  17
  18     plan 'no_plan';
  19 }
  20
  21 ok( defined &Moose::XS::new_getter );
  22 ok( defined &Moose::XS::new_setter );
  23 ok( defined &Moose::XS::new_accessor );
  24 ok( defined &Moose::XS::new_predicate );
  25
  26 {
  27     package Foo;
  28     use Moose;
  29
  30     has x => ( is => "rw", predicate => "has_x" );
  31     has y => ( is => "ro" );
  32     has z => ( reader => "z", setter => "set_z" );
  33     has ref => ( is => "rw", weak_ref => 1 );
  34 }
  35
  36 {
  37     my ( $x, $y, $z, $ref ) = map { Foo->meta->get_attribute($_) } qw(x y z ref);
  38     $x->Moose::XS::new_accessor("Foo::x");
  39     $x->Moose::XS::new_predicate("Foo::has_x");
  40     $y->Moose::XS::new_getter("Foo::y");
  41     $z->Moose::XS::new_getter("Foo::z");
  42     $z->Moose::XS::new_setter("Foo::set_z");
  43     $ref->Moose::XS::new_accessor("Foo::ref");
  44 }
  45
  46
  47 my $ref = [ ];
  48
  49 my $foo = Foo->new( x => "ICKS", y => "WHY", z => "ZEE", ref => $ref );
  50
  51 is( $foo->x, "ICKS" );
  52 is( $foo->y, "WHY" );
  53 is( $foo->z, "ZEE" );
  54 is( $foo->ref, $ref, );
  55
  56 lives_ok { $foo->x("YASE") };
  57
  58 is( $foo->x, "YASE" );
  59
  60 dies_ok { $foo->y("blah") };
  61
  62 is( $foo->y, "WHY" );
  63
  64 dies_ok { $foo->z("blah") };
  65
  66 is( $foo->z, "ZEE" );
  67
  68 lives_ok { $foo->set_z("new") };
  69
  70 is( $foo->z, "new" );
  71
  72 ok( $foo->has_x );
  73
  74 ok( !Foo->new->has_x );
  75
  76 undef $ref;
  77
  78 is( $foo->ref(), undef );
  79
  80 $ref = { };
  81
  82 $foo->ref($ref);
  83
  84 is( $foo->ref, $ref, );
  85
  86 undef $ref;
  87
  88 is( $foo->ref(), undef );
  89
  90 use Data::Dumper;
  91 warn Dumper($foo);