Проверка того, что два хэш-ключа имеют одинаковые структуры в Perl

#perl #testing #data-structures #hash

Вопрос:

Я пишу модульный тест, в котором мне нужно проверить, идентичны ли ключевые структуры двух хэш-переменных (хэши хэшей). Ключевые значения могут отличаться. Глубина хэшей является произвольной.

Test::Deep Кажется, что это идеально, но я не могу понять, как заставить cmp_deeply игнорировать значения.

 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");
 

выходы:

 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'
 

Если бы хэш имел известную структуру, я мог бы использовать тестовую переменную со значениями ignore() . Однако в моем случае лучшим решением было бы то, что мне не пришлось бы обновлять структуру в тестовом коде.

Я попытался обойти %hash1 использование Data::Walk и проверить, существует ли каждый ключ %hash2 , но обнаружил, что трудно получить текущие ключи из $Data::Walk::container значения.

Есть какие-нибудь идеи для подходящего инструмента сравнения?

Ответ №1:

Похоже, что вам нужно игнорировать листья в этих структурах, которые иначе сравниваются.

Затем можно сравнить все пути к листьям между двумя структурами, не обращая внимания на листья.

Модуль Data::Leaf::Walker может помочь в этом, чтобы генерировать массивы путей ко всем листьям. Тогда их нужно сравнить, и Test::Deep с его сумкой-сравнение-это просто инструмент.

 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');
 

Это печатает, как и ожидалось, ok 1 - key-paths . Изменение любого ключа приводит к not ok 1 ...


Как только мы перейдем к этому, я хотел бы упомянуть, что модуль предоставляет итератор

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

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

Таким образом, мы получаем оба пути и их значения, по одному за раз. Есть еще несколько, но хорошо подобранных методов. См.документы.

Ответ №2:

Вот пример того, как вы можете сделать это вручную:

 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 "34" = 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;
    }
}