diff --git a/modules/Bio/EnsEMBL/Utils/Scalar.pm b/modules/Bio/EnsEMBL/Utils/Scalar.pm index e02fb59c18455ca4150bdebab025708380853170..3ed68f9dc4ff43be62ca6beb79ee760642389248 100644 --- a/modules/Bio/EnsEMBL/Utils/Scalar.pm +++ b/modules/Bio/EnsEMBL/Utils/Scalar.pm @@ -36,10 +36,16 @@ Bio::EnsEMBL::Utils::Scalar check_ref({}, 'ARRAY'); # Will return false check_ref($dba, 'Bio::EnsEMBL::DBSQL::DBAdaptor'); #Returns true if $dba is a DBAdaptor + # Returns true if all array contents are of the given type + check_array_contents([$dba], 'Bio::EnsEMBL::DBSQL::DBAdaptor'); + assert_ref([], 'ARRAY'); #Returns true assert_ref({}, 'ARRAY'); #throws an exception assert_ref($dba, 'Bio::EnsEMBL::Gene'); #throws an exception if $dba is not a Gene + # Throws an exception if all array contents are not of the given type + assert_array_contents([$dba], 'Bio::EnsEMBL::Gene'); #throws an exception if $dba is not a Gene + wrap_array([]); #Returns the same reference wrap_array($a); #Returns [$a] if $a was not an array wrap_array(undef); #Returns [] since incoming was undefined @@ -102,15 +108,15 @@ our %EXPORT_TAGS; our @EXPORT_OK; @EXPORT_OK = qw( - check_ref check_ref_can - assert_ref assert_ref_can assert_numeric assert_integer assert_boolean assert_strand assert_file_handle + check_ref check_ref_can check_array_contents check_hash_contents + assert_ref assert_ref_can assert_numeric assert_integer assert_boolean assert_strand assert_file_handle assert_array_contents assert_hash_contents wrap_array scope_guard split_array ); %EXPORT_TAGS = ( - assert => [qw(assert_ref assert_ref_can assert_integer assert_numeric assert_boolean assert_strand assert_file_handle)], - check => [qw(check_ref check_ref_can)], + assert => [qw(assert_ref assert_ref_can assert_integer assert_numeric assert_boolean assert_strand assert_file_handle assert_array_contents assert_hash_contents)], + check => [qw(check_ref check_ref_can check_array_contents check_hash_contents)], array => [qw/wrap_array split_array/], all => [@EXPORT_OK] ); @@ -195,6 +201,189 @@ sub assert_ref { return 1; } +=head2 assert_array_contents + + Arg [1] : ArrayRef references to check + Arg [2] : The type we expect + Arg [3] : The attribute name you are asserting; not required but allows + for more useful error messages to be generated. Defaults to + C<-Unknown->. + Description : A subroutine which checks to see if the given objects/refs are + what you expect. This behaves in an identical manner as + C<assert_ref> does works on an array ref of references + + You can turn assertions off by using the global variable + $Bio::EnsEMBL::Utils::Scalar::ASSERTIONS = 0 + Returntype : Boolean; true if we managed to get to the return + Example : assert_array_contents([[],[],[]], 'ARRAY'); + Exceptions : Throws is references argument is not an ArrayRef, also + if the expected type was not set and if the given reference + was not assignable to the expected value. + Status : Stable + +=cut + +sub assert_array_contents { + my ($array, $expected, $attribute_name) = @_; + return 1 unless $ASSERTIONS; + throw('No expected type given') if ! defined $expected; + $attribute_name ||= '-Unknown-'; + assert_ref($array, 'ARRAY', $attribute_name); + my $count = scalar(@{$array}); + for(my $i = 0; $i<$count; $i++) { + my $ref = $array->[$i]; + my $class = ref($ref); + throw("The given reference for attribute $attribute_name was undef (at position ${i})") unless defined $ref; + throw("Asking for the type of the attribute $attribute_name produced no type; check it is a reference (at position ${i})") unless $class; + if(blessed($ref)) { + throw("${attribute_name}'s type '${class}' is not an ISA of '${expected}' (at position ${i})") if ! $ref->isa($expected); + } + else { + throw("$attribute_name was expected to be '${expected}' but was '${class}' (at position ${i})") if $expected ne $class; + } + } + return 1; +} + +=head2 check_array_contents + + Arg [1] : ArrayRef references to check + Arg [2] : The type we expect + Arg [3] : The attribute name you are asserting; not required but allows + for more useful error messages to be generated. Defaults to + C<-Unknown->. + Description : A subroutine which checks to see if the given objects/refs are + what you expect. + Returntype : Boolean; true if all contents were as expected + Example : check_array_contents([[],[],[]], 'ARRAY'); + Exceptions : Thrown if no type was given + Status : Stable + +=cut + +sub check_array_contents { + my ($array, $expected, $attribute_name) = @_; + return 0 if ! check_ref($array, 'ARRAY'); + throw('No expected type given') if ! defined $expected; + my $contents_ok = 1; + my $count = scalar(@{$array}); + for(my $i = 0; $i<$count; $i++) { + my $ref = $array->[$i]; + if(!$ref) { + $contents_ok = 0; + last; + } + my $class = ref($ref); + if(!$class) { + $contents_ok = 0; + last; + } + if(blessed($ref)) { + if(! $ref->isa($expected)) { + $contents_ok = 0; + last; + } + } + elsif($expected ne $class) { + $contents_ok = 0; + last; + } + } + return $contents_ok; +} + +=head2 assert_hash_contents + + Arg [1] : HashRef references to check + Arg [2] : The type we expect + Arg [3] : The attribute name you are asserting; not required but allows + for more useful error messages to be generated. Defaults to + C<-Unknown->. + Description : A subroutine which checks to see if the given objects/refs are + what you expect. This behaves in an identical manner as + C<assert_ref> does works on a HashRef of references. Hash keys + are always Strings so do not need asserting. + + You can turn assertions off by using the global variable + $Bio::EnsEMBL::Utils::Scalar::ASSERTIONS = 0 + Returntype : Boolean; true if we managed to get to the return + Example : assert_hash_contents({a => [], b => []}, 'ARRAY'); + Exceptions : Throws is references argument is not an ArrayRef, also + if the expected type was not set and if the given reference + was not assignable to the expected value. + Status : Stable + +=cut + +sub assert_hash_contents { + my ($hash, $expected, $attribute_name) = @_; + return 1 unless $ASSERTIONS; + throw('No expected type given') if ! defined $expected; + $attribute_name ||= '-Unknown-'; + assert_ref($hash, 'HASH', $attribute_name); + my @keys = keys %{$hash}; + while(my $key = shift @keys) { + my $ref = $hash->{$key}; + my $class = ref($ref); + throw("The given reference for attribute $attribute_name was undef (with key ${key})") unless defined $ref; + throw("Asking for the type of the attribute $attribute_name produced no type; check it is a reference (with key ${key})") unless $class; + if(blessed($ref)) { + throw("${attribute_name}'s type '${class}' is not an ISA of '${expected}' (with key ${key})") if ! $ref->isa($expected); + } + else { + throw("$attribute_name was expected to be '${expected}' but was '${class}' (with key ${key})") if $expected ne $class; + } + } + return 1; +} + +=head2 check_hash_contents + + Arg [1] : HashRef references to check + Arg [2] : The type we expect + Arg [3] : The attribute name you are asserting; not required but allows + for more useful error messages to be generated. Defaults to + C<-Unknown->. + Description : A subroutine which checks to see if the given objects/refs are + what you expect. + Returntype : Boolean; true if all contents were as expected + Example : check_hash_contents({a => [], b => []}, 'ARRAY'); + Exceptions : Thrown if no type was given + Status : Stable + +=cut + +sub check_hash_contents { + my ($hash, $expected, $attribute_name) = @_; + throw('No expected type given') if ! defined $expected; + return 0 if ! check_ref($hash, 'HASH'); + my $contents_ok = 1; + my @keys = keys %{$hash}; + while(my $key = shift @keys) { + my $ref = $hash->{$key}; + if(!$ref) { + $contents_ok = 0; + last; + } + my $class = ref($ref); + if(!$class) { + $contents_ok = 0; + last; + } + if(blessed($ref)) { + if(! $ref->isa($expected)) { + $contents_ok = 0; + last; + } + } + elsif($expected ne $class) { + $contents_ok = 0; + last; + } + } + return $contents_ok; +} + =head2 wrap_array() Arg : The reference we want to wrap in an array @@ -453,7 +642,7 @@ sub assert_file_handle { Arg [2] : ArrayRef The array to split Description : Takes an array of values and splits the array into multiple arrays where the maximum size of each array is as specified - Example : + Example : my $split_arrays = split_array($large_array, 10); Returntype : ArrayRef of ArrayRefs where each element is a split list =cut diff --git a/modules/t/utilsScalar.t b/modules/t/utilsScalar.t index 18547fb0d13366a2ae3b90e17f01e40e122e0976..64a89621d9198c327ba986948d21afb11a359942 100644 --- a/modules/t/utilsScalar.t +++ b/modules/t/utilsScalar.t @@ -10,6 +10,8 @@ use IO::Handle; my $gene = Bio::EnsEMBL::IdMapping::TinyGene->new_fast([]); +# Assert ref check + dies_ok { assert_ref(undef, 'ARRAY') } 'Undef value results in death'; dies_ok { assert_ref([], undef) } 'Undef assertion results in death'; throws_ok { assert_ref('string', 'ARRAY') } qr/produced no type/, 'Passing in a Scalar means death'; @@ -41,6 +43,71 @@ ok ( check_ref({}, 'HASH'), 'Ref of a hash should be a HASH'); ok ( check_ref($gene, 'Bio::EnsEMBL::IdMapping::TinyFeature'), 'Ref of a gene should be a TinyFeature'); ok ( check_ref($gene, 'Bio::EnsEMBL::IdMapping::TinyGene'), 'Ref of a gene should be a TinyGene'); +# Array assertions +dies_ok { assert_array_contents([undef], 'ARRAY') } 'ARRAY: Undef value results in death'; +dies_ok { assert_array_contents([], undef) } 'ARRAY: Undef assertion results in death'; +throws_ok { assert_array_contents(['string'], 'ARRAY') } qr/produced no type/, 'ARRAY: Passing in a Scalar means death'; +dies_ok { assert_array_contents([\''], 'ARRAY') } 'ARRAY: Ref of a Scalar is not an ARRAY so death'; +dies_ok { assert_array_contents([$gene], 'CODE') } 'ARRAY: TinyGene object is not a CODE so death'; +dies_ok { assert_array_contents([$gene], 'Bio::EnsEMBL::Feature') } 'ARRAY: TinyGene object is not a Bio::EnsEMBL::Feature so death'; +dies_ok { assert_array_contents([$gene], 'HASH') } 'ARRAY: TinyGene is blessed so we expect false even though it is a HASH'; + +lives_ok { assert_array_contents([\''], 'SCALAR') } 'ARRAY: Ref of a Scalar should be a SCALAR'; +lives_ok { assert_array_contents([[]], 'ARRAY') } 'ARRAY: Ref of an array should be a ARRAY'; +lives_ok { assert_array_contents([{}], 'HASH') } 'ARRAY: Ref of a hash should be a HASH'; +lives_ok { assert_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyFeature') } 'ARRAY: Ref of a gene should be a TinyFeature'; +lives_ok { assert_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyGene') } 'ARRAY: Ref of a gene should be a TinyGene'; +lives_ok { assert_array_contents([], 'Bio::EnsEMBL::IdMapping::TinyGene') } 'ARRAY: Empty array means no death'; + +# Array checks +dies_ok { check_array_contents([], undef) } 'ARRAY: Undef for assertion in check_array_contents results in death'; + +ok(! check_array_contents([undef], 'ARRAY'), 'ARRAY: Undef value returns false'); +ok(! check_array_contents(['string'], 'ARRAY'), 'ARRAY: Passing in a Scalar means returns false'); +ok(! check_array_contents([\''], 'ARRAY'), 'ARRAY: Ref of a Scalar is not an ARRAY so returns false'); +ok(! check_array_contents([$gene], 'CODE'), 'ARRAY: TinyGene object is not a CODE so returns false'); +ok(! check_array_contents([$gene], 'Bio::EnsEMBL::Feature'), 'ARRAY: TinyGene object is not a Bio::EnsEMBL::Feature so returns false'); +ok(! check_array_contents([$gene], 'HASH'), 'ARRAY: TinyGene is blessed so we expect false even though it is a HASH'); + +ok ( check_array_contents([\''], 'SCALAR'), 'ARRAY: Ref of a Scalar should be a SCALAR'); +ok ( check_array_contents([[]], 'ARRAY'), 'ARRAY: Ref of an array should be a ARRAY'); +ok ( check_array_contents([{}], 'HASH'), 'ARRAY: Ref of a hash should be a HASH'); +ok ( check_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyFeature'), 'ARRAY: Ref of a gene should be a TinyFeature'); +ok ( check_array_contents([$gene], 'Bio::EnsEMBL::IdMapping::TinyGene'), 'ARRAY: Ref of a gene should be a TinyGene'); + +# Hash assertions +dies_ok { assert_hash_contents({a => undef}, 'ARRAY') } 'HASH: Undef value results in death'; +dies_ok { assert_hash_contents({}, undef) } 'HASH: Undef assertion results in death'; +throws_ok { assert_hash_contents({ a => 'string'}, 'ARRAY') } qr/produced no type/, 'HASH: Passing in a Scalar means death'; +dies_ok { assert_hash_contents({a => \''}, 'ARRAY') } 'HASH: Ref of a Scalar is not an ARRAY so death'; +dies_ok { assert_hash_contents({a => $gene}, 'CODE') } 'HASH: TinyGene object is not a CODE so death'; +dies_ok { assert_hash_contents({a => $gene}, 'Bio::EnsEMBL::Feature') } 'HASH: TinyGene object is not a Bio::EnsEMBL::Feature so death'; +dies_ok { assert_hash_contents({a => $gene}, 'HASH') } 'HASH: TinyGene is blessed so we expect false even though it is a HASH'; + +lives_ok { assert_hash_contents({a => \'' }, 'SCALAR') } 'HASH: Ref of a Scalar should be a SCALAR'; +lives_ok { assert_hash_contents({a => []}, 'ARRAY') } 'HASH: Ref of an array should be a ARRAY'; +lives_ok { assert_hash_contents({a => {}}, 'HASH') } 'HASH: Ref of a hash should be a HASH'; +lives_ok { assert_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyFeature') } 'HASH: Ref of a gene should be a TinyFeature'; +lives_ok { assert_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyGene') } 'HASH: Ref of a gene should be a TinyGene'; +lives_ok { assert_hash_contents({}, 'Bio::EnsEMBL::IdMapping::TinyGene') } 'HASH: Empty array means no death'; + +# Hash checks +dies_ok { check_hash_contents({}, undef) } 'HASH: Undef for assertion in check_hash_contents results in death'; + +ok(! check_hash_contents({a => undef}, 'ARRAY'), 'HASH: Undef value returns false'); +ok(! check_hash_contents({a => 'string'}, 'ARRAY'), 'HASH: Passing in a Scalar means returns false'); +ok(! check_hash_contents({a => \''}, 'ARRAY'), 'HASH: Ref of a Scalar is not an ARRAY so returns false'); +ok(! check_hash_contents({a => $gene}, 'CODE'), 'HASH: TinyGene object is not a CODE so returns false'); +ok(! check_hash_contents({a => $gene}, 'Bio::EnsEMBL::Feature'), 'HASH: TinyGene object is not a Bio::EnsEMBL::Feature so returns false'); +ok(! check_hash_contents({a => $gene}, 'HASH'), 'HASH: TinyGene is blessed so we expect false even though it is a HASH'); + +ok ( check_hash_contents({a => \''}, 'SCALAR'), 'HASH: Ref of a Scalar should be a SCALAR'); +ok ( check_hash_contents({a => []}, 'ARRAY'), 'HASH: Ref of an array should be a ARRAY'); +ok ( check_hash_contents({a => {}}, 'HASH'), 'HASH: Ref of a hash should be a HASH'); +ok ( check_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyFeature'), 'HASH: Ref of a gene should be a TinyFeature'); +ok ( check_hash_contents({a => $gene}, 'Bio::EnsEMBL::IdMapping::TinyGene'), 'HASH: Ref of a gene should be a TinyGene'); + + #Array Wrapping my $undef_ref = undef; @@ -85,7 +152,10 @@ throws_ok { assert_integer(undef) } qr/undefined/, 'Passing in undefined scalar dies_ok { assert_integer(bless(1, 'Brian'), 'met')} 'Passing in a blessed scalar means death'; dies_ok { assert_integer('hello')} 'Passing in a String scalar means death'; dies_ok { assert_integer({})} 'Passing in a HashRef means death'; -dies_ok { assert_integer(1E-10) } 'Passing in scientific notation numeric means death'; +dies_ok { assert_integer(1E-10) } 'Passing in negative scientific notation numeric means death'; +lives_ok { assert_integer(1E10) } 'Passing in positive scientific notation numeric means lives'; +lives_ok { assert_integer(1_000) } 'Separators means lives'; +lives_ok { assert_integer('2') } 'A string numeric is ok'; dies_ok { assert_integer(1.2) } 'Passing in floating point means death'; lives_ok { assert_integer(1) } 'Passing in integer means lives'; @@ -179,6 +249,8 @@ close($_) for ($scalar_fh, $other_scalar_fh); lives_ok {assert_integer([]) } 'Assertions off; [] returns true for assert_integer()'; lives_ok {assert_numeric([]) } 'Assertions off; [] returns true for assert_numeric()'; lives_ok {assert_ref_can([], 'wibble')} 'Assertions off; [] returns true for assert_ref_can()'; + lives_ok {assert_array_contents([{}], 'wibble')} 'Assertions off; [{}] returns true for assert_array_contents() when asserting type "wibble"'; + lives_ok {assert_hash_contents({a => {}}, 'wibble')} 'Assertions off; {a => {}} returns true for assert_hash_contents() when asserting type "wibble"'; } dies_ok { assert_ref([], 'HASH') } 'Assertions back on; [] is not a HASH';