[pve-devel] [PATCH common v4 2/5] tools: add is_deeply

[Dominik Csapak <d.csapak@proxmox.com>]

to compare nested hashes/lists and scalar values recursively.
Also includes some tests

Signed-off-by: Dominik Csapak <d.csapak@proxmox.com>
---
changes from v3:
* rename the testfile is_deeply_test to match Makefile
 src/PVE/Tools.pm       |  31 +++++++++
 test/Makefile          |   1 +
 test/is_deeply_test.pl | 142 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 174 insertions(+)
 create mode 100755 test/is_deeply_test.pl

diff --git a/src/PVE/Tools.pm b/src/PVE/Tools.pm
index b3af2c6..766c809 100644
--- a/src/PVE/Tools.pm
+++ b/src/PVE/Tools.pm
@@ -2150,4 +2150,35 @@ sub get_file_hash {
     return lc($digest);
 }
 
+# compare two perl variables recursively, so this works for scalars, nested
+# hashes and nested arrays
+sub is_deeply {
+    my ($a, $b) = @_;
+
+    return 0 if defined($a) != defined($b);
+    return 1 if !defined($a); # both are undef
+
+    my ($ref_a, $ref_b) = (ref($a), ref($b));
+
+    # scalar case
+    return 0 if !$ref_a && !$ref_b && "$a" ne "$b";
+
+    # different types, ok because ref never returns undef, only empty string
+    return 0 if $ref_a ne $ref_b;
+
+    if ($ref_a eq 'HASH') {
+	return 0 if scalar(keys $a->%*) != scalar(keys $b->%*);
+	for my $opt (keys $a->%*) {
+	    return 0 if !is_deeply($a->{$opt}, $b->{$opt});
+	}
+    } elsif ($ref_a eq 'ARRAY') {
+	return 0 if scalar($a->@*) != scalar($b->@*);
+	for (my $i = 0; $i < $a->@*; $i++) {
+	    return 0 if !is_deeply($a->[$i], $b->[$i]);
+	}
+    }
+
+    return 1;
+}
+
 1;
diff --git a/test/Makefile b/test/Makefile
index 82f40ab..b0de1a5 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -6,6 +6,7 @@ TESTS = lock_file.test			\
 	format_test.test		\
 	section_config_test.test	\
 	api_parameter_test.test		\
+	is_deeply_test.test		\
 
 all:
 
diff --git a/test/is_deeply_test.pl b/test/is_deeply_test.pl
new file mode 100755
index 0000000..f546b36
--- /dev/null
+++ b/test/is_deeply_test.pl
@@ -0,0 +1,142 @@
+#!/usr/bin/perl
+
+use lib '../src';
+
+use strict;
+use warnings;
+
+use Test::More;
+use PVE::Tools;
+
+my $tests = [
+    {
+	name => 'both undef',
+	a => undef,
+	b => undef,
+	expected => 1,
+    },
+    {
+	name => 'empty string',
+	a => '',
+	b => '',
+	expected => 1,
+    },
+    {
+	name => 'empty string and undef',
+	a => '',
+	b => undef,
+	expected => 0,
+    },
+    {
+	name => '0 and undef',
+	a => 0,
+	b => undef,
+	expected => 0,
+    },
+    {
+	name => 'equal strings',
+	a => 'test',
+	b => 'test',
+	expected => 1,
+    },
+    {
+	name => 'unequal strings',
+	a => 'test',
+	b => 'tost',
+	expected => 0,
+    },
+    {
+	name => 'equal numerics',
+	a => 42,
+	b => 42,
+	expected => 1,
+    },
+    {
+	name => 'unequal numerics',
+	a => 42,
+	b => 420,
+	expected => 0,
+    },
+    {
+	name => 'equal arrays',
+	a => ['foo', 'bar'],
+	b => ['foo', 'bar'],
+	expected => 1,
+    },
+    {
+	name => 'equal empty arrays',
+	a => [],
+	b => [],
+	expected => 1,
+    },
+    {
+	name => 'unequal arrays',
+	a => ['foo', 'bar'],
+	b => ['bar', 'foo'],
+	expected => 0,
+    },
+    {
+	name => 'equal empty hashes',
+	a => { },
+	b => { },
+	expected => 1,
+    },
+    {
+	name => 'equal hashes',
+	a => { foo => 'bar' },
+	b => { foo => 'bar' },
+	expected => 1,
+    },
+    {
+	name => 'unequal hashes',
+	a => { foo => 'bar' },
+	b => { bar => 'foo' },
+	expected => 0,
+    },
+    {
+	name => 'equal nested hashes',
+	a => {
+	    foo => 'bar',
+	    bar => 1,
+	    list => ['foo', 'bar'],
+	    properties => {
+		baz => 'boo',
+	    },
+	},
+	b => {
+	    foo => 'bar',
+	    bar => 1,
+	    list => ['foo', 'bar'],
+	    properties => {
+		baz => 'boo',
+	    },
+	},
+	expected => 1,
+    },
+    {
+	name => 'unequal nested hashes',
+	a => {
+	    foo => 'bar',
+	    bar => 1,
+	    list => ['foo', 'bar'],
+	    properties => {
+		baz => 'boo',
+	    },
+	},
+	b => {
+	    foo => 'bar',
+	    bar => 1,
+	    list => ['foo', 'bar'],
+	    properties => {
+		baz => undef,
+	    },
+	},
+	expected => 0,
+    },
+];
+
+for my $test ($tests->@*) {
+    is (PVE::Tools::is_deeply($test->{a}, $test->{b}), $test->{expected}, $test->{name});
+}
+
+done_testing();
-- 
2.30.2