[Bast-commits] r6246 - in DBIx-Class/0.08/branches/rs_subclass/t: . lib/DBICNSTest

[abraxxa at dev.catalyst.perl.org]

Author: abraxxa
Date: 2009-05-13 08:42:05 +0000 (Wed, 13 May 2009)
New Revision: 6246

Added:
   DBIx-Class/0.08/branches/rs_subclass/t/39load_classes.t
   DBIx-Class/0.08/branches/rs_subclass/t/lib/DBICNSTest/S.pm
Log:
added test to show the bug


Added: DBIx-Class/0.08/branches/rs_subclass/t/39load_classes.t
===================================================================
--- DBIx-Class/0.08/branches/rs_subclass/t/39load_classes.t	                        (rev 0)
+++ DBIx-Class/0.08/branches/rs_subclass/t/39load_classes.t	2009-05-13 08:42:05 UTC (rev 6246)
@@ -0,0 +1,30 @@
+#!/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 => 4;
+
+my $warnings;
+eval {
+    local $SIG{__WARN__} = sub { $warnings .= shift };
+    package DBICNSTest;
+    use base qw/DBIx::Class::Schema/;
+    __PACKAGE__->load_classes(qw/
+        S
+    /);
+};
+ok(!$@) or diag $@;
+
+my $source_s = DBICNSTest->source('S');
+isa_ok($source_s, 'DBIx::Class::ResultSource::Table');
+my $rset_s   = DBICNSTest->resultset('S');
+isa_ok($rset_s, 'DBICNSTest::Result::A');
+
+my $row = $rset_s->new({});
+
+ok($row->can('submethod'), 'method defined in rs subclass');

Added: DBIx-Class/0.08/branches/rs_subclass/t/lib/DBICNSTest/S.pm
===================================================================
--- DBIx-Class/0.08/branches/rs_subclass/t/lib/DBICNSTest/S.pm	                        (rev 0)
+++ DBIx-Class/0.08/branches/rs_subclass/t/lib/DBICNSTest/S.pm	2009-05-13 08:42:05 UTC (rev 6246)
@@ -0,0 +1,8 @@
+package DBICNSTest::S;
+use base qw/DBICNSTest::Result::A/;
+
+sub submethod {
+    return 'this is a new method in this subclass';
+}
+
+1;