Testing that two hash keys have equal structures in Perl-CodePudding

I am writing a unit test where I have to check whether the key structures of the two hash variables (hashes of hashes) are identical. The key values can differ. The depth of the hashes is arbitary.

The Test::Deep appears to be ideal, but I can't figure out how to make the cmp_deeply ignore the values.

use Test::Deep;

my %hash1 = ( key1 => "foo", key2 => {key21 => "bar", key22 => "yeah"});
my %hash2 = ( key1 => "foo", key2 => {key21 => "bar", key22 => "wow"});

cmp_deeply(\%hash1, \%hash2, "This test should not fail");

outputs:

not ok 1 - This test should not fail
#   Failed test 'This test should not fail'
#   at demo.pl line 13.
# Compared $data->{"key2"}{"key22"}
#    got : 'yeah'
# expect : 'wow'

If a hash would have a known structure I could use a test variable with values ignore(). However, in my case the best solution would be that I wouldn't have to update the structure in the test code.

I tried traversing the %hash1 using Data::Walk and checking that each key exists in %hash2 but found difficult to get the current keys from the $Data::Walk::container value.

Any ideas for a suitable comparison tool?

CodePudding user response：

Here is an example of how you can do it manually:

use strict;
use warnings;
use experimental qw(signatures);
use Test::More;

{
    my %hash1 = ( key1 => "foo", key2 => {key21 => "bar", key22 => "yeah"});
    my %hash2 = ( key1 => "foo", key2 => {key21 => "bar", key22 => "wow"});
    ok(cmp_keys(\%hash1, \%hash2), "Hash keys identical");
}
done_testing();

sub cmp_keys( $hash1, $hash2 ) {
    my @keys1 = flatten_keys( $hash1 );
    my @keys2 = flatten_keys( $hash2 );
    return 0 if @keys1 != @keys2;
    for my $i (0..$#keys1) {
        return 0 if $keys1[$i] ne $keys2[$i];
    }
    return 1;
}

sub flatten_keys( $hash ) {
    my @keys;
    my $prefix = '';
    _flatten_keys( $hash, $prefix, \@keys);
    return sort @keys;
}

sub _flatten_keys ( $hash, $prefix, $keys) {
    # $; The subscript separator for multidimensional array emulation,
    #    default value is "\034" = 0x1C
    my $sep = $;;
    for my $key (keys %$hash) {
        if (ref $hash->{$key} eq "HASH") {
            _flatten_keys( $hash->{$key}, $prefix . $key . $sep, $keys );
        }
        push @$keys, $prefix . $key;
    }
}

CodePudding user response：

So it seems that you need to ignore the (final) leaves in these structures, otherwise compare them.

One way should then be to compare all paths to each leaf between the two structures, disregarding leaves themselves.^†

The module Data::Leaf::Walker can help with that, to generate arrays of paths to all leaves. Then those need be compared, and Test::Deep with its bag-comparison is just the tool.

use warnings;
use strict;
use feature 'say';

use Data::Leaf::Walker;
use Test::More qw(no_plan);
use Test::Deep;

my %h1 = (key1 => "foo", key2 => {key21 => "bar", key22 => "yeah"});
my %h2 = (key1 => "foo", key2 => {key21 => "bar", key22 => "wow"});

my $walker = Data::Leaf::Walker->new(\%h1);    

my @key_paths_1;
while ( my ($key_path, $value) = $walker->each ) {
    push @key_paths_1, $key_path;
    #say "[ @$key_path ] => $value"
}   

$walker = Data::Leaf::Walker->new(\%h2);

my @key_paths_2;
while ( my ($key_path, $value) = $walker->each ) {
    push @key_paths_2, $key_path;
    #say "[ @$key_path ] => $value"
}

# Now compare @key_paths_1 and @key_paths_2
# Order of arrayrefs in the top-level arrays doesn't matter
# but order of elements in each arrayref does 
cmp_bag(\@key_paths_1, \@key_paths_2, 'key-paths');

^† I can't think of anything that may be missed this way?