From: Dave Rolsky <autarch@urth.org>
Date: Tue, 9 Feb 2010 23:00:51 +0000 (-0600)
Subject: make class attributes work in roles
X-Git-Tag: 0.11~23
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=88b7f2c81c47c0498b82d95a4f9fc71258d689f1;p=gitmo%2FMooseX-ClassAttribute.git

make class attributes work in roles
---

diff --git a/lib/MooseX/ClassAttribute.pm b/lib/MooseX/ClassAttribute.pm
index 9d58273..219b6ff 100644
--- a/lib/MooseX/ClassAttribute.pm
+++ b/lib/MooseX/ClassAttribute.pm
@@ -9,6 +9,10 @@ our $AUTHORITY = 'cpan:DROLSKY';
 use Moose 0.89 ();
 use Moose::Exporter;
 use MooseX::ClassAttribute::Role::Meta::Class;
+use MooseX::ClassAttribute::Role::Meta::Role;
+use MooseX::ClassAttribute::Role::Meta::Application::ToClass;
+use MooseX::ClassAttribute::Role::Meta::Application::ToRole;
+use MooseX::ClassAttribute::Role::Meta::Application::ToInstance;
 
 Moose::Exporter->setup_import_methods( with_meta => ['class_has'] );
 
@@ -23,6 +27,13 @@ sub init_meta {
         },
         role_metaroles => {
             role => ['MooseX::ClassAttribute::Role::Meta::Role'],
+            application_to_class =>
+                ['MooseX::ClassAttribute::Role::Meta::Application::ToClass'],
+            application_to_role =>
+                ['MooseX::ClassAttribute::Role::Meta::Application::ToRole'],
+            application_to_instance => [
+                'MooseX::ClassAttribute::Role::Meta::Application::ToInstance'
+            ],
         },
     );
 }
