[Moose-commits] r7800 - in MooseX-GlobRef/trunk: t t/tlib/MooseX
t/tlib/MooseX/GlobRef xt
dexter at code2.0beta.co.uk
dexter at code2.0beta.co.uk
Thu Feb 26 17:07:17 GMT 2009
Author: dexter
Date: 2009-02-26 09:07:17 -0800 (Thu, 26 Feb 2009)
New Revision: 7800
Added:
MooseX-GlobRef/trunk/t/all_tests.t
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestBase.pm
Removed:
MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t
MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm
Modified:
MooseX-GlobRef/trunk/t/test.pl
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm
MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm
MooseX-GlobRef/trunk/xt/
Log:
* Refactor test units.
Deleted: MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t
===================================================================
--- MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/010_MooseX_GlobRef.t 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
-
-my $suite = __FILE__;
-$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
-$suite =~ s/_/::/g;
-$suite .= "TestSuite";
-
-Test::Unit::HarnessUnit->new->start($suite);
Deleted: MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t
===================================================================
--- MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/020_MooseX_GlobRef_Object.t 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,25 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use File::Spec;
-use Cwd;
-
-BEGIN {
- unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-
- my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
- unshift @INC, File::Spec->catdir($cwd, 't/tlib');
-};
-
-use Test::Unit::Lite;
-
-local $SIG{__WARN__} = sub { require Carp; Carp::confess("Warning: ", @_) };
-
-my $suite = __FILE__;
-$suite =~ s/.*\d{3}_(.*)\.t/$1/ or die;
-$suite =~ s/_/::/g;
-$suite .= "TestSuite";
-
-Test::Unit::HarnessUnit->new->start($suite);
Added: MooseX-GlobRef/trunk/t/all_tests.t
===================================================================
--- MooseX-GlobRef/trunk/t/all_tests.t (rev 0)
+++ MooseX-GlobRef/trunk/t/all_tests.t 2009-02-26 17:07:17 UTC (rev 7800)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use File::Spec;
+use Cwd;
+
+BEGIN {
+ unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
+
+ my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
+ unshift @INC, File::Spec->catdir($cwd, 'inc');
+ unshift @INC, File::Spec->catdir($cwd, 'lib');
+}
+
+use Test::Unit::Lite 0.11;
+use Test::Assert;
+
+use Exception::Base max_arg_nums => 0, max_arg_len => 200, verbosity => 4;
+use Exception::Assertion verbosity => 4;
+
+local $SIG{__WARN__} = sub { require Carp; Carp::confess( $_[0] ) };
+
+Test::Unit::HarnessUnit->new->start('Test::Unit::Lite::AllTests');
Modified: MooseX-GlobRef/trunk/t/test.pl
===================================================================
--- MooseX-GlobRef/trunk/t/test.pl 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/test.pl 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,8 +1,7 @@
#!/usr/bin/perl
-use 5.006;
use strict;
-no warnings;
+use warnings;
use File::Basename;
use File::Spec;
@@ -11,9 +10,18 @@
BEGIN {
chdir dirname(__FILE__) or die "$!";
chdir '..' or die "$!";
-};
-do "./Build.PL";
+ unshift @INC, map { /(.*)/; $1 } split(/:/, $ENV{PERL5LIB}) if defined $ENV{PERL5LIB} and ${^TAINT};
-local @ARGV = (@ARGV, 'test');
-do "./Build";
+ my $cwd = ${^TAINT} ? do { local $_=getcwd; /(.*)/; $1 } : '.';
+ unshift @INC, File::Spec->catdir($cwd, 'inc');
+ unshift @INC, File::Spec->catdir($cwd, 'lib');
+}
+
+use Test::Unit::Lite;
+
+use Exception::Base max_arg_nums => 0, max_arg_len => 200, verbosity => 4;
+
+local $SIG{__WARN__} = sub { require Carp; Carp::confess( $_[0] ) };
+
+all_tests;
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectImmutableTest.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,6 +1,6 @@
package MooseX::GlobRef::ObjectImmutableTest;
-use parent 'MooseX::GlobRefBaseTest';
+use parent 'MooseX::GlobRefTestBase';
use constant test_class => (__PACKAGE__ . '::TestClass');
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTest.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,6 +1,6 @@
package MooseX::GlobRef::ObjectTest;
-use parent 'MooseX::GlobRefBaseTest';
+use parent 'MooseX::GlobRefTestBase';
use constant test_class => (__PACKAGE__ . '::TestClass');
Deleted: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRef/ObjectTestSuite.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,24 +0,0 @@
-package MooseX::GlobRef::ObjectTestSuite;
-
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestSuite';
-
-sub suite {
- my $class = shift;
-
- 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;
-};
-
-1;
Deleted: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,133 +0,0 @@
-package MooseX::GlobRefBaseTest;
-
-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_true(! $mi->is_slot_initialized($obj, 'field'));
- assert_null($mi->get_slot_value($obj, 'field'));
- assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
- assert_true($mi->is_slot_initialized($obj, 'field'));
- assert_equals(1, $mi->get_slot_value($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'));
- assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
- assert_equals(1, $mi->get_slot_value($obj, 'field'));
-
- my $cloned = $mi->clone_instance( $obj );
- assert_not_null($cloned);
- assert_str_not_equals($obj, $cloned);
- assert_true($mi->is_slot_initialized($cloned, 'field'));
- assert_equals(1, $mi->get_slot_value($cloned, '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);
-};
-
-sub test_dump {
- my $self = shift;
- my $test_class = $self->test_class;
-
- my $obj = $test_class->new;
- assert_not_null($obj);
- assert_isa($test_class, $obj);
- $obj->field('VALUE');
- my @dump = $obj->dump;
- assert_equals( 2, scalar @dump );
- assert_matches( qr/$test_class.*VALUE/s, join '', @dump );
- my $dump = $obj->dump;
- assert_matches( qr/$test_class.*VALUE/s, $dump );
-};
-
-1;
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefImmutableTest.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,6 +1,6 @@
package MooseX::GlobRefImmutableTest;
-use parent 'MooseX::GlobRefBaseTest';
+use parent 'MooseX::GlobRefTestBase';
use constant test_class => (__PACKAGE__ . '::TestClass');
Modified: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTest.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,6 +1,6 @@
package MooseX::GlobRefTest;
-use parent 'MooseX::GlobRefBaseTest';
+use parent 'MooseX::GlobRefTestBase';
use constant test_class => (__PACKAGE__ . '::TestClass');
Copied: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestBase.pm (from rev 7793, MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefBaseTest.pm)
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestBase.pm (rev 0)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestBase.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -0,0 +1,133 @@
+package MooseX::GlobRefTestBase;
+
+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_true(! $mi->is_slot_initialized($obj, 'field'));
+ assert_null($mi->get_slot_value($obj, 'field'));
+ assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
+ assert_true($mi->is_slot_initialized($obj, 'field'));
+ assert_equals(1, $mi->get_slot_value($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'));
+ assert_equals(1, $mi->set_slot_value($obj, 'field', 1));
+ assert_equals(1, $mi->get_slot_value($obj, 'field'));
+
+ my $cloned = $mi->clone_instance( $obj );
+ assert_not_null($cloned);
+ assert_str_not_equals($obj, $cloned);
+ assert_true($mi->is_slot_initialized($cloned, 'field'));
+ assert_equals(1, $mi->get_slot_value($cloned, '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);
+};
+
+sub test_dump {
+ my $self = shift;
+ my $test_class = $self->test_class;
+
+ my $obj = $test_class->new;
+ assert_not_null($obj);
+ assert_isa($test_class, $obj);
+ $obj->field('VALUE');
+ my @dump = $obj->dump;
+ assert_equals( 2, scalar @dump );
+ assert_matches( qr/$test_class.*VALUE/s, join '', @dump );
+ my $dump = $obj->dump;
+ assert_matches( qr/$test_class.*VALUE/s, $dump );
+};
+
+1;
Deleted: MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm
===================================================================
--- MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm 2009-02-26 16:54:19 UTC (rev 7799)
+++ MooseX-GlobRef/trunk/t/tlib/MooseX/GlobRefTestSuite.pm 2009-02-26 17:07:17 UTC (rev 7800)
@@ -1,24 +0,0 @@
-package MooseX::GlobRefTestSuite;
-
-use Test::Unit::Lite;
-use parent 'Test::Unit::TestSuite';
-
-sub suite {
- my $class = shift;
-
- 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;
-};
-
-1;
Property changes on: MooseX-GlobRef/trunk/xt
___________________________________________________________________
Name: svn:ignore
+ Debian_CPANTS.txt
More information about the Moose-commits
mailing list