Support for Class::XSAccessor accessors

lib/Class/Tiny.pm

@@ -15,6 +15,9 @@ require( $] >= 5.010 ? "mro.pm" : "MRO/Compat.pm" ); ## no critic:
 
 my %CLASS_ATTRIBUTES;
 
+my $HAS_XS = !$ENV{PERL_CLASS_TINY_PP}
+    && eval { require Class::XSAccessor; 1 };
+
 sub import {
     my $class = shift;
     my $pkg   = caller;
@@ -82,6 +85,11 @@ sub $name {
         : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default )
     );
 }
+HERE
+    }
+    elsif ($HAS_XS) {
+        return << "HERE";
+    use Class::XSAccessor accessors => [ $name => ];
 HERE
     }
     else {

t/kilo.t

@@ -0,0 +1,85 @@
+use 5.006;
+use strict;
+use warnings;
+use lib 't/lib';
+
+use Test::More 0.96;
+use TestUtils;
+
+BEGIN { $ENV{PERL_CLASS_TINY_PP} = 1 };
+
+# Very basic tests of Class::Tiny's accessors when Class::XSAccessor is
+# explicitly disabled. The real testing will be on CPAN Testers because some
+# testers will have it installed and others will not. Nevertheless, it's
+# useful to have a canary.
+#
+
+require_ok("Kilo");
+
+subtest "attribute list" => sub {
+    is_deeply(
+        [ sort Class::Tiny->get_all_attributes_for("Kilo") ],
+        [ sort qw/foo bar baz qux kit/ ],
+        "attribute list correct",
+    );
+};
+
+subtest "empty list constructor" => sub {
+    my $obj = new_ok("Kilo");
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, undef, "bar is undef" );
+    is( $obj->baz, undef, "baz is undef" );
+    is( $obj->qux, undef, "qux is undef" );
+    is( $obj->kit, undef, "kit is undef" );
+};
+
+subtest "empty hash object constructor" => sub {
+    my $obj = new_ok( "Kilo", [ {} ] );
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, undef, "bar is undef" );
+    is( $obj->baz, undef, "baz is undef" );
+    is( $obj->qux, undef, "qux is undef" );
+    is( $obj->kit, undef, "kit is undef" );
+};
+
+subtest "subclass attribute set as list" => sub {
+    my $obj = new_ok( "Kilo", [ kit => 23 ] );
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, undef, "bar is undef" );
+    is( $obj->qux, undef, "baz is undef" );
+    is( $obj->qux, undef, "qux is undef" );
+    is( $obj->kit, 23,    "kit is set" );
+};
+
+subtest "superclass attribute set as list" => sub {
+    my $obj = new_ok( "Kilo", [ bar => 42, baz => 23, qux => 13, kit => 31 ] );
+    is( $obj->foo, undef, "foo is undef" );
+    is( $obj->bar, 42,    "bar is set" );
+    is( $obj->baz, 23,    "baz is set" );
+    is( $obj->qux, 13,    "qux is set" );
+    is( $obj->kit, 31,    "kit is set" );
+};
+
+subtest "all attributes set as list" => sub {
+    my $obj =
+      new_ok( "Kilo", [ foo => 13, bar => 42, baz => 23, qux => 11, kit => 31 ] );
+    is( $obj->foo, 13, "foo is set" );
+    is( $obj->bar, 42, "bar is set" );
+    is( $obj->baz, 23, "baz is set" );
+    is( $obj->qux, 11, "qux is set" );
+    is( $obj->kit, 31, "kit is set" );
+};
+
+subtest "attributes are RW" => sub {
+    my $obj = new_ok( "Kilo", [ { foo => 23, bar => 42 } ] );
+    is( $obj->foo(24), 24, "changing foo returns new value" );
+    is( $obj->foo,     24, "accessing foo returns changed value" );
+    is( $obj->baz(42), 42, "changing baz returns new value" );
+    is( $obj->baz,     42, "accessing baz returns changed value" );
+    is( $obj->qux(11), 11, "changing qux returns new value" );
+    is( $obj->qux,     11, "accessing qux returns changed value" );
+    is( $obj->kit(31), 31, "changing kit returns new value" );
+    is( $obj->kit,     31, "accessing kit rerutns changed value" );
+};
+
+done_testing;

t/lib/Kilo.pm

@@ -0,0 +1,8 @@
+use 5.006;
+use strict;
+use warnings;
+
+package Kilo;
+use base 'Juliett';
+
+1;