Testing that two hash keys have equal structures in Perl

user_6617026 0
Viewed 110

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?

data-structures hash perl testing
2 Answers

It seems that you need to ignore the leaves in these structures, which are otherwise compared.

Then one can compare all paths to leaves between the two structures, disregarding the leaves.

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 @key_paths_h1 = Data::Leaf::Walker->new(\%h1)->keys;

my @key_paths_h2 = Data::Leaf::Walker->new(\%h2)->keys;

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

This prints as expected, ok 1 - key-paths. Changing any key ends up in not ok 1 ...

Once we're at it, I'd like to mention that the module provides an iterator

my $walker = Data::Leaf::Walker->new($data_structure_ref);

while ( my ($keys_path, $value) = $walker->each ) {
    say "[ @$keys_path ] => $value"
}

This way we get both paths and their values, one pop at a time. There's only a few more, but well chosen, methods. See docs.

user_46533790

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;
    }
}
user_21737730
Related