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 {
  22     package Moose::XS;
  23
  24     sub attr_to_meta_instance {
  25         my $attr = shift;
  26         return $attr->associated_class->get_meta_instance;
  27     }
  28
  29     sub meta_instance_to_attr_descs {
  30         my $mi = shift;
  31
  32         return (
  33             $mi->associated_metaclass->name,
  34             [ map { {
  35                 meta => $_,
  36                 key  => ($_->slots)[0],
  37             } } $mi->get_all_attributes ]
  38         );
  39     }
  40 }
  41
  42 ok( defined &Moose::XS::new_getter );
  43 ok( defined &Moose::XS::new_setter );
  44 ok( defined &Moose::XS::new_accessor );
  45 ok( defined &Moose::XS::new_predicate );
  46
  47 {
  48     package Foo;
  49     use Moose;
  50
  51     has x => ( is => "rw", predicate => "has_x" );
  52     has y => ( is => "ro" );
  53     has z => ( reader => "z", setter => "set_z" );
  54     has ref => ( is => "rw", weak_ref => 1 );
  55     has i => ( isa => "Int", is => "rw" );
  56     has s => ( isa => "Str", is => "rw" );
  57     has a => ( isa => "ArrayRef", is => "rw" );
  58 }
  59
  60 {
  61     my ( $x, $y, $z, $ref, $a, $s, $i ) = map { Foo->meta->get_attribute($_) } qw(x y z ref a s i);
  62     $x->Moose::XS::new_accessor("Foo::x");
  63     $x->Moose::XS::new_predicate("Foo::has_x");
  64     $y->Moose::XS::new_getter("Foo::y");
  65     $z->Moose::XS::new_getter("Foo::z");
  66     $z->Moose::XS::new_setter("Foo::set_z");
  67     $ref->Moose::XS::new_accessor("Foo::ref");
  68     $a->Moose::XS::new_accessor("Foo::a");
  69     $s->Moose::XS::new_accessor("Foo::s");
  70     $i->Moose::XS::new_accessor("Foo::i");
  71 }
  72
  73
  74 my $ref = [ ];
  75
  76 my $foo = Foo->new( x => "ICKS", y => "WHY", z => "ZEE", ref => $ref );
  77
  78 is( $foo->x, "ICKS" );
  79 is( $foo->y, "WHY" );
  80 is( $foo->z, "ZEE" );
  81 is( $foo->ref, $ref, );
  82
  83 lives_ok { $foo->x("YASE") };
  84
  85 is( $foo->x, "YASE" );
  86
  87 dies_ok { $foo->y("blah") };
  88
  89 is( $foo->y, "WHY" );
  90
  91 dies_ok { $foo->z("blah") };
  92
  93 is( $foo->z, "ZEE" );
  94
  95 lives_ok { $foo->set_z("new") };
  96
  97 is( $foo->z, "new" );
  98
  99 ok( $foo->has_x );
 100
 101 ok( !Foo->new->has_x );
 102
 103 undef $ref;
 104
 105 is( $foo->ref(), undef );
 106
 107 $ref = { };
 108
 109 $foo->ref($ref);
 110
 111 is( $foo->ref, $ref, );
 112
 113 undef $ref;
 114
 115 is( $foo->ref(), undef );
 116
 117 ok( !eval { $foo->a("not a ref"); 1 } );
 118 ok( !eval { $foo->i(1.3); 1 } );
 119 ok( !eval { $foo->s(undef); 1 } );
 120
 121 ok( eval { $foo->a([]); 1 } );
 122 ok( eval { $foo->i(3); 1 } );
 123 ok( eval { $foo->s("foo"); 1 } );
 124
 125 use Data::Dumper;
 126 warn Dumper($foo);