[RFT 1/2] MMTests::Stat: replace List::BinarySearch

[Luis Chamberlain <mcgrof@kernel.org>]

List::BinarySearch is ancient and has a few issues:

  a) The project hasnt't received any updates since 2018
  b) It's licensed under GPLv1 or Artistica v1 license which are
     not compatible with GPLv2
  c) Some distributions don't carry a package for it

Debian in particular doesn't have it anymore. I looked at the code
and was bewildered with the amount of insane hacks to support ancient
versions of perl and to also support running our custom comparison
routine.

All the above challenges seem silly to deal with on users if we can
just implement what we need and call it a day. So let's do that, and
also add unit tests for mmtests while at it, setting a set of a few
examples we can easily grow.

While at it use SPDX license identifiers to simplify license clarity
just as we have in the kernel. The same SPDX tag is already upstream
on Linux. We can expand on this to keep things simpler later.

Signed-off-by: Luis Chamberlain <mcgrof@kernel.org>
---
 Makefile                        |  4 ++
 README.md                       |  5 +--
 bin/install-depends             |  1 -
 bin/lib/MMTests/BinarySearch.pm | 70 +++++++++++++++++++++++++++++++++
 bin/lib/MMTests/Stat.pm         |  4 +-
 compare-kernels.sh              |  5 ---
 t/0001-libs.t                   | 12 ++++++
 t/0002-binsearch.t              | 68 ++++++++++++++++++++++++++++++++
 8 files changed, 158 insertions(+), 11 deletions(-)
 create mode 100644 Makefile
 create mode 100644 bin/lib/MMTests/BinarySearch.pm
 create mode 100644 t/0001-libs.t
 create mode 100644 t/0002-binsearch.t

diff --git a/Makefile b/Makefile
new file mode 100644
index 000000000000..ac84750e9462
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,4 @@
+all test:
+
+test:
+	@prove -I bin/lib/ -r t
diff --git a/README.md b/README.md
index ae9b119d150d..98c5975e4197 100644
--- a/README.md
+++ b/README.md
@@ -44,9 +44,8 @@ $ ../../compare-kernels.sh --format html --output-dir /tmp/html > /tmp/html/inde
 The first step is optional. Some configurations are auto-generated from
 a template, particularly the filesystem-specific ones.
 
