From: <mjd...@us...> - 2009-11-25 06:02:58
|
Revision: 325 http://treebase.svn.sourceforge.net/treebase/?rev=325&view=rev Author: mjdominus Date: 2009-11-25 06:01:41 +0000 (Wed, 25 Nov 2009) Log Message: ----------- bug fix in has_subobject, plus regression test Modified Paths: -------------- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm Added Paths: ----------- trunk/treebase-core/src/main/perl/t/80_regression.t Modified: trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm =================================================================== --- trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm 2009-11-25 05:58:49 UTC (rev 324) +++ trunk/treebase-core/src/main/perl/lib/CIPRES/TreeBase/VeryBadORM.pm 2009-11-25 06:01:41 UTC (rev 325) @@ -253,7 +253,8 @@ sub has_subobject { my $base = shift; my $subobj = shift; - return $base->has_attr($base->foreign_key($subobj)); + my $fk = $base->foreign_key($subobj) or return; + return $base->has_attr($fk); } =item foreign_key() Added: trunk/treebase-core/src/main/perl/t/80_regression.t =================================================================== --- trunk/treebase-core/src/main/perl/t/80_regression.t (rev 0) +++ trunk/treebase-core/src/main/perl/t/80_regression.t 2009-11-25 06:01:41 UTC (rev 325) @@ -0,0 +1,21 @@ + +use Test::More tests => 1; + +BEGIN { + require CIPRES::TreeBase::VeryBadORM; + + package TestObject; + CIPRES::TreeBase::VeryBadORM->register; + sub table { "study" } + sub foreign_key { return undef; } +} + +# Regression test for bug in has_subobject: if ->foreign_key indicates that the attribute is +# unknown, don't try to call has_attr on the failed result value +# 20091125 MJD +use DBI; +my $dbh = DBI->connect("DBI:CSV:f_dir=test_db;csv_eol=\n"); +CIPRES::TreeBase::VeryBadORM->set_db_connection($dbh); + +ok(! TestObject->has_subobject("poo"), "foreign_key method failure"); + This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |