在Perl中测试两个哈希键是否具有相同的结构

Question

我正在编写一个单元测试，需要检查两个哈希变量（哈希的哈希）的键结构是否相同。键值可以不同。哈希的深度是任意的。

看起来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() 值。然而，在我的情况下，最好的解决方案是不必在测试代码中更新结构。

我尝试使用 Data::Walk 遍历 %hash1 并检查每个键是否存在于 %hash2 中，但发现很难从 $Data::Walk::container 值中获取当前键。

有没有适合的比较工具的想法？

- Matti Lattu

Answer 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"
}   

这样我们就可以逐个弹出地获取两条路径及其值。还有一些方法需要使用，但都是明智的选择。请查看文档。

- zdim

Answer 2

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

- Håkon Hægland