25-apply.t

diff --git a/t/25-apply.t b/t/25-apply.t
new file mode 100644 (file)
index 0000000..a006c0e
--- /dev/null
+++ b/t/25-apply.t
@@ -0,0 +1,79 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use Test::NoWarnings;
+use Data::Dump 'pp';
+use List::Util qw(first min max);
+use List::MoreUtils qw(uniq firstidx);
+
+BEGIN { use_ok('List::Index' => 'rangematch'); }
+
+{
+       my %options = (pagesize => 10, context => 5);
+
+       # generate random test data
+       my @values;
+       for (0 .. rand 1000) {
+               my $string = join '', map {
+                       # random character (a-z or random digit)
+                       chr((int rand(27) || rand(10)-ord('0')*0) + ord('a')-1)
+               } 0 .. rand(16);
+               push @values, $string
+                       unless @values and $values[-1] eq $string;
+       }
+       @values = uniq @values;
+
+       # find ranges for generated values
+       my $ranges = eval {
+               my $index = List::Index->new(\@values);
+               $index->ranges(\%options);
+       };
+       my $failure = $@ || ref $ranges ne 'ARRAY' && (
+               $ranges ? 'returned ranges not an array ref' : 'no ranges returned'
+       );
+       my $setup = scalar(@values)." rows at $options{pagesize}±$options{context}";
+       ok(!$failure, "ranges for $setup")
+               or BAIL_OUT($failure);
+
+       # apply found ranges
+       my @matches = eval {
+               my @contents;
+               for (@$ranges) {
+                       my $match = rangematch($_);
+                       defined $match or die "Invalid range '$_'";
+                       push @contents, [ grep { /$match/ } @values ];
+               }
+               return @contents;
+       };
+       ok(first(sub {$_}, @matches), sprintf 'match %d pages', scalar(@$ranges))
+               or BAIL_OUT($@);
+
+       # debugging report of data relevant to the first page with given size
+       sub pagecontext {
+               my ($size) = @_;
+               my $page = firstidx sub { @$_ == $size }, @matches;
+               for (max($page - 1, 0) .. min($page + 1)) {
+                       my $pagevals = $matches[$_];
+                       printf("# page #%d [%s] (%d): %s\n",
+                               $_, $ranges->[$_], scalar(@$pagevals),
+                               join(' ', sort @$pagevals),
+                       );
+               }
+       }
+
+       # analyse final page sizes
+       if (my $limit = $options{pagesize} + $options{context}) {
+               my $largest = max(map { scalar @$_ } @matches);
+               cmp_ok($largest, '<=', $limit, "page sizes under $limit")
+                       or pagecontext($largest);
+       }
+#      pop @matches;
+       if (my $limit = $options{pagesize} - $options{context}) {
+               my $smallest = min(map {scalar @$_} @matches);
+               cmp_ok($smallest, '>=', $limit, "page sizes over $limit")
+                       or pagecontext($smallest);
+       }
+}
+