Merge pull request #11556 from ppentchev/pp-308-perl

Add Peter Pentchev's Perl solutions to #308

2 files changed, 88 insertions, 0 deletions

diff --git a/challenge-308/ppentchev/perl5/ch-1.t b/challenge-308/ppentchev/perl5/ch-1.t
new file mode 100644
index 0000000000..3778aaee35
--- /dev/null
+++ b/challenge-308/ppentchev/perl5/ch-1.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl5
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+use v5.016;
+use strict;
+use warnings;
+
+use Test::More;
+
+plan tests => 1;
+
+use constant T_COUNT_UNIQUE => [
+	[
+		["perl", "weekly", "challenge"],
+		["raku", "weekly", "challenge"],
+		2,
+	],
+	[
+		["perl", "raku", "python"],
+		["python", "java"],
+		1,
+	],
+	[
+		["guest", "contribution"],
+		["fun", "weekly", "challenge"],
+		0,
+	],
+];
+
+sub count_common_hash_assume_unique($$) {
+        my ($str1, $str2) = @_;
+
+        my %set1 = map { ($_, 1) } @{$str1};
+        scalar grep { defined $set1{$_} } @{$str2}
+}
+
+subtest hash_assume_unique => sub {
+	plan tests => scalar @{T_COUNT_UNIQUE()};
+	for my $tcase (@{T_COUNT_UNIQUE()}) {
+        	my ($str1, $str2, $expected) = @{$tcase};
+        	is count_common_hash_assume_unique($str1, $str2), $expected;
+	}
+};
diff --git a/challenge-308/ppentchev/perl5/ch-2.t b/challenge-308/ppentchev/perl5/ch-2.t
new file mode 100644
index 0000000000..9763423556
--- /dev/null
+++ b/challenge-308/ppentchev/perl5/ch-2.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl5
+# SPDX-FileCopyrightText: Peter Pentchev <roam@ringlet.net>
+# SPDX-License-Identifier: BSD-2-Clause
+
+use v5.016;
+use strict;
+use warnings;
+
+use Test::More;
+
+plan tests => 1;
+
+use constant T_XOR => [
+	[
+		[1, 2, 3],
+		1,
+		[1, 0, 2, 1],
+	],
+	[
+		[6, 2, 7, 3],
+		4,
+		[4, 2, 0, 7, 4],
+	],
+];
+
+sub decode_xor($$) {
+        my ($encoded, $current) = @_;
+        my @res;
+
+        for my $val (@{$encoded}) {
+                push @res, $current;
+                $current ^= $val;
+        }
+        push @res, $current;
+        @res
+}
+
+subtest xor => sub {
+	plan tests => scalar @{T_XOR()};
+	for my $tcase (@{T_XOR()}) {
+        	my ($encoded, $initial, $expected) = @{$tcase};
+        	is decode_xor($encoded, $initial), @{$expected};
+	}
+};