[MOBY-guts] biomoby commit

[Mark Wilkinson]

mwilkinson
Tue Aug 23 15:07:30 EDT 2005
Update of /home/repository/moby/moby-live/Perl/t
In directory pub.open-bio.org:/tmp/cvs-serv22923/t

Modified Files:
	Client-Central.t 
Log Message:
updating test suite to test all possible ways of getting identical artileNames in an object registration - inheritence, identical has or hasa relationships

moby-live/Perl/t Client-Central.t,1.31,1.32
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/t/Client-Central.t,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -r1.31 -r1.32
--- /home/repository/moby/moby-live/Perl/t/Client-Central.t	2005/08/23 18:26:20	1.31
+++ /home/repository/moby/moby-live/Perl/t/Client-Central.t	2005/08/23 19:07:30	1.32
@@ -5,7 +5,7 @@
 
 # change 'tests => 1' to 'tests => last_test_to_print';
 #use SOAP::Lite +trace;
-use Test::More tests => 128; # perldoc Test::More for details
+use Test::More tests => 131; # perldoc Test::More for details
 
 # Test 1
 BEGIN { use_ok('MOBY::Client::Central') };
@@ -37,8 +37,8 @@
                 authURI => "test.suite.com",
 			    Relationships => {
 					ISA => [
-						['Object', 'article1'],
-						['Object', 'articleName2']],
+						['Object', ''],
+						['Object', '']],
 					HASA => [
 						['Object', 'articleName3']]}
                        );
@@ -54,7 +54,7 @@
                 authURI => "test.suite.com",
 			    Relationships => {
 					ISA => [
-						['String', 'article1'],
+						['String', ''],
                                                ],
 					HASA => [
 						['Object', 'articleName3']]}
@@ -72,7 +72,7 @@
                 authURI => "test.suite.com",
 			    Relationships => {
 					ISA => [
-						['Object', 'article1']],
+						['Object', '']],
 					HASA => [
 						['Object', 'articleName3']]}
                        );
@@ -80,22 +80,85 @@
  or diag("Object registration failure: ".$r->message));
 
 
-# Test  Should end up with identical articleName at same level and therefore fail
+# Test  Should end up with identical articleName at same level and therefore fail (by inheritence)
+$r = $C->registerObjectClass(objectType => "Rubbish2",
+                description => "a human-readable description of the object",
+				contactEmail => 'your at email.address',
+                authURI => "test.suite.com",
+			    Relationships => {
+					ISA => [
+						['Rubbish', '']],
+					HASA => [
+						['Object', 'articleName3']]}
+                       );
+( ok(!$r->success,"Object registration correctly failed with identical articlename at same level of XML")
+ or diag("Object registration should have failed with identical articleName at same XML level by inheritence, but didn't: ".$r->message));
+
+
+# Test  Should end up with identical articleName at same level and therefore fail (by double identical HASAs)
+$r = $C->registerObjectClass(objectType => "Rubbish2",
+                description => "a human-readable description of the object",
+				contactEmail => 'your at email.address',
+                authURI => "test.suite.com",
+			    Relationships => {
+					ISA => [
+						['Object', '']],
+					HASA => [
+						['Object', 'articleName3'],
+						['Object', 'articleName3']]}
+                       );
+( ok(!$r->success,"Object registration correctly failed with identical articlename at same level of XML")
+ or diag("Object registration should have failed with identical articleName at same XML level by identical hasas, but didn't: ".$r->message));
+
+# Test  Should end up with identical articleName at same level and therefore fail (by double non-identical HASAs)
+$r = $C->registerObjectClass(objectType => "Rubbish2",
+                description => "a human-readable description of the object",
+				contactEmail => 'your at email.address',
+                authURI => "test.suite.com",
+			    Relationships => {
+					ISA => [
+						['Object', '']],
+					HASA => [
+						['Integer', 'articleName3'],
+						['Object', 'articleName3']]}
+                       );
+( ok(!$r->success,"Object registration correctly failed with identical articlename at same level of XML")
+ or diag("Object registration should have failed with identical articleName at same XML level by non-identical hasas, but didn't: ".$r->message));
+
+
+# Test  Should end up with identical articleName at same level and therefore fail (by double non-identical HASs)
+$r = $C->registerObjectClass(objectType => "Rubbish2",
+                description => "a human-readable description of the object",
+				contactEmail => 'your at email.address',
+                authURI => "test.suite.com",
+			    Relationships => {
+					ISA => [
+						['Object', '']],
+					HAS => [
+						['Integer', 'articleName3'],
+						['Object', 'articleName3']]}
+                       );
+( ok(!$r->success,"Object registration correctly failed with identical articlename at same level of XML")
+ or diag("Object registration should have failed with identical articleName at same XML level by identical hass, but didn't: ".$r->message));
+
+# Test  Should end up with identical articleName at same level and therefore fail (by identical HAS/HASA)
 $r = $C->registerObjectClass(objectType => "Rubbish2",
                 description => "a human-readable description of the object",
 				contactEmail => 'your at email.address',
                 authURI => "test.suite.com",
 			    Relationships => {
 					ISA => [
-						['Rubbish', 'article1']],
+						['Object', '']],
 					HASA => [
+						['Object', 'articleName3']],
+					HAS =>  [
 						['Object', 'articleName3']]}
                        );
-( ok($r->success,"Object registration correctly failed with identical articlename at same level of XML")
- or diag("Object registration should have failed with identical articleName at same XML level, but didn't: ".$r->message));
+( ok(!$r->success,"Object registration correctly failed with identical articlename at same level of XML")
+ or diag("Object registration should have failed with identical articleName at same XML level by hasa/has, but didn't: ".$r->message));
 
 
-# Test 6
+# Test 
 $r = $C->deregisterObjectClass(objectType => "Rubbish");
 ( ok($r->success,"Object deregistration successful"))
 or diag("Object deregistration failure: ".$r->message) ;