From 4ce8e2312b117f9042deadbfc262d03429a515e4 Mon Sep 17 00:00:00 2001
From: cjfields <cjfields@bioperl.org>
Date: Tue, 9 Dec 2008 03:19:29 +0000
Subject: [PATCH] Modify to test new temp classes and ensure that added methods
 do not pollute original namespace

svn path=/bioperl-live/trunk/; revision=15121
---
 t/Root/RootI.t | 91 +++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 58 insertions(+), 33 deletions(-)

diff --git a/t/Root/RootI.t b/t/Root/RootI.t
index 001e5fdd7..be8245c67 100644
--- a/t/Root/RootI.t
+++ b/t/Root/RootI.t
@@ -7,7 +7,7 @@ BEGIN {
     use lib '.';
     use Bio::Root::Test;
     
-    test_begin(-tests => 24);
+    test_begin(-tests => 30);
 	
 	use_ok('Bio::Root::Root');
     use_ok('Bio::Seq');
@@ -80,11 +80,12 @@ is shift @vals, 'up the';
 is shift @vals, 'stairs';
 
 # tests for _set_from_args()
-{
-	no warnings 'redefine';
-	
-	# simplest form
-	local *Bio::Root::Root::new = sub {
+# Let's not pollute Bio::Root::Root namespace if possible
+# Create temp classes instead which inherit Bio::Root::Root, then test
+
+package Bio::Foo1;
+use base qw(Bio::Root::Root);
+sub new {
 		my $class = shift;
 		my $self = {};
 		bless $self, ref($class) || $class;
@@ -93,12 +94,15 @@ is shift @vals, 'stairs';
 		
 		return $self;
 	};
-	
-	$obj = Bio::Root::Root->new(-verbose => 1, t1 => 1, '--Test-2' => 2);
-	ok ! $obj->can('t1'), 'arg not callable';
-	
-	# with method creation
-	local *Bio::Root::Root::new = sub {
+
+package main;
+
+$obj = Bio::Foo1->new(-verbose => 1, t1 => 1, '--Test-2' => 2);
+ok ! $obj->can('t1'), 'arg not callable';
+
+package Bio::Foo2;
+use base qw(Bio::Root::Root);
+sub new {
 		my $class = shift;
 		my $self = {};
 		bless $self, ref($class) || $class;
@@ -107,13 +111,20 @@ is shift @vals, 'stairs';
 		
 		return $self;
 	};
-	
-	$obj = Bio::Root::Root->new(-verbose => 1, t3 => 1, '--Test-4' => 2);
-	ok $obj->can('t3'), 'arg callable since method was created';
-	ok $obj->can('test_4'), 'mal-formed arg callable since method was created with good name';
-	
-	# with method creation, but limited to certain methods
-	local *Bio::Root::Root::new = sub {
+
+package main;
+
+$obj = Bio::Foo2->new(-verbose => 1, t3 => 1, '--Test-4' => 2);
+ok $obj->can('t3'), 'arg callable since method was created';
+ok $obj->can('test_4'), 'mal-formed arg callable since method was created with good name';
+for my $m (qw(t3 test_4)) {
+    ok (UNIVERSAL::can('Bio::Foo2',$m), "Methods in new package/class namespace");
+    ok (!UNIVERSAL::can('Bio::Root::Root',$m), "Methods don't pollute original Bio::Root::Root namespace");
+}
+
+package Bio::Foo3;
+use base qw(Bio::Root::Root);
+sub new {
 		my $class = shift;
 		my $self = {};
 		bless $self, ref($class) || $class;
@@ -122,13 +133,19 @@ is shift @vals, 'stairs';
 		
 		return $self;
 	};
-	
-	$obj = Bio::Root::Root->new(-verbose => 1, t5 => 1, '--Test-6' => 2);
-	ok $obj->can('t5'), 'arg callable since method was created';
-	ok ! $obj->can('test_6'), 'arg not in method list not created';
-	
-	# with synonyms
-	local *Bio::Root::Root::new = sub {
+
+package main;
+
+$obj = Bio::Foo3->new(-verbose => 1, t5 => 1, '--Test-6' => 2);
+ok $obj->can('t5'), 'arg callable since method was created';
+ok ! $obj->can('test_6'), 'arg not in method list not created';
+
+ok (UNIVERSAL::can('Bio::Foo3','t5'), "Methods in new package/class namespace");
+ok (!UNIVERSAL::can('Bio::Root::Root','t5'), "Methods don't pollute original Bio::Root::Root namespace");
+
+package Bio::Foo4;
+use base qw(Bio::Root::Root);
+sub new {
 		my $class = shift;
 		my $self = {};
 		bless $self, ref($class) || $class;
@@ -142,11 +159,19 @@ is shift @vals, 'stairs';
 		
 		return $self;
 	};
-	
-	$obj = Bio::Root::Root->new(-verbose => 1, t7 => 1, '--Test-8' => 2);
-	is $obj->verbose, 1, 'verbose was set correctly';
-	is $obj->t7, 1, 'synonym was set correctly';
-	is $obj->test7, 1, 'real method of synonym was set correctly';
-	is $obj->test_8, 2, 'mal-formed arg correctly resolved to created method';
-	is $obj->t8, 2, 'synonym of set method was set correctly';
+
+# with synonyms
+package main;
+
+$obj = Bio::Foo4->new(-verbose => 1, t7 => 1, '--Test-8' => 2);
+is $obj->verbose, 1, 'verbose was set correctly';
+is $obj->t7, 1, 'synonym was set correctly';
+is $obj->test7, 1, 'real method of synonym was set correctly';
+is $obj->test_8, 2, 'mal-formed arg correctly resolved to created method';
+is $obj->t8, 2, 'synonym of set method was set correctly';
+
+for my $m (qw()) {
+    ok (!UNIVERSAL::can('Bio::Foo4','t7'), "Methods in new package/class namespace");
+    ok (!UNIVERSAL::can('Bio::Root::Root','t7'), "Methods don't pollute original Bio::Root::Root namespace");
 }
+
-- 
2.11.4.GIT