use strict; use warnings; package T::Utils; use vars qw( $VERSION @ISA @EXPORT ); require Exporter; use Test::More; @ISA=qw(Exporter); $VERSION = '0.1'; @EXPORT = qw( generic_rv_test ); my $test = Test::More->builder; sub import { my($self) = shift; my $pack = caller; $test->exported_to($pack); $self->export_to_level(1, $self, @EXPORT); } sub _path_to_filename { my $file = shift @_; my ($vol, $dir, $key) = File::Spec->splitpath($file); return $key; } sub generic_rv_test { my $rv = shift; my $array_ref = shift; my @input_keys = sort @$array_ref; $array_ref = shift; my @known_deps = sort @$array_ref; my @used_by; my ($used_by_ok, $i); # sanity check input foreach my $input (@input_keys) { !(grep {$_ eq $input} @known_deps) or die "\@input_keys overlaps with \@known_deps\n"; } $test->ok(ref($rv) eq "HASH", "\$rv is a ref") or return; # check all input files and known deps correspond to an entry in rv map {$_ = _path_to_filename($_)} @input_keys; map {$_ =~ s|\\|\/|go} (@input_keys, @known_deps); $test->ok(exists $rv->{$_}, "$_ is in rv") foreach (@input_keys, @known_deps); # Check general properties of the keys foreach my $key (keys %$rv) { $test->ok(((exists($rv->{$key}{key}) && $key eq $rv->{$key}{key}) && (exists($rv->{$key}{file}) && $rv->{$key}{file} =~ /(?:^|[\/\\])$key$/) && (exists($rv->{$key}{type}) && $rv->{$key}{type} =~ /^(?:module|autoload|data|shared)$/)), "For $key: sub-key matches && file matches && type matches module|autoload|data|shared"); if (exists($rv->{$key}{used_by})) { @used_by = sort @{$rv->{$key}{used_by}}; if ($#used_by + 1 > 0) { $used_by_ok = 1; if ($#used_by + 1 > 1) { for ($i=0; $i<$#used_by; $i++) { if ($used_by[$i] eq $used_by[$i+1]) { # relies on @used_by being sorted earlier $used_by_ok = 0; last; } } } $test->ok($used_by_ok, "$key\'s used_by has no duplicates"); $used_by_ok = 1; foreach my $used_by (@used_by) { $used_by_ok &= exists($rv->{$used_by}); } $test->ok($used_by_ok, "All entries in $key\'s used_by are themselves described in \$rv"); } else { print "array length: $#used_by\n"; $test->ok(0, "$key\'s used_by exists and isn't empty"); } } else { $test->ok((grep {$_ eq $key} @input_keys) | ($key =~ m/Plugin/o), "used-by not defined so $key is one of the input files or is a plugin"); # THIS IS WHERE THE TEST FAILS DUE TO THE MISSING USED_BY INFORMATION } } } 1; __END__