-Note that [`List::BinarySearch`](https://metacpan.org/pod/List::BinarySearch)
-and maybe even [`Math::Gradient`](https://metacpan.org/pod/Math::Gradient) may
-need to be installed from [CPAN](https://www.cpan.org/) for the reporting to
+Note that perhaps [`Math::Gradient`](https://metacpan.org/pod/Math::Gradient)
+may need to be installed from [CPAN](https://www.cpan.org/) for the reporting to
 work. Similarly, [`R`](https://www.r-project.org/) should be installed if
 attempting to highlight whether performance differences are statistically
 relevant.
diff --git a/bin/install-depends b/bin/install-depends
index e0052f274027..694084c2937e 100755
--- a/bin/install-depends
+++ b/bin/install-depends
@@ -61,7 +61,6 @@ my %package_map = (
 	"debian::xz"				=> "xz-utils",
 	"debian::zeromq-devel"			=> "libzmq3-dev",
 	"debian::zlib-devel"			=> "zlib1g-dev",
-	"debian::perl-List-BinarySearch"	=> "liblist-binarysearch-perl",
 	"debian::perl-GD"			=> "libgd-perl",
 	"debian::sysvinit-tools"		=> "sysvinit-utils",
 	"debian::gettext-runtime"		=> "gettext",
diff --git a/bin/lib/MMTests/BinarySearch.pm b/bin/lib/MMTests/BinarySearch.pm
new file mode 100644
index 000000000000..2189ab4176d5
--- /dev/null
+++ b/bin/lib/MMTests/BinarySearch.pm
@@ -0,0 +1,70 @@
+# Copyright Luis Chamberlain <mcgrof@kernel.org>, 2024
+# // SPDX-License-Identifier: GPL-2.0-or-later OR copyleft-next-0.3.1
+#
+# Simple List::BinarySearch numeric BinarySearch.pm replacement.
+#
+# This is a re-write of our own binary search, reducing the scope to support
+# only the spaceship "<=>" operator as that's all we need. We also provide tests
+# under t/*.t to ensure compatibility and a larger list of examples and test
+# cases.
+#
+# This uses perl v5.20 subroutine signatures to let us be pedantic about the
+# arguments used.
+
+package MMTests::BinarySearch;
+
+use strict;
+use warnings;
+use feature 'signatures';
+no warnings 'experimental::signatures';
+use Scalar::Util qw(looks_like_number);
+
+require Exporter;
+use vars qw (@ISA @EXPORT);
+
+@ISA    = qw(Exporter);
+@EXPORT = qw(&binsearch_pos_num &binsearch_range_num);
+
+sub binsearch_pos_num($target, $aref) {
+	die "Only numbers allowed" unless looks_like_number($target);
+	die "Expected an array reference!" unless ref $aref eq 'ARRAY';
+
+	my ($low, $high) = (0, scalar @{$aref});
+
+	while ($low < $high) {
+		my $mid = int(($low + $high) / 2);
+		my $result = $aref->[$mid] <=> $target;
+		if ($result < 0) {
+			$low = $mid + 1;
+		} else {
+			$high = $mid - 1;
+		}
+	}
+
+	return $low;
+}
+
+# Returns an inclusive range for both, if you only use one return
+# value, you consume the last value.
+sub binsearch_range_num ($low_target, $high_target, $aref) {
+	die "Only numbers allowed" unless looks_like_number($low_target);
+	die "Only numbers allowed" unless looks_like_number($high_target);
+	die "Expected an array reference!" unless ref $aref eq 'ARRAY';
+
+	my ($index_low, $index_high, $result, $aref_num_elements);
+
+	$aref_num_elements = scalar @$aref;
+
+	$index_low  = binsearch_pos_num($low_target, $aref);
+	$index_high = binsearch_pos_num($high_target, $aref);
+
+	$result = $index_high < $aref_num_elements ? $aref->[$index_high] <=> $high_target : 1;
+
+	if ($index_high == $aref_num_elements or $result > 0 and $index_high > 0) {
+		$index_high--;
+	}
+
+	return ($index_low, $index_high);
+}
+
+1;
diff --git a/bin/lib/MMTests/Stat.pm b/bin/lib/MMTests/Stat.pm
index 41e6b79267c9..bd06f92812ba 100644
--- a/bin/lib/MMTests/Stat.pm
+++ b/bin/lib/MMTests/Stat.pm
@@ -10,7 +10,7 @@ use MMTests::Report;
 use strict;
 use POSIX qw(floor);
 use FindBin qw($Bin);
-use List::BinarySearch qw(binsearch_range);
+use MMTests::BinarySearch qw(binsearch_range_num);
 use Scalar::Util qw(looks_like_number);
 
 @ISA    = qw(Exporter);
@@ -495,7 +495,7 @@ sub calc_samples {
 	} elsif ($high eq "max") {
 		$high = $dataref->[$elements - 1];
 	}
-	my ($lowidx, $highidx) = binsearch_range { $a <=> $b }  $low, $high, @{$dataref};
+	my ($lowidx, $highidx) = binsearch_range_num($low, $high, $dataref);
 	return $highidx - $lowidx + 1;
 }
 
diff --git a/compare-kernels.sh b/compare-kernels.sh
index 44a5ad25c744..d7cf1795cff8 100755
--- a/compare-kernels.sh
+++ b/compare-kernels.sh
@@ -68,11 +68,6 @@ if [ ! -t 1 ]; then
 	OUT=$(mktemp ~/.compare-kernel-XXXX.out)
 fi
 
-perldoc -l List::BinarySearch &>/dev/null
-if [ $? -ne 0 ]; then
-	install-depends perl-List-BinarySearch &> $OUT
-fi
-
 if [ "$FORMAT" = "html" ]; then
 	install-depends gnuplot &>> $OUT
 	install-depends perl-GD &>> $OUT
diff --git a/t/0001-libs.t b/t/0001-libs.t
new file mode 100644
index 000000000000..3f4e428ecaa3
--- /dev/null
+++ b/t/0001-libs.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use MMTests::BinarySearch;
+use Test::More;
+
+can_ok('MMTests::BinarySearch', 'binsearch_pos_num');
+can_ok('MMTests::BinarySearch', 'binsearch_range_num');
+
+done_testing();
diff --git a/t/0002-binsearch.t b/t/0002-binsearch.t
new file mode 100644
index 000000000000..aadd63ef7f20
--- /dev/null
+++ b/t/0002-binsearch.t
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use MMTests::BinarySearch qw(binsearch_pos_num);
+use MMTests::BinarySearch qw(binsearch_range_num);
+use Test::More;
+use Test::Exception;
+
+my @ints = (100, 200, 300, 400, 500);
+
+sub dummy_sub { return (1, 2, 3, 4); }
+
+sub test_binsearch_pos_num {
+
+	throws_ok {
+		binsearch_pos_num('a', [1, 2, 3]);
+	} qr/Only numbers allowed/, "binsearch_pos_num dies if a string is used as the first argument";
+
+	throws_ok {
+		binsearch_pos_num(3, "foo");
+	} qr/Expected an array reference!/, "binsearch_pos_num dies if the second argument is not an array ref";
+
+	my @empty_array = ();
+	is(binsearch_pos_num(1, \@empty_array), 0,
+		"an empty array means we should place the item at index 0, that was returned as expected");
+
+        is(binsearch_pos_num(100, \@ints), 0, "target 5 at position 0 as expected");
+        is(binsearch_pos_num(200, \@ints), 1, "target 200 found at position 1 as expected");
+};
+
+sub test_binsearch_range_num {
+	throws_ok {
+		binsearch_range_num('a', 'b', [1, 2, 3]);
+	} qr/Only numbers allowed/, "binsearch_range_num dies if a string is used as the first argument";
+
+	throws_ok {
+		binsearch_range_num(1, 'b', [1, 2, 3]);
+	} qr/Only numbers allowed/, "binsearch_range_num dies if a string is used as the second argument";
+
+	throws_ok {
+		binsearch_range_num(3, 2, "foo");
+	} qr/Expected an array reference!/, "binsearch_range_num dies if the third argument is not an array ref";
+
+	# is() will only grok the last value returned here
+	is(dummy_sub(), 4, "Testing the last element");
+
+	# These capture only the last value returned by binsearch_range_num()
+	# as it returns two values, only the last value is captured here.
+        is(binsearch_range_num(200, 500, [100,200,300,400]), 3, "binsearch_range_num: adjusts foir overshooting range");
+        is(binsearch_range_num(200, 500, \@ints), 3, "binsearch_range_num: adjusts foir overshooting range and calls variable");
+        is(binsearch_range_num(200, 350, [100,200,300,400]), 2, "binsearch_range_num: corret range when upper bound is in-bounds but not found");
+
+	# This tests both expected return values from binsearch_range_num()
+	is_deeply([binsearch_range_num(200, 500, [100, 200, 300, 400])], [1, 3], "binsearch_range_num: correct indices for 200 and 500");
+
+	is_deeply([binsearch_range_num(150, 350, [100, 200, 300, 400])], [1, 2], "give a proper low and high");
+	is_deeply([binsearch_range_num(50, 450, [100, 200, 300, 400])], [0, 3], "Low below, high above range: 50 to 450");
+
+	# This is an improvement in our implementation against List::BinarySearch
+	is_deeply([binsearch_range_num(10, 50, [100, 200, 300, 400])], [0, 0], "Both targets below range: 10 to 50");
+}
+
+test_binsearch_pos_num();
+test_binsearch_range_num();
+
+done_testing();
-- 
2.43.0