diff --git a/lib/MooseX/ClassAttribute/Meta/Role/Attribute.pm b/lib/MooseX/ClassAttribute/Meta/Role/Attribute.pm
new file mode 100644
index 0000000..88e2740
--- /dev/null
+++ b/lib/MooseX/ClassAttribute/Meta/Role/Attribute.pm
@@ -0,0 +1,24 @@
+package MooseX::ClassAttribute::Meta::Role::Attribute;
+
+use strict;
+use warnings;
+
+use List::MoreUtils qw( uniq );
+
+use namespace::autoclean;
+use Moose;
+
+extends 'Moose::Meta::Role::Attribute';
+
+sub new {
+    my ( $class, $name, %options ) = @_;
+
+    $options{traits} = [
+        uniq( @{ $options{traits} || [] } ),
+        'MooseX::ClassAttribute::Role::Meta::Attribute'
+    ];
+
+    return $class->SUPER::new( $name, %options );
+}
+
+1;
diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Application.pm b/lib/MooseX/ClassAttribute/Role/Meta/Application.pm
new file mode 100644
index 0000000..33ee084
--- /dev/null
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Application.pm
@@ -0,0 +1,13 @@
+package MooseX::ClassAttribute::Role::Meta::Application;
+
+use strict;
+use warnings;
+
+use namespace::autoclean;
+use Moose::Role;
+
+after apply_attributes => sub {
+    shift->apply_class_attributes(@_);
+};
+
+1;
diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Application/ToClass.pm b/lib/MooseX/ClassAttribute/Role/Meta/Application/ToClass.pm
new file mode 100644
index 0000000..4300f0f
--- /dev/null
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Application/ToClass.pm
@@ -0,0 +1,39 @@
+package MooseX::ClassAttribute::Role::Meta::Application::ToClass;
+
+use strict;
+use warnings;
+
+use namespace::autoclean;
+use Moose::Role;
+
+with 'MooseX::ClassAttribute::Role::Meta::Application';
+
+sub apply_class_attributes {
+    my $self  = shift;
+    my $role  = shift;
+    my $class = shift;
+
+    $class = Moose::Util::MetaRole::apply_metaclass_roles(
+        for             => $class,
+        class_metaroles => {
+            class => ['MooseX::ClassAttribute::Role::Meta::Class'],
+        },
+    );
+
+    my $attr_metaclass = $class->attribute_metaclass();
+
+    foreach my $attribute_name ( $role->get_class_attribute_list() ) {
+        if (   $class->has_class_attribute($attribute_name)
+            && $class->get_class_attribute($attribute_name)
+            != $role->get_class_attribute($attribute_name) ) {
+            next;
+        }
+        else {
+            $class->add_class_attribute(
+                $role->get_class_attribute($attribute_name)
+                    ->attribute_for_class($attr_metaclass) );
+        }
+    }
+}
+
+1;
diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Application/ToInstance.pm b/lib/MooseX/ClassAttribute/Role/Meta/Application/ToInstance.pm
new file mode 100644
index 0000000..049b9f2
--- /dev/null
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Application/ToInstance.pm
@@ -0,0 +1,43 @@
+package MooseX::ClassAttribute::Role::Meta::Application::ToInstance;
+
+use strict;
+use warnings;
+
+use Class::MOP;
+
+use namespace::autoclean;
+use Moose::Role;
+
+after apply => sub {
+    shift->apply_class_attributes(@_);
+};
+
+sub apply_class_attributes {
+    my $self   = shift;
+    my $role   = shift;
+    my $object = shift;
+
+    my $class = Moose::Util::MetaRole::apply_metaclass_roles(
+        for             => ref $object,
+        class_metaroles => {
+            class => ['MooseX::ClassAttribute::Role::Meta::Class'],
+        },
+    );
+
+    my $attr_metaclass = $class->attribute_metaclass();
+
+    foreach my $attribute_name ( $role->get_class_attribute_list() ) {
+        if (   $class->has_class_attribute($attribute_name)
+            && $class->get_class_attribute($attribute_name)
+            != $role->get_class_attribute($attribute_name) ) {
+            next;
+        }
+        else {
+            $class->add_class_attribute(
+                $role->get_class_attribute($attribute_name)
+                    ->attribute_for_class($attr_metaclass) );
+        }
+    }
+}
+
+1;
diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Application/ToRole.pm b/lib/MooseX/ClassAttribute/Role/Meta/Application/ToRole.pm
new file mode 100644
index 0000000..6b6f2cb
--- /dev/null
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Application/ToRole.pm
@@ -0,0 +1,53 @@
+package MooseX::ClassAttribute::Role::Meta::Application::ToRole;
+
+use strict;
+use warnings;
+
+use Moose::Util::MetaRole;
+use MooseX::ClassAttribute::Role::Meta::Application::ToClass;
+use MooseX::ClassAttribute::Role::Meta::Application::ToInstance;
+
+use namespace::autoclean;
+use Moose::Role;
+
+with 'MooseX::ClassAttribute::Role::Meta::Application';
+
+sub apply_class_attributes {
+    my $self  = shift;
+    my $role1 = shift;
+    my $role2 = shift;
+
+    $role2 = Moose::Util::MetaRole::apply_metaclass_roles(
+        for            => $role2,
+        role_metaroles => {
+            role => ['MooseX::ClassAttribute::Role::Meta::Role'],
+            application_to_class =>
+                ['MooseX::ClassAttribute::Role::Meta::Application::ToClass'],
+            application_to_role =>
+                ['MooseX::ClassAttribute::Role::Meta::Application::ToRole'],
+            application_to_instance => [
+                'MooseX::ClassAttribute::Role::Meta::Application::ToInstance'
+            ],
+        },
+    );
+
+    foreach my $attribute_name ( $role1->get_class_attribute_list() ) {
+        if (   $role2->has_class_attribute($attribute_name)
+            && $role2->get_class_attribute($attribute_name)
+            != $role1->get_class_attribute($attribute_name) ) {
+
+            require Moose;
+            Moose->throw_error( "Role '"
+                    . $role1->name()
+                    . "' has encountered a class attribute conflict "
+                    . "during composition. This is fatal error and cannot be disambiguated."
+            );
+        }
+        else {
+            $role2->add_class_attribute(
+                $role1->get_class_attribute($attribute_name)->clone() );
+        }
+    }
+}
+
+1;
diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm b/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm
index c109454..be59f19 100644
--- a/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Attribute.pm
@@ -5,19 +5,18 @@ use warnings;
 
 use MooseX::ClassAttribute::Meta::Method::Accessor;
 
