X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F018_anon_class.t;h=1b0687911a75edde2f982b4a6170d020d20f3a48;hb=939ec2879f2eef695c063d980c47ecf5c6437481;hp=d8d43fedd825eba50f0d8efaa1ebc3a30d1c2682;hpb=6b96f5ab0771ffc7b3c4ddfc2e9a4e31379403af;p=gitmo%2FClass-MOP.git diff --git a/t/018_anon_class.t b/t/018_anon_class.t index d8d43fe..1b06879 100644 --- a/t/018_anon_class.t +++ b/t/018_anon_class.t @@ -1,70 +1,68 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 16; -use Test::Exception; +use Test::More; +use Test::Fatal; -BEGIN { - use_ok('Class::MOP'); -} +use Class::MOP; { package Foo; use strict; use warnings; use metaclass; - + sub bar { 'Foo::bar' } } my $anon_class_id; { - my $anon_class = Class::MOP::Class->create_anon_class(); - isa_ok($anon_class, 'Class::MOP::Class'); - - ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/); - - ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists'); - like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name'); - - is_deeply( - [$anon_class->superclasses], - [], - '... got an empty superclass list'); - lives_ok { - $anon_class->superclasses('Foo'); - } '... can add a superclass to anon class'; - is_deeply( - [$anon_class->superclasses], - [ 'Foo' ], - '... got the right superclass list'); - - ok(!$anon_class->has_method('foo'), '... no foo method'); - lives_ok { - $anon_class->add_method('foo' => sub { "__ANON__::foo" }); - } '... added a method to my anon-class'; - ok($anon_class->has_method('foo'), '... we have a foo method now'); - - my $instance = $anon_class->new_object(); - isa_ok($instance, $anon_class->name); - isa_ok($instance, 'Foo'); - - is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method'); - is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); + my $instance; + { + my $anon_class = Class::MOP::Class->create_anon_class(); + isa_ok($anon_class, 'Class::MOP::Class'); + + ($anon_class_id) = ($anon_class->name =~ /Class::MOP::Class::__ANON__::SERIAL::(\d+)/); + + ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package exists'); + like($anon_class->name, qr/Class::MOP::Class::__ANON__::SERIAL::[0-9]+/, '... got an anon class package name'); + + is_deeply( + [$anon_class->superclasses], + [], + '... got an empty superclass list'); + is( exception { + $anon_class->superclasses('Foo'); + }, undef, '... can add a superclass to anon class' ); + is_deeply( + [$anon_class->superclasses], + [ 'Foo' ], + '... got the right superclass list'); + + ok(!$anon_class->has_method('foo'), '... no foo method'); + is( exception { + $anon_class->add_method('foo' => sub { "__ANON__::foo" }); + }, undef, '... added a method to my anon-class' ); + ok($anon_class->has_method('foo'), '... we have a foo method now'); + + $instance = $anon_class->new_object(); + isa_ok($instance, $anon_class->name); + isa_ok($instance, 'Foo'); + + is($instance->foo, '__ANON__::foo', '... got the right return value of our foo method'); + is($instance->bar, 'Foo::bar', '... got the right return value of our bar method'); + } + + ok(exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package still exists'); } ok(!exists $main::Class::MOP::Class::__ANON__::SERIAL::{$anon_class_id . '::'}, '... the package no longer exists'); -# NOTE: -# I bumped this test up to 100_000 instances, and -# still got not conflicts. If your application needs -# more than that, your probably mst +# but it breaks down when we try to create another one ... -my %conflicts; -foreach my $i (1 .. 100) { - $conflicts{ Class::MOP::Class->create_anon_class()->name } = undef; -} -is(scalar(keys %conflicts), 100, '... got as many classes as I would expect'); +my $instance_2 = bless {} => ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id); +isa_ok($instance_2, ('Class::MOP::Class::__ANON__::SERIAL::' . $anon_class_id)); +ok(!$instance_2->isa('Foo'), '... but the new instance is not a Foo'); +ok(!$instance_2->can('foo'), '... and it can no longer call the foo method'); +done_testing;