[Bast-commits] r7913 - in DBIx-Class/0.08/branches/test_class: . t
t/lib t/lib/XUnit
robkinyon at dev.catalyst.perl.org
robkinyon at dev.catalyst.perl.org
Sun Nov 15 23:43:18 GMT 2009
Author: robkinyon
Date: 2009-11-15 23:43:17 +0000 (Sun, 15 Nov 2009)
New Revision: 7913
Added:
DBIx-Class/0.08/branches/test_class/t/lib/XUnit.pm
DBIx-Class/0.08/branches/test_class/t/lib/XUnit/
DBIx-Class/0.08/branches/test_class/t/lib/XUnit/LoadNamespace.pm
DBIx-Class/0.08/branches/test_class/t/xunit.t
Removed:
DBIx-Class/0.08/branches/test_class/t/39load_namespaces_1.t
DBIx-Class/0.08/branches/test_class/t/39load_namespaces_2.t
DBIx-Class/0.08/branches/test_class/t/39load_namespaces_3.t
DBIx-Class/0.08/branches/test_class/t/39load_namespaces_4.t
DBIx-Class/0.08/branches/test_class/t/39load_namespaces_exception.t
DBIx-Class/0.08/branches/test_class/t/39load_namespaces_rt41083.t
Modified:
DBIx-Class/0.08/branches/test_class/Makefile.PL
Log:
Moved the t/39* tests to XUnit as an example
Modified: DBIx-Class/0.08/branches/test_class/Makefile.PL
===================================================================
--- DBIx-Class/0.08/branches/test_class/Makefile.PL 2009-11-15 23:00:46 UTC (rev 7912)
+++ DBIx-Class/0.08/branches/test_class/Makefile.PL 2009-11-15 23:43:17 UTC (rev 7913)
@@ -13,6 +13,7 @@
test_requires 'Test::Builder' => '0.33';
+test_requires 'Test::Class' => '0.33';
test_requires 'Test::Deep' => '0';
test_requires 'Test::Exception' => '0';
test_requires 'Test::More' => '0.92';
Deleted: DBIx-Class/0.08/branches/test_class/t/39load_namespaces_1.t
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/39load_namespaces_1.t 2009-11-15 23:00:46 UTC (rev 7912)
+++ DBIx-Class/0.08/branches/test_class/t/39load_namespaces_1.t 2009-11-15 23:43:17 UTC (rev 7913)
@@ -1,35 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-use lib qw(t/lib);
-use DBICTest; # do not remove even though it is not used
-
-plan tests => 8;
-
-my $warnings;
-eval {
- local $SIG{__WARN__} = sub { $warnings .= shift };
- package DBICNSTest;
- use base qw/DBIx::Class::Schema/;
- __PACKAGE__->load_namespaces;
-};
-ok(!$@) or diag $@;
-like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
-
-my $source_a = DBICNSTest->source('A');
-isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
-my $rset_a = DBICNSTest->resultset('A');
-isa_ok($rset_a, 'DBICNSTest::ResultSet::A');
-
-my $source_b = DBICNSTest->source('B');
-isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
-my $rset_b = DBICNSTest->resultset('B');
-isa_ok($rset_b, 'DBIx::Class::ResultSet');
-
-for my $moniker (qw/A B/) {
- my $class = "DBICNSTest::Result::$moniker";
- ok(!defined($class->result_source_instance->source_name));
-}
Deleted: DBIx-Class/0.08/branches/test_class/t/39load_namespaces_2.t
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/39load_namespaces_2.t 2009-11-15 23:00:46 UTC (rev 7912)
+++ DBIx-Class/0.08/branches/test_class/t/39load_namespaces_2.t 2009-11-15 23:43:17 UTC (rev 7913)
@@ -1,33 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-use lib qw(t/lib);
-use DBICTest; # do not remove even though it is not used
-
-plan tests => 6;
-
-my $warnings;
-eval {
- local $SIG{__WARN__} = sub { $warnings .= shift };
- package DBICNSTest;
- use base qw/DBIx::Class::Schema/;
- __PACKAGE__->load_namespaces(
- result_namespace => 'Rslt',
- resultset_namespace => 'RSet',
- );
-};
-ok(!$@) or diag $@;
-like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
-
-my $source_a = DBICNSTest->source('A');
-isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
-my $rset_a = DBICNSTest->resultset('A');
-isa_ok($rset_a, 'DBICNSTest::RSet::A');
-
-my $source_b = DBICNSTest->source('B');
-isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
-my $rset_b = DBICNSTest->resultset('B');
-isa_ok($rset_b, 'DBIx::Class::ResultSet');
Deleted: DBIx-Class/0.08/branches/test_class/t/39load_namespaces_3.t
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/39load_namespaces_3.t 2009-11-15 23:00:46 UTC (rev 7912)
+++ DBIx-Class/0.08/branches/test_class/t/39load_namespaces_3.t 2009-11-15 23:43:17 UTC (rev 7913)
@@ -1,36 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-use lib qw(t/lib);
-use DBICTest; # do not remove even though it is not used
-
-plan tests => 7;
-
-my $warnings;
-eval {
- local $SIG{__WARN__} = sub { $warnings .= shift };
- package DBICNSTestOther;
- use base qw/DBIx::Class::Schema/;
- __PACKAGE__->load_namespaces(
- result_namespace => [ '+DBICNSTest::Rslt', '+DBICNSTest::OtherRslt' ],
- resultset_namespace => '+DBICNSTest::RSet',
- );
-};
-ok(!$@) or diag $@;
-like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
-
-my $source_a = DBICNSTestOther->source('A');
-isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
-my $rset_a = DBICNSTestOther->resultset('A');
-isa_ok($rset_a, 'DBICNSTest::RSet::A');
-
-my $source_b = DBICNSTestOther->source('B');
-isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
-my $rset_b = DBICNSTestOther->resultset('B');
-isa_ok($rset_b, 'DBIx::Class::ResultSet');
-
-my $source_d = DBICNSTestOther->source('D');
-isa_ok($source_d, 'DBIx::Class::ResultSource::Table');
Deleted: DBIx-Class/0.08/branches/test_class/t/39load_namespaces_4.t
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/39load_namespaces_4.t 2009-11-15 23:00:46 UTC (rev 7912)
+++ DBIx-Class/0.08/branches/test_class/t/39load_namespaces_4.t 2009-11-15 23:43:17 UTC (rev 7913)
@@ -1,30 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-use lib qw(t/lib);
-use DBICTest; # do not remove even though it is not used
-
-plan tests => 6;
-
-my $warnings;
-eval {
- local $SIG{__WARN__} = sub { $warnings .= shift };
- package DBICNSTest;
- use base qw/DBIx::Class::Schema/;
- __PACKAGE__->load_namespaces( default_resultset_class => 'RSBase' );
-};
-ok(!$@) or diag $@;
-like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
-
-my $source_a = DBICNSTest->source('A');
-isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
-my $rset_a = DBICNSTest->resultset('A');
-isa_ok($rset_a, 'DBICNSTest::ResultSet::A');
-
-my $source_b = DBICNSTest->source('B');
-isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
-my $rset_b = DBICNSTest->resultset('B');
-isa_ok($rset_b, 'DBICNSTest::RSBase');
Deleted: DBIx-Class/0.08/branches/test_class/t/39load_namespaces_exception.t
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/39load_namespaces_exception.t 2009-11-15 23:00:46 UTC (rev 7912)
+++ DBIx-Class/0.08/branches/test_class/t/39load_namespaces_exception.t 2009-11-15 23:43:17 UTC (rev 7913)
@@ -1,21 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-use Test::More;
-
-use lib qw(t/lib);
-use DBICTest; # do not remove even though it is not used
-
-plan tests => 1;
-
-eval {
- package DBICNSTest;
- use base qw/DBIx::Class::Schema/;
- __PACKAGE__->load_namespaces(
- result_namespace => 'Bogus',
- resultset_namespace => 'RSet',
- );
-};
-
-like ($@, qr/are you sure this is a real Result Class/, 'Clear exception thrown');
Deleted: DBIx-Class/0.08/branches/test_class/t/39load_namespaces_rt41083.t
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/39load_namespaces_rt41083.t 2009-11-15 23:00:46 UTC (rev 7912)
+++ DBIx-Class/0.08/branches/test_class/t/39load_namespaces_rt41083.t 2009-11-15 23:43:17 UTC (rev 7913)
@@ -1,67 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-use lib 't/lib';
-use DBICTest; # do not remove even though it is not used
-use Test::More tests => 8;
-
-sub _chk_warning {
- defined $_[0]?
- $_[0] !~ qr/We found ResultSet class '([^']+)' for '([^']+)', but it seems that you had already set '([^']+)' to use '([^']+)' instead/ :
- 1
-}
-
-sub _chk_extra_sources_warning {
- my $p = qr/already has a source, use register_extra_source for additional sources/;
- defined $_[0]? $_[0] !~ /$p/ : 1;
-}
-
-sub _verify_sources {
- my @monikers = @_;
- is_deeply (
- [ sort DBICNSTest::RtBug41083->sources ],
- \@monikers,
- 'List of resultsource registrations',
- );
-}
-
-{
- my $warnings;
- eval {
- local $SIG{__WARN__} = sub { $warnings .= shift };
- package DBICNSTest::RtBug41083;
- use base 'DBIx::Class::Schema';
- __PACKAGE__->load_namespaces(
- result_namespace => 'Schema_A',
- resultset_namespace => 'ResultSet_A',
- default_resultset_class => 'ResultSet'
- );
- };
-
- ok(!$@) or diag $@;
- ok(_chk_warning($warnings), 'expected no resultset complaint');
- ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
-
- _verify_sources (qw/A A::Sub/);
-}
-
-{
- my $warnings;
- eval {
- local $SIG{__WARN__} = sub { $warnings .= shift };
- package DBICNSTest::RtBug41083;
- use base 'DBIx::Class::Schema';
- __PACKAGE__->load_namespaces(
- result_namespace => 'Schema',
- resultset_namespace => 'ResultSet',
- default_resultset_class => 'ResultSet'
- );
- };
- ok(!$@) or diag $@;
- ok(_chk_warning($warnings), 'expected no resultset complaint') or diag $warnings;
- ok(_chk_extra_sources_warning($warnings), 'expected no extra sources complaint') or diag($warnings);
-
- _verify_sources (qw/A A::Sub Foo Foo::Sub/);
-}
Added: DBIx-Class/0.08/branches/test_class/t/lib/XUnit/LoadNamespace.pm
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/lib/XUnit/LoadNamespace.pm (rev 0)
+++ DBIx-Class/0.08/branches/test_class/t/lib/XUnit/LoadNamespace.pm 2009-11-15 23:43:17 UTC (rev 7913)
@@ -0,0 +1,206 @@
+package
+ XUnit::LoadNameSpace;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( XUnit );
+
+sub test1 : Tests(8) {
+ my $self = shift;
+
+ my $warnings;
+ eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTest;
+ use base qw/DBIx::Class::Schema/;
+ __PACKAGE__->load_namespaces;
+ };
+ $self->ok(!$@) or diag $@;
+ $self->like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
+
+ my $source_a = DBICNSTest->source('A');
+ $self->isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
+ my $rset_a = DBICNSTest->resultset('A');
+ $self->isa_ok($rset_a, 'DBICNSTest::ResultSet::A');
+
+ my $source_b = DBICNSTest->source('B');
+ $self->isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
+ my $rset_b = DBICNSTest->resultset('B');
+ $self->isa_ok($rset_b, 'DBIx::Class::ResultSet');
+
+ for my $moniker (qw/A B/) {
+ my $class = "DBICNSTest::Result::$moniker";
+ $self->ok(!defined($class->result_source_instance->source_name));
+ }
+}
+
+sub test2 : Tests(6) {
+ my $self = shift;
+
+ my $warnings;
+ eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTest;
+ use base qw/DBIx::Class::Schema/;
+ __PACKAGE__->load_namespaces(
+ result_namespace => 'Rslt',
+ resultset_namespace => 'RSet',
+ );
+ };
+ $self->ok(!$@) or diag $@;
+ $self->like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
+
+ my $source_a = DBICNSTest->source('A');
+ $self->isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
+ my $rset_a = DBICNSTest->resultset('A');
+ $self->isa_ok($rset_a, 'DBICNSTest::RSet::A');
+
+ my $source_b = DBICNSTest->source('B');
+ $self->isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
+ my $rset_b = DBICNSTest->resultset('B');
+ $self->isa_ok($rset_b, 'DBIx::Class::ResultSet');
+}
+
+sub test3 : Tests(7) {
+ my $self = shift;
+
+ my $warnings;
+ eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTestOther;
+ use base qw/DBIx::Class::Schema/;
+ __PACKAGE__->load_namespaces(
+ result_namespace => [ '+DBICNSTest::Rslt', '+DBICNSTest::OtherRslt' ],
+ resultset_namespace => '+DBICNSTest::RSet',
+ );
+ };
+ $self->ok(!$@) or diag $@;
+ $self->like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
+
+ my $source_a = DBICNSTestOther->source('A');
+ $self->isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
+ my $rset_a = DBICNSTestOther->resultset('A');
+ $self->isa_ok($rset_a, 'DBICNSTest::RSet::A');
+
+ my $source_b = DBICNSTestOther->source('B');
+ $self->isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
+ my $rset_b = DBICNSTestOther->resultset('B');
+ $self->isa_ok($rset_b, 'DBIx::Class::ResultSet');
+
+ my $source_d = DBICNSTestOther->source('D');
+ $self->isa_ok($source_d, 'DBIx::Class::ResultSource::Table');
+}
+
+sub test4 : Tests(6) {
+ my $self = shift;
+
+ my $warnings;
+ eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTest;
+ use base qw/DBIx::Class::Schema/;
+ __PACKAGE__->load_namespaces( default_resultset_class => 'RSBase' );
+ };
+ $self->ok(!$@) or diag $@;
+ $self->like($warnings, qr/load_namespaces found ResultSet class C with no corresponding Result class/);
+
+ my $source_a = DBICNSTest->source('A');
+ $self->isa_ok($source_a, 'DBIx::Class::ResultSource::Table');
+ my $rset_a = DBICNSTest->resultset('A');
+ $self->isa_ok($rset_a, 'DBICNSTest::ResultSet::A');
+
+ my $source_b = DBICNSTest->source('B');
+ $self->isa_ok($source_b, 'DBIx::Class::ResultSource::Table');
+ my $rset_b = DBICNSTest->resultset('B');
+ $self->isa_ok($rset_b, 'DBICNSTest::RSBase');
+}
+
+sub exception : Tests(1) {
+ my $self = shift;
+
+ eval {
+ package DBICNSTest;
+ use base qw/DBIx::Class::Schema/;
+ __PACKAGE__->load_namespaces(
+ result_namespace => 'Bogus',
+ resultset_namespace => 'RSet',
+ );
+ };
+
+ $self->like ($@, qr/are you sure this is a real Result Class/, 'Clear exception thrown');
+}
+
+sub rt41083_case1 : Tests(4) {
+ my $self = shift;
+
+ my $warnings;
+ eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTest::RtBug41083;
+ use base 'DBIx::Class::Schema';
+ __PACKAGE__->load_namespaces(
+ result_namespace => 'Schema_A',
+ resultset_namespace => 'ResultSet_A',
+ default_resultset_class => 'ResultSet'
+ );
+ };
+
+ $self->ok(!$@) or diag $@;
+ $self->check_warnings($warnings);
+ $self->verify_sources(qw/A A::Sub/);
+}
+
+sub rt41083_case2 : Tests(4) {
+ my $self = shift;
+
+ my $warnings;
+ eval {
+ local $SIG{__WARN__} = sub { $warnings .= shift };
+ package DBICNSTest::RtBug41083;
+ use base 'DBIx::Class::Schema';
+ __PACKAGE__->load_namespaces(
+ result_namespace => 'Schema',
+ resultset_namespace => 'ResultSet',
+ default_resultset_class => 'ResultSet'
+ );
+ };
+ $self->ok(!$@) or diag $@;
+ $self->check_warnings($warnings);
+ $self->verify_sources(qw/A A::Sub Foo Foo::Sub/);
+}
+
+sub check_warnings {
+ my $self = shift;
+ my ($warnings) = @_;
+
+ if ( defined $warnings ) {
+ $self->unlike(
+ qr/We found ResultSet class '([^']+)' for '([^']+)', but it seems that you had already set '([^']+)' to use '([^']+)' instead/,
+ "Have a warning, but it's ok"
+ )
+ and
+ $self->unlike(
+ qr/already has a source, use register_extra_source for additional sources/,
+ "Have a warning, but it's ok"
+ )
+ or $self->diag( $warnings );
+ }
+ else {
+ $self->ok( 1, "No complaints" );
+ $self->ok( 1, "No complaints" );
+ }
+}
+
+sub verify_sources {
+ my $self = shift;
+ my @monikers = @_;
+ $self->is_deeply (
+ [ sort DBICNSTest::RtBug41083->sources ],
+ \@monikers,
+ 'List of resultsource registrations',
+ );
+}
+
+1;
+__END__
Added: DBIx-Class/0.08/branches/test_class/t/lib/XUnit.pm
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/lib/XUnit.pm (rev 0)
+++ DBIx-Class/0.08/branches/test_class/t/lib/XUnit.pm 2009-11-15 23:43:17 UTC (rev 7913)
@@ -0,0 +1,35 @@
+package # Hide from PAUSE
+ XUnit;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw( Test::Class );
+
+INIT { Test::Class->runtests }
+
+BEGIN {
+ # XXX Need a better way to do this.
+ my $subs_for = sub {
+ my $pkg = shift;
+ no strict 'refs';
+ return grep { defined &{"${pkg}::${_}"} } keys %{"${pkg}::"};
+ };
+
+ my @packages = qw(
+ Test::More
+ );
+
+ foreach my $pkg ( @packages ) {
+ eval "use $pkg ();";
+ die $@ if $@;
+ foreach my $subroutine ( $subs_for->($pkg) ) {
+ next if __PACKAGE__->can($subroutine);
+ eval qq| sub $subroutine { shift; goto &{"${pkg}::${subroutine}"} } |;
+ die $@ if $@;
+ }
+ }
+}
+
+1;
+__END__
Added: DBIx-Class/0.08/branches/test_class/t/xunit.t
===================================================================
--- DBIx-Class/0.08/branches/test_class/t/xunit.t (rev 0)
+++ DBIx-Class/0.08/branches/test_class/t/xunit.t 2009-11-15 23:43:17 UTC (rev 7913)
@@ -0,0 +1,8 @@
+#!/usr/bin/perl -T
+
+use strict;
+use warnings;
+
+use lib qw( t/lib );
+
+use Test::Class::Load 't/lib/XUnit';
More information about the Bast-commits
mailing list