+use namespace::autoclean;
 use Moose::Role;
 
 # This is the worst role evar! Really, this should be a subclass,
 # because it overrides a lot of behavior. However, as a subclass it
 # won't cooperate with _other_ subclasses.
 
-around 'accessor_metaclass' => sub
-{
+around 'accessor_metaclass' => sub {
     return 'MooseX::ClassAttribute::Meta::Method::Accessor';
 };
 
-around '_process_options' => sub
-{
+around '_process_options' => sub {
     my $orig    = shift;
     my $class   = shift;
     my $name    = shift;
@@ -29,8 +28,7 @@ around '_process_options' => sub
     return $class->$orig( $name, $options );
 };
 
-around attach_to_class => sub
-{
+around attach_to_class => sub {
     my $orig = shift;
     my $self = shift;
     my $meta = shift;
@@ -41,8 +39,7 @@ around attach_to_class => sub
         unless $self->is_lazy();
 };
 
-around 'detach_from_class' => sub
-{
+around 'detach_from_class' => sub {
     my $orig = shift;
     my $self = shift;
     my $meta = shift;
@@ -52,38 +49,32 @@ around 'detach_from_class' => sub
     $self->$orig($meta);
 };
 
-sub _initialize
-{
+sub _initialize {
     my $self      = shift;
     my $metaclass = shift;
 
-    if ( $self->has_default() )
-    {
+    if ( $self->has_default() ) {
         $self->set_value( undef, $self->default() );
     }
-    elsif ( $self->has_builder() )
-    {
+    elsif ( $self->has_builder() ) {
         $self->set_value( undef, $self->_call_builder( $metaclass->name() ) );
     }
 }
 
-around 'default' => sub
-{
+around 'default' => sub {
     my $orig = shift;
     my $self = shift;
 
     my $default = $self->$orig();
 
-    if ( $self->is_default_a_coderef() )
-    {
+    if ( $self->is_default_a_coderef() ) {
         return $default->( $self->associated_class() );
     }
 
     return $default;
 };
 
-around '_call_builder' => sub
-{
+around '_call_builder' => sub {
     shift;
     my $self  = shift;
     my $class = shift;
@@ -100,42 +91,40 @@ around '_call_builder' => sub
             . "'" );
 };
 
-around 'set_value' => sub
-{
+around 'set_value' => sub {
     shift;
-    my $self     = shift;
-    shift; # ignoring instance or class name
-    my $value    = shift;
+    my $self = shift;
+    shift;    # ignoring instance or class name
+    my $value = shift;
 
-    $self->associated_class()->set_class_attribute_value( $self->name() => $value );
+    $self->associated_class()
+        ->set_class_attribute_value( $self->name() => $value );
 };
 
-around 'get_value' => sub
-{
+around 'get_value' => sub {
     shift;
-    my $self  = shift;
+    my $self = shift;
 
-    return $self->associated_class()->get_class_attribute_value( $self->name() );
+    return $self->associated_class()
+        ->get_class_attribute_value( $self->name() );
 };
 
-around 'has_value' => sub
-{
+around 'has_value' => sub {
     shift;
-    my $self  = shift;
+    my $self = shift;
 
-    return $self->associated_class()->has_class_attribute_value( $self->name() );
+    return $self->associated_class()
+        ->has_class_attribute_value( $self->name() );
 };
 
-around 'clear_value' => sub
-{
+around 'clear_value' => sub {
     shift;
-    my $self  = shift;
+    my $self = shift;
 
-    return $self->associated_class()->clear_class_attribute_value( $self->name() );
+    return $self->associated_class()
+        ->clear_class_attribute_value( $self->name() );
 };
 
-no Moose::Role;
-
 1;
 
 __END__
diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Mixin/HasClassAttributes.pm b/lib/MooseX/ClassAttribute/Role/Meta/Mixin/HasClassAttributes.pm
index 1b7eb49..3531f15 100644
--- a/lib/MooseX/ClassAttribute/Role/Meta/Mixin/HasClassAttributes.pm
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Mixin/HasClassAttributes.pm
@@ -9,7 +9,7 @@ use Moose::Role;
 has _class_attribute_map => (
     traits  => ['Hash'],
     is      => 'ro',
-    isa     => 'HashRef[Moose::Meta::Attribute]',
+    isa     => 'HashRef[Class::MOP::Mixin::AttributeCore]',
     handles => {
         '_add_class_attribute'     => 'set',
         'has_class_attribute'      => 'exists',
diff --git a/lib/MooseX/ClassAttribute/Role/Meta/Role.pm b/lib/MooseX/ClassAttribute/Role/Meta/Role.pm
new file mode 100644
index 0000000..3530dc6
--- /dev/null
+++ b/lib/MooseX/ClassAttribute/Role/Meta/Role.pm
@@ -0,0 +1,143 @@
+package MooseX::ClassAttribute::Role::Meta::Role;
+
+use strict;
+use warnings;
+
+use MooseX::ClassAttribute::Meta::Role::Attribute;
+use Scalar::Util qw( blessed );
+
+use namespace::autoclean;
+use Moose::Role;
+
+with 'MooseX::ClassAttribute::Role::Meta::Mixin::HasClassAttributes';
+
+around add_class_attribute => sub {
+    my $orig = shift;
+    my $self = shift;
+    my $attr = (
+        blessed $_[0] && $_[0]->isa('Class::MOP::Mixin::AttributeCore')
+        ? $_[0]
+        : MooseX::ClassAttribute::Meta::Role::Attribute->new(@_)
+    );
+
+    $self->$orig($attr);
+
+    return $attr;
+};
+
+sub _attach_class_attribute {
+    my ( $self, $attribute ) = @_;
+
+    $attribute->attach_to_role($self);
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::ClassAttribute::Role::Meta::Class - A metaclass role for classes with class attributes
+
+=head1 SYNOPSIS
+
+  for my $attr ( HasClassAttributes->meta()->get_all_class_attributes() )
+  {
+      print $attr->name();
+  }
+
+=head1 DESCRIPTION
+
+This role adds awareness of class attributes to a metaclass object. It
+provides a set of introspection methods that largely parallel the
+existing attribute methods, except they operate on class attributes.
+
+=head1 METHODS
+
+Every method provided by this role has an analogous method in
+C<Class::MOP::Class> or C<Moose::Meta::Class> for regular attributes.
+
+=head2 $meta->has_class_attribute($name)
+
+=head2 $meta->get_class_attribute($name)
+
+=head2 $meta->get_class_attribute_list()
+
+=head2 $meta->get_class_attribute_map()
+
+These methods operate on the current metaclass only.
+
+=head2 $meta->add_class_attribute(...)
+
+This accepts the same options as the L<Moose::Meta::Attribute>
+C<add_attribute()> method. However, if an attribute is specified as
+"required" an error will be thrown.
+
+=head2 $meta->remove_class_attribute($name)
+
+If the named class attribute exists, it is removed from the class,
+along with its accessor methods.
+
+=head2 $meta->get_all_class_attributes()
+
+This method returns a list of attribute objects for the class and all
+its parent classes.
+
+=head2 $meta->find_class_attribute_by_name($name)
+
+This method looks at the class and all its parent classes for the
+named class attribute.
+
+=head2 $meta->get_class_attribute_value($name)
+
+=head2 $meta->set_class_attribute_value($name, $value)
+
+=head2 $meta->set_class_attribute_value($name)
+
+=head2 $meta->clear_class_attribute_value($name)
+
+These methods operate on the storage for class attribute values, which
+is attached to the metaclass object.
+
+There's really no good reason for you to call these methods unless
+you're doing some deep hacking. They are named as public methods
+solely because they are used by other meta roles and classes in this
+distribution.
+
+=head2 inline_class_slot_access($name)
+
+=head2 inline_get_class_slot_value($name)
+
+=head2 inline_set_class_slot_value($name, $val_name)
+
+=head2 inline_is_class_slot_initialized($name)
+
+=head2 inline_deinitialize_class_slot($name)
+
+=head2 inline_weaken_class_slot_value($name)
+
+These methods return code snippets for inlining.
+
+There's really no good reason for you to call these methods unless
+you're doing some deep hacking. They are named as public methods
+solely because they are used by other meta roles and classes in this
+distribution.
+
+=head1 AUTHOR
+
+Dave Rolsky, C<< <autarch@urth.org> >>
+
+=head1 BUGS
+
+See L<MooseX::ClassAttribute> for details.
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
diff --git a/t/01-basic.t b/t/01-basic.t
index ac68764..6993861 100644
--- a/t/01-basic.t
+++ b/t/01-basic.t
@@ -4,5 +4,8 @@ use warnings;
 use lib 't/lib';
 
 use SharedTests;
+use Test::More;
 
 SharedTests::run_tests();
+
+done_testing();
diff --git a/t/02-immutable.t b/t/02-immutable.t
index 63c3739..93c69b3 100644
--- a/t/02-immutable.t
+++ b/t/02-immutable.t
@@ -4,8 +4,11 @@ use warnings;
 use lib 't/lib';
 
 use SharedTests;
+use Test::More;
 
 HasClassAttribute->meta()->make_immutable();
 Child->meta()->make_immutable();
 
 SharedTests::run_tests();
+
+done_testing();
diff --git a/t/03-introspection.t b/t/03-introspection.t
index 3c3ac02..3ea04b0 100644
--- a/t/03-introspection.t
+++ b/t/03-introspection.t
@@ -29,6 +29,7 @@ my @ca = qw( Delegatee
     Built
     LazyBuilt
     Triggerish
+    TriggerRecord
 );
 
 is_deeply(
diff --git a/t/06-role.t b/t/06-role.t
new file mode 100644
index 0000000..b6fe678
--- /dev/null
+++ b/t/06-role.t
@@ -0,0 +1,115 @@
+use strict;
+use warnings;
+
+use lib 't/lib';
+
+use SharedTests;
+use Test::More;
+
+use Moose::Util qw( apply_all_roles );
+
+{
+    package RoleHCA;
+
+    use Moose::Role;
+    use MooseX::ClassAttribute;
+
+    while ( my ( $name, $def ) = each %SharedTests::Attrs ) {
+        class_has $name => %{$def};
+    }
+}
+
+{
+    package ClassWithRoleHCA;
+
+    use Moose;
+
+    with 'RoleHCA';
+
+    has 'size' => (
+        is      => 'rw',
+        isa     => 'Int',
+        default => 5,
+    );
+
+    sub BUILD {
+        my $self = shift;
+
+        $self->ObjectCount( $self->ObjectCount() + 1 );
+    }
+
+    sub _BuildIt {42}
+
+    sub _CallTrigger {
+        push @{ $_[0]->TriggerRecord() }, [@_];
+    }
+}
+
+SharedTests::run_tests('ClassWithRoleHCA');
+
+# These next tests are aimed at testing to-role application followed by
+# to-class application
+{
+    package RoleWithRoleHCA;
+
+    use Moose::Role;
+    use MooseX::ClassAttribute;
+
+    with 'RoleHCA';
+}
+
+{
+    package ClassWithRoleWithRoleHCA;
+
+    use Moose;
+
+    with 'RoleWithRoleHCA';
+
+    has 'size' => (
+        is      => 'rw',
+        isa     => 'Int',
+        default => 5,
+    );
+
+    sub BUILD {
+        my $self = shift;
+
+        $self->ObjectCount( $self->ObjectCount() + 1 );
+    }
+
+    sub _BuildIt {42}
+
+    sub _CallTrigger {
+        push @{ $_[0]->TriggerRecord() }, [@_];
+    }
+}
+
+SharedTests::run_tests('ClassWithRoleWithRoleHCA');
+
+{
+    package InstanceWithRoleHCA;
+
+    use Moose;
+
+    has 'size' => (
+        is      => 'rw',
+        isa     => 'Int',
+        default => 5,
+    );
+
+    sub _BuildIt {42}
+
+    sub _CallTrigger {
+        push @{ $_[0]->TriggerRecord() }, [@_];
+    }
+}
+
+my $instance = InstanceWithRoleHCA->new();
+
+apply_all_roles( $instance, 'RoleHCA' );
+
+$instance->ObjectCount(1);
+
+SharedTests::run_tests($instance);
+
+done_testing();
diff --git a/t/lib/SharedTests.pm b/t/lib/SharedTests.pm
index 538e702..aa4a72c 100644
--- a/t/lib/SharedTests.pm
+++ b/t/lib/SharedTests.pm
@@ -7,7 +7,6 @@ use Scalar::Util qw( isweak );
 use Test::More;
 
 use vars qw($Lazy);
-$Lazy = 0;
 
 our %Attrs = (
     ObjectCount => {
@@ -75,6 +74,10 @@ our %Attrs = (
         is      => 'rw',
         trigger => sub { shift->_CallTrigger(@_) },
     },
+    TriggerRecord => {
+        is      => 'ro',
+        default => sub { [] },
+    },
 );
 
 {
@@ -103,10 +106,8 @@ our %Attrs = (
 
     sub _BuildIt {42}
 
-    our @Triggered;
-
     sub _CallTrigger {
-        push @Triggered, [@_];
+        push @{ $_[0]->TriggerRecord() }, [@_];
     }
 
     sub make_immutable {
@@ -154,49 +155,55 @@ our %Attrs = (
 }
 
 sub run_tests {
-    my $class = shift || 'HasClassAttribute';
+    my $thing = shift || 'HasClassAttribute';
 
     local $Test::Builder::Level = $Test::Builder::Level + 1;
 
+    $Lazy = 0;
+
+    my $count = ref $thing ? 1 : 0;
+
     {
         is(
-            $class->ObjectCount(), 0,
+            $thing->ObjectCount(), $count,
             'ObjectCount() is 0'
         );
 
-        my $hca1 = $class->new();
-        is(
-            $hca1->size(), 5,
-            'size is 5 - object attribute works as expected'
-        );
-        is(
-            $class->ObjectCount(), 1,
-            'ObjectCount() is 1'
-        );
-
-        my $hca2 = $class->new( size => 10 );
-        is(
-            $hca2->size(), 10,
-            'size is 10 - object attribute can be set via constructor'
-        );
-        is(
-            $class->ObjectCount(), 2,
-            'ObjectCount() is 2'
-        );
-        is(
-            $hca2->ObjectCount(), 2,
-            'ObjectCount() is 2 - can call class attribute accessor on object'
-        );
+        unless ( ref $thing ) {
+            my $hca1 = $thing->new();
+            is(
+                $hca1->size(), 5,
+                'size is 5 - object attribute works as expected'
+            );
+            is(
+                $thing->ObjectCount(), 1,
+                'ObjectCount() is 1'
+            );
+
+            my $hca2 = $thing->new( size => 10 );
+            is(
+                $hca2->size(), 10,
+                'size is 10 - object attribute can be set via constructor'
+            );
+            is(
+                $thing->ObjectCount(), 2,
+                'ObjectCount() is 2'
+            );
+            is(
+                $hca2->ObjectCount(), 2,
+                'ObjectCount() is 2 - can call class attribute accessor on object'
+            );
+        }
     }
 
-    {
-        my $hca3 = $class->new( ObjectCount => 20 );
+    unless ( ref $thing ) {
+        my $hca3 = $thing->new( ObjectCount => 20 );
         is(
             $hca3->ObjectCount(), 3,
             'class attributes passed to the constructor do not get set in the object'
         );
         is(
-            $class->ObjectCount(), 3,
+            $thing->ObjectCount(), 3,
             'class attributes are not affected by constructor params'
         );
     }
@@ -204,12 +211,12 @@ sub run_tests {
     {
         my $object = bless {}, 'Thing';
 
-        $class->WeakAttribute($object);
+        $thing->WeakAttribute($object);
 
         undef $object;
 
         ok(
-            !defined $class->WeakAttribute(),
+            !defined $thing->WeakAttribute(),
             'weak class attributes are weak'
         );
     }
@@ -221,8 +228,8 @@ sub run_tests {
         );
 
         is(
-            $class->LazyAttribute(), 1,
-            '$class->LazyAttribute() is 1'
+            $thing->LazyAttribute(), 1,
+            '$thing->LazyAttribute() is 1'
         );
 
         is(
@@ -232,7 +239,7 @@ sub run_tests {
     }
 
     {
-        eval { $class->ReadOnlyAttribute(20) };
+        eval { $thing->ReadOnlyAttribute(20) };
         like(
             $@, qr/\QCannot assign a value to a read-only accessor/,
             'cannot set read-only class attribute'
@@ -248,97 +255,95 @@ sub run_tests {
 
     {
         ok(
-            !$class->HasM(),
+            !$thing->HasM(),
             'HasM() returns false before M is set'
         );
 
-        $class->SetM(22);
+        $thing->SetM(22);
 
         ok(
-            $class->HasM(),
+            $thing->HasM(),
             'HasM() returns true after M is set'
         );
         is(
-            $class->M(), 22,
+            $thing->M(), 22,
             'M() returns 22'
         );
 
-        $class->ClearM();
+        $thing->ClearM();
 
         ok(
-            !$class->HasM(),
+            !$thing->HasM(),
             'HasM() returns false after M is cleared'
         );
     }
 
     {
         isa_ok(
-            $class->Delegatee(), 'Delegatee',
+            $thing->Delegatee(), 'Delegatee',
             'has a Delegetee object'
         );
         is(
-            $class->units(), 5,
+            $thing->units(), 5,
             'units() delegates to Delegatee and returns 5'
         );
     }
 
     {
-        my @ids = $class->IdsInMapping();
+        my @ids = $thing->IdsInMapping();
         is(
             scalar @ids, 0,
             'there are no keys in the mapping yet'
         );
 
         ok(
-            !$class->ExistsInMapping('a'),
+            !$thing->ExistsInMapping('a'),
             'key does not exist in mapping'
         );
 
-        $class->SetMapping( a => 20 );
+        $thing->SetMapping( a => 20 );
 
         ok(
-            $class->ExistsInMapping('a'),
+            $thing->ExistsInMapping('a'),
             'key does exist in mapping'
         );
 
         is(
-            $class->GetMapping('a'), 20,
+            $thing->GetMapping('a'), 20,
             'value for a in mapping is 20'
         );
     }
 
     {
         is(
-            $class->Built(), 42,
+            $thing->Built(), 42,
             'attribute with builder works'
         );
 
         is(
-            $class->LazyBuilt(), 42,
+            $thing->LazyBuilt(), 42,
             'attribute with lazy builder works'
         );
     }
 
     {
-        $class->Triggerish(42);
-        my $triggered = do { no strict 'refs'; \@{ $class . '::Triggered' } };
-        is( scalar @{$triggered}, 1, 'trigger was called' );
-        is( $class->Triggerish(), 42, 'Triggerish is now 42' );
+        $thing->Triggerish(42);
 
-        $class->Triggerish(84);
-        is( $class->Triggerish(), 84, 'Triggerish is now 84' );
+        is( scalar @{ $thing->TriggerRecord() }, 1, 'trigger was called' );
+        is( $thing->Triggerish(), 42, 'Triggerish is now 42' );
+
+        $thing->Triggerish(84);
+        is( $thing->Triggerish(), 84, 'Triggerish is now 84' );
 
         is_deeply(
-            $triggered,
+            $thing->TriggerRecord(),
             [
-                [ $class, qw( 42 ) ],
-                [ $class, qw( 84 42 ) ],
+                [ $thing, qw( 42 ) ],
+                [ $thing, qw( 84 42 ) ],
             ],
             'trigger passes old value correctly'
         );
     }
-
-    done_testing();
 }
 
 1;