[Moose-commits] r7645 - in MooseX-GlobRef-Object/trunk: .
lib/MooseX/GlobRef t/tlib/MooseX/GlobRef t/tlib/MooseX/GlobRef/Meta
dexter at code2.0beta.co.uk
dexter at code2.0beta.co.uk
Thu Feb 12 22:15:46 GMT 2009
Author: dexter
Date: 2009-02-12 14:15:46 -0800 (Thu, 12 Feb 2009)
New Revision: 7645
Added:
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm
Modified:
MooseX-GlobRef-Object/trunk/Build.PL
MooseX-GlobRef-Object/trunk/Changes
MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm
Log:
* Tests are refactored and build requires Test::Unit::Lite >= 0.12.
Modified: MooseX-GlobRef-Object/trunk/Build.PL
===================================================================
--- MooseX-GlobRef-Object/trunk/Build.PL 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/Build.PL 2009-02-12 22:15:46 UTC (rev 7645)
@@ -22,7 +22,7 @@
optional => {
},
build_requires => {
- 'Test::Unit::Lite' => 0.11,
+ 'Test::Unit::Lite' => 0.12,
'Test::Assert' => 0,
},
create_makefile_pl => 'traditional',
Modified: MooseX-GlobRef-Object/trunk/Changes
===================================================================
--- MooseX-GlobRef-Object/trunk/Changes 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/Changes 2009-02-12 22:15:46 UTC (rev 7645)
@@ -6,6 +6,7 @@
* Now works "use metaclass 'MooseX::GlobRef::Meta::Class'".
* Use simpler "*$self->{attr}" syntax for accessing attributes stored in hash
slot of glob reference.
+* Tests are refactored and build requires Test::Unit::Lite >= 0.12.
------------------------------------------------------------------------
0.05 | Piotr Roszatycki <dexter at debian.org> | 2009-01-31
Modified: MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/lib/MooseX/GlobRef/Object.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -65,9 +65,7 @@
our $VERSION = '0.06';
-use metaclass 'MooseX::GlobRef::Meta::Class' => (
-# instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
-);
+use metaclass 'MooseX::GlobRef::Meta::Class';
=head1 INHERITANCE
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassImmutableTest.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -1,42 +1,28 @@
package MooseX::GlobRef::Meta::ClassImmutableTest;
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestCase';
+use parent 'MooseX::GlobRef::ObjectBaseTest';
-use Test::Assert ':all';
+use constant test_class => (__PACKAGE__ . '::TestClass');
-use Scalar::Util 'reftype';
-
-
{
- package MooseX::GlobRef::Meta::ClassImmutableTest::Test1;
+ package MooseX::GlobRef::Meta::ClassImmutableTest::TestClass;
use metaclass 'MooseX::GlobRef::Meta::Class';
use Moose;
- has field => ( is => 'rw' );
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
+ has weak_field => (
+ is => 'rw',
+ );
+
__PACKAGE__->meta->make_immutable;
};
-
-sub test___isa {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::ClassImmutableTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::ClassImmutableTest::Test1'));
- assert_equals('GLOB', reftype($obj));
-};
-
-sub test_accessor {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::ClassImmutableTest::Test1->new(field => $$);
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::ClassImmutableTest::Test1'));
- assert_equals($$, $obj->field);
- assert_equals(1, $obj->field(1));
- assert_equals(1, $obj->field);
-};
-
1;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTest.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -1,40 +1,26 @@
package MooseX::GlobRef::Meta::ClassTest;
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestCase';
+use parent 'MooseX::GlobRef::ObjectBaseTest';
-use Test::Assert ':all';
+use constant test_class => (__PACKAGE__ . '::TestClass');
-use Scalar::Util 'reftype';
-
-
{
- package MooseX::GlobRef::Meta::ClassTest::Test1;
+ package MooseX::GlobRef::Meta::ClassTest::TestClass;
use metaclass 'MooseX::GlobRef::Meta::Class';
use Moose;
- has field => ( is => 'rw' );
-};
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
-
-sub test___isa {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::ClassTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::ClassTest::Test1'));
- assert_equals('GLOB', reftype($obj));
+ has weak_field => (
+ is => 'rw',
+ );
};
-sub test_accessor {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::ClassTest::Test1->new(field => $$);
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::ClassTest::Test1'));
- assert_equals($$, $obj->field);
- assert_equals(1, $obj->field(1));
- assert_equals(1, $obj->field);
-};
-
1;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/ClassTestSuite.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -2,12 +2,22 @@
use Test::Unit::Lite;
use parent 'Test::Unit::TestSuite';
-
+
sub suite {
my $class = shift;
- my $suite = Test::Unit::TestSuite->empty_new('Metaclass');
- $suite->add_test('MooseX::GlobRef::Meta::ClassTest');
- $suite->add_test('MooseX::GlobRef::Meta::ClassImmutableTest');
+
+ my $suite_name = __PACKAGE__;
+ $suite_name =~ s/.*://;
+
+ my $simple_test_name = __PACKAGE__;
+ $simple_test_name =~ s/Suite$//;
+
+ my $immutable_test_name = __PACKAGE__;
+ $immutable_test_name =~ s/TestSuite$/ImmutableTest/;
+
+ my $suite = Test::Unit::TestSuite->empty_new($suite_name);
+ $suite->add_test($simple_test_name);
+ $suite->add_test($immutable_test_name);
return $suite;
};
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceImmutableTest.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -1,15 +1,11 @@
package MooseX::GlobRef::Meta::InstanceImmutableTest;
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestCase';
+use parent 'MooseX::GlobRef::ObjectBaseTest';
-use Test::Assert ':all';
+use constant test_class => (__PACKAGE__ . '::TestClass');
-use Scalar::Util 'reftype';
-
-
{
- package MooseX::GlobRef::Meta::InstanceImmutableTest::Test1;
+ package MooseX::GlobRef::Meta::InstanceImmutableTest::TestClass;
use metaclass 'Moose::Meta::Class' => (
instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
@@ -17,28 +13,30 @@
use Moose;
- has field => ( is => 'rw' );
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
- __PACKAGE__->meta->make_immutable;
-};
+ has weak_field => (
+ is => 'rw',
+ );
+ sub BUILD {
+ my $self = shift;
-sub test___isa {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::InstanceImmutableTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::InstanceImmutableTest::Test1'));
- assert_equals('GLOB', reftype($obj));
-};
+ # fill some other slots in globref
+ my $scalarref = ${*$self};
+ $$scalarref = 'SCALAR';
+ my $arrayref = \@{*$self};
+ @$arrayref = ('ARRAY');
-sub test_accessor {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::InstanceImmutableTest::Test1->new(field => $$);
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::InstanceImmutableTest::Test1'));
- assert_equals($$, $obj->field);
- assert_equals(1, $obj->field(1));
- assert_equals(1, $obj->field);
+ return $self;
+ };
+
+ __PACKAGE__->meta->make_immutable;
};
1;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTest.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -1,15 +1,11 @@
package MooseX::GlobRef::Meta::InstanceTest;
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestCase';
+use parent 'MooseX::GlobRef::ObjectBaseTest';
-use Test::Assert ':all';
+use constant test_class => (__PACKAGE__ . '::TestClass');
-use Scalar::Util 'reftype';
-
-
{
- package MooseX::GlobRef::Meta::InstanceTest::Test1;
+ package MooseX::GlobRef::Meta::InstanceTest::TestClass;
use metaclass 'Moose::Meta::Class' => (
instance_metaclass => 'MooseX::GlobRef::Meta::Instance'
@@ -17,26 +13,28 @@
use Moose;
- has field => ( is => 'rw' );
-};
+ has field => (
+ is => 'rw',
+ clearer => 'clear_field',
+ default => 'default',
+ lazy => 1,
+ );
+ has weak_field => (
+ is => 'rw',
+ );
-sub test___isa {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::InstanceTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::InstanceTest::Test1'));
- assert_equals('GLOB', reftype($obj));
-};
+ sub BUILD {
+ my $self = shift;
-sub test_accessor {
- my $self = shift;
- my $obj = MooseX::GlobRef::Meta::InstanceTest::Test1->new(field => $$);
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::Meta::InstanceTest::Test1'));
- assert_equals($$, $obj->field);
- assert_equals(1, $obj->field(1));
- assert_equals(1, $obj->field);
+ # fill some other slots in globref
+ my $scalarref = ${*$self};
+ $$scalarref = 'SCALAR';
+ my $arrayref = \@{*$self};
+ @$arrayref = ('ARRAY');
+
+ return $self;
+ };
};
1;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/Meta/InstanceTestSuite.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -2,12 +2,22 @@
use Test::Unit::Lite;
use parent 'Test::Unit::TestSuite';
-
+
sub suite {
my $class = shift;
- my $suite = Test::Unit::TestSuite->empty_new('MetaclassInstance');
- $suite->add_test('MooseX::GlobRef::Meta::InstanceTest');
- $suite->add_test('MooseX::GlobRef::Meta::InstanceImmutableTest');
+
+ my $suite_name = __PACKAGE__;
+ $suite_name =~ s/.*://;
+
+ my $simple_test_name = __PACKAGE__;
+ $simple_test_name =~ s/Suite$//;
+
+ my $immutable_test_name = __PACKAGE__;
+ $immutable_test_name =~ s/TestSuite$/ImmutableTest/;
+
+ my $suite = Test::Unit::TestSuite->empty_new($suite_name);
+ $suite->add_test($simple_test_name);
+ $suite->add_test($immutable_test_name);
return $suite;
};
Added: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm (rev 0)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectBaseTest.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -0,0 +1,110 @@
+package MooseX::GlobRef::ObjectBaseTest;
+
+use Test::Unit::Lite;
+use parent 'Test::Unit::TestCase';
+
+use Test::Assert ':all';
+
+use Scalar::Util 'reftype';
+
+sub test_class {
+ fail('test_class is not overriden');
+};
+
+sub test___isa {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $obj = $test_class->new;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_equals('GLOB', reftype($obj));
+};
+
+sub test_accessor {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $obj = $test_class->new;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_equals('default', $obj->field);
+ assert_equals(1, $obj->field(1));
+ assert_equals(1, $obj->field);
+ assert_true($obj->clear_field);
+ assert_equals('default', $obj->field);
+};
+
+sub test_slot_moc {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $mi = $test_class->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $obj = $mi->create_instance;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_null($mi->get_slot_value($obj, 'field'));
+ assert_true(! $mi->is_slot_initialized($obj, 'field'));
+ assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
+ assert_equals(1, $mi->get_slot_value($obj, 'field'));
+ assert_true($mi->is_slot_initialized($obj, 'field'));
+ assert_true($mi->deinitialize_slot($obj, 'field'));
+ assert_null($mi->get_slot_value($obj, 'field'));
+ assert_true(! $mi->is_slot_initialized($obj, 'field'));
+};
+
+sub test_slot_moc_inline {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $mi = $test_class->meta->get_meta_instance;
+ assert_not_null($mi);
+
+ my $code_create_instance = $mi->inline_create_instance('$test_class');
+ assert_not_equals('', $code_create_instance);
+ my $code_get_slot_value = $mi->inline_get_slot_value('$obj', 'field');
+ assert_not_equals('', $code_get_slot_value);
+ my $code_is_slot_initialized = $mi->inline_is_slot_initialized('$obj', 'field');
+ assert_not_equals('', $code_is_slot_initialized);
+ my $code_set_slot_value = $mi->inline_set_slot_value('$obj', 'field', '$value');
+ assert_not_equals('', $code_set_slot_value);
+ my $code_deinitialize_slot = $mi->inline_deinitialize_slot('$obj', 'field');
+ assert_not_equals('', $code_deinitialize_slot);
+
+ my $obj = eval $code_create_instance;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_null(eval $code_get_slot_value);
+ assert_true(! eval $code_is_slot_initialized);
+ my $value = 42;
+ assert_equals($value, eval $code_set_slot_value);
+ assert_equals($value, eval $code_get_slot_value);
+ assert_true(eval $code_is_slot_initialized);
+ assert_true(eval $code_deinitialize_slot);
+ assert_null(eval $code_get_slot_value);
+ assert_true(! eval $code_is_slot_initialized);
+};
+
+sub test_weak_field {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $mi = $test_class->meta->get_meta_instance;
+ assert_not_null($mi);
+ my $obj = $test_class->new;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ assert_null($obj->weak_field);
+ {
+ my $scalar = 'SCALAR';
+ assert_not_null($obj->weak_field(\$scalar));
+ assert_not_null($obj->weak_field);
+ assert_equals('SCALAR', ${$obj->weak_field});
+ $mi->weaken_slot_value($obj, 'weak_field');
+ };
+ assert_null($obj->weak_field);
+};
+
+1;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -1,15 +1,11 @@
package MooseX::GlobRef::ObjectImmutableTest;
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestCase';
+use parent 'MooseX::GlobRef::ObjectBaseTest';
-use Test::Assert ':all';
+use constant test_class => (__PACKAGE__ . '::TestClass');
-use Scalar::Util 'reftype';
-
-
{
- package MooseX::GlobRef::ObjectImmutableTest::Test1;
+ package MooseX::GlobRef::ObjectImmutableTest::TestClass;
use Moose;
@@ -21,108 +17,24 @@
default => 'default',
lazy => 1,
);
-
+
has weak_field => (
is => 'rw',
);
- sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
+ sub BUILD {
+ my $self = shift;
+
+ # fill some other slots in globref
my $scalarref = ${*$self};
$$scalarref = 'SCALAR';
- my $arrayref = \@{*$self};
- @$arrayref = ('ARRAY');
+ my $arrayref = \@{*$self};
+ @$arrayref = ('ARRAY');
+
return $self;
- };
+ };
__PACKAGE__->meta->make_immutable;
};
-
-sub test___isa {
- my $self = shift;
- my $obj = MooseX::GlobRef::ObjectImmutableTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableTest::Test1'));
- assert_equals('GLOB', reftype($obj));
-};
-
-sub test_accessor {
- my $self = shift;
- my $obj = MooseX::GlobRef::ObjectImmutableTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableTest::Test1'));
- assert_equals('default', $obj->field);
- assert_equals(1, $obj->field(1));
- assert_equals(1, $obj->field);
- assert_true($obj->clear_field);
- assert_equals('default', $obj->field);
-};
-
-sub test_slot_moc {
- my $self = shift;
- my $mi = MooseX::GlobRef::ObjectImmutableTest::Test1->meta->get_meta_instance;
- assert_not_null($mi);
-
- my $obj = $mi->create_instance;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableTest::Test1'));
- assert_null($mi->get_slot_value($obj, 'field'));
- assert_true(! $mi->is_slot_initialized($obj, 'field'));
- assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
- assert_equals(1, $mi->get_slot_value($obj, 'field'));
- assert_true($mi->is_slot_initialized($obj, 'field'));
- assert_true($mi->deinitialize_slot($obj, 'field'));
- assert_null($mi->get_slot_value($obj, 'field'));
- assert_true(! $mi->is_slot_initialized($obj, 'field'));
-};
-
-sub test_slot_moc_inline {
- my $self = shift;
- my $mi = MooseX::GlobRef::ObjectImmutableTest::Test1->meta->get_meta_instance;
- assert_not_null($mi);
-
- my $code_create_instance = $mi->inline_create_instance('$class');
- assert_not_equals('', $code_create_instance);
- my $code_get_slot_value = $mi->inline_get_slot_value('$obj', 'field');
- assert_not_equals('', $code_get_slot_value);
- my $code_is_slot_initialized = $mi->inline_is_slot_initialized('$obj', 'field');
- assert_not_equals('', $code_is_slot_initialized);
- my $code_set_slot_value = $mi->inline_set_slot_value('$obj', 'field', '$value');
- assert_not_equals('', $code_set_slot_value);
- my $code_deinitialize_slot = $mi->inline_deinitialize_slot('$obj', 'field');
- assert_not_equals('', $code_deinitialize_slot);
-
- my $obj = eval "my \$class = 'MooseX::GlobRef::ObjectImmutableTest::Test1'; $code_create_instance;";
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableTest::Test1'));
- assert_null(eval $code_get_slot_value);
- assert_true(! eval $code_is_slot_initialized);
- assert_equals(1, eval "my \$value = 1; $code_set_slot_value;");
- assert_equals(1, eval $code_get_slot_value);
- assert_true(eval $code_is_slot_initialized);
- assert_true(eval $code_deinitialize_slot);
- assert_null(eval $code_get_slot_value);
- assert_true(! eval $code_is_slot_initialized);
-};
-
-sub test_weak_field {
- my $self = shift;
- my $mi = MooseX::GlobRef::ObjectImmutableTest::Test1->meta->get_meta_instance;
- assert_not_null($mi);
- my $obj = MooseX::GlobRef::ObjectImmutableTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectImmutableTest::Test1'));
- assert_null($obj->weak_field);
- {
- my $scalar = 'SCALAR';
- assert_not_null($obj->weak_field(\$scalar));
- assert_not_null($obj->weak_field);
- assert_equals('SCALAR', ${$obj->weak_field});
- $mi->weaken_slot_value($obj, 'weak_field');
- };
- assert_null($obj->weak_field);
-};
-
1;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -1,15 +1,11 @@
package MooseX::GlobRef::ObjectTest;
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestCase';
+use parent 'MooseX::GlobRef::ObjectBaseTest';
-use Test::Assert ':all';
+use constant test_class => (__PACKAGE__ . '::TestClass');
-use Scalar::Util 'reftype';
-
-
{
- package MooseX::GlobRef::ObjectTest::Test1;
+ package MooseX::GlobRef::ObjectTest::TestClass;
use Moose;
@@ -26,101 +22,20 @@
is => 'rw',
);
- sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
- my $scalarref = ${*$self};
- $$scalarref = 'SCALAR';
- my $arrayref = \@{*$self};
- @$arrayref = ('ARRAY');
- return $self;
- };
-};
+ sub BUILD {
+ my $self = shift;
+ # if not a globref then will fail later on assertion
+ if (Scalar::Util::reftype($self) eq 'GLOB') {
+ # fill some other slots in globref
+ my $scalarref = ${*$self};
+ $$scalarref = 'SCALAR';
+ my $arrayref = \@{*$self};
+ @$arrayref = ('ARRAY');
+ };
-sub test___isa {
- my $self = shift;
- my $obj = MooseX::GlobRef::ObjectTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectTest::Test1'));
- assert_equals('GLOB', reftype($obj));
-};
-
-sub test_accessor {
- my $self = shift;
- my $obj = MooseX::GlobRef::ObjectTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectTest::Test1'));
- assert_equals('default', $obj->field);
- assert_equals(1, $obj->field(1));
- assert_equals(1, $obj->field);
- assert_true($obj->clear_field);
- assert_equals('default', $obj->field);
-};
-
-sub test_slot_moc {
- my $self = shift;
- my $mi = MooseX::GlobRef::ObjectTest::Test1->meta->get_meta_instance;
- assert_not_null($mi);
-
- my $obj = $mi->create_instance;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectTest::Test1'));
- assert_null($mi->get_slot_value($obj, 'field'));
- assert_true(! $mi->is_slot_initialized($obj, 'field'));
- assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
- assert_equals(1, $mi->get_slot_value($obj, 'field'));
- assert_true($mi->is_slot_initialized($obj, 'field'));
- assert_true($mi->deinitialize_slot($obj, 'field'));
- assert_null($mi->get_slot_value($obj, 'field'));
- assert_true(! $mi->is_slot_initialized($obj, 'field'));
-};
-
-sub test_slot_moc_inline {
- my $self = shift;
- my $mi = MooseX::GlobRef::ObjectTest::Test1->meta->get_meta_instance;
- assert_not_null($mi);
-
- my $code_create_instance = $mi->inline_create_instance('$class');
- assert_not_equals('', $code_create_instance);
- my $code_get_slot_value = $mi->inline_get_slot_value('$obj', 'field');
- assert_not_equals('', $code_get_slot_value);
- my $code_is_slot_initialized = $mi->inline_is_slot_initialized('$obj', 'field');
- assert_not_equals('', $code_is_slot_initialized);
- my $code_set_slot_value = $mi->inline_set_slot_value('$obj', 'field', '$value');
- assert_not_equals('', $code_set_slot_value);
- my $code_deinitialize_slot = $mi->inline_deinitialize_slot('$obj', 'field');
- assert_not_equals('', $code_deinitialize_slot);
-
- my $obj = eval "my \$class = 'MooseX::GlobRef::ObjectTest::Test1'; $code_create_instance;";
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectTest::Test1'));
- assert_null(eval $code_get_slot_value);
- assert_true(! eval $code_is_slot_initialized);
- assert_equals(1, eval "my \$value = 1; $code_set_slot_value;");
- assert_equals(1, eval $code_get_slot_value);
- assert_true(eval $code_is_slot_initialized);
- assert_true(eval $code_deinitialize_slot);
- assert_null(eval $code_get_slot_value);
- assert_true(! eval $code_is_slot_initialized);
-};
-
-sub test_weak_field {
- my $self = shift;
- my $mi = MooseX::GlobRef::ObjectTest::Test1->meta->get_meta_instance;
- assert_not_null($mi);
- my $obj = MooseX::GlobRef::ObjectTest::Test1->new;
- assert_not_null($obj);
- assert_true($obj->isa('MooseX::GlobRef::ObjectTest::Test1'));
- assert_null($obj->weak_field);
- {
- my $scalar = 'SCALAR';
- assert_not_null($obj->weak_field(\$scalar));
- assert_not_null($obj->weak_field);
- assert_equals('SCALAR', ${$obj->weak_field});
- $mi->weaken_slot_value($obj, 'weak_field');
+ return $self;
};
- assert_null($obj->weak_field);
};
1;
Modified: MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm
===================================================================
--- MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm 2009-02-12 20:22:40 UTC (rev 7644)
+++ MooseX-GlobRef-Object/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm 2009-02-12 22:15:46 UTC (rev 7645)
@@ -5,9 +5,19 @@
sub suite {
my $class = shift;
- my $suite = Test::Unit::TestSuite->empty_new('ExtendsObject');
- $suite->add_test('MooseX::GlobRef::ObjectTest');
- $suite->add_test('MooseX::GlobRef::ObjectImmutableTest');
+
+ my $suite_name = __PACKAGE__;
+ $suite_name =~ s/.*://;
+
+ my $simple_test_name = __PACKAGE__;
+ $simple_test_name =~ s/Suite$//;
+
+ my $immutable_test_name = __PACKAGE__;
+ $immutable_test_name =~ s/TestSuite$/ImmutableTest/;
+
+ my $suite = Test::Unit::TestSuite->empty_new($suite_name);
+ $suite->add_test($simple_test_name);
+ $suite->add_test($immutable_test_name);
return $suite;
};
More information about the Moose-commits
mailing list