t/25-apply.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4
   5 use Test::More tests => 6;
   6 use Test::NoWarnings;
   7 use Data::Dump 'pp';
   8 use List::Util qw(first min max);
   9 use List::MoreUtils qw(uniq firstidx);
  10 use POSIX qw(ceil);
  11
  12 BEGIN { use_ok('List::Index' => 'rangematch'); }
  13
  14 {
  15         my $rows = rand(100) ** 2;
  16         my %options = (pagesize => 50, context => 4, length => 4);
  17
  18         # generate random test data
  19         my @values;
  20         for (0 .. $rows) {
  21                 my $string = join '', map {
  22                         # random character (a-z or random digit)
  23                         chr((int rand(27) || rand(10)-ord('0')*0) + ord('a')-1)
  24                 } 0 .. rand($options{length});
  25                 push @values, $string
  26                         unless @values and $values[-1] eq $string;
  27         }
  28         @values = uniq @values;
  29
  30         # find ranges for generated values
  31         my $ranges = eval { List::Index->new(\%options)->ranges(\@values) };
  32         my $failure = $@ || ref $ranges ne 'ARRAY' && (
  33                 $ranges ? 'returned ranges not an array ref' : 'no ranges returned'
  34         );
  35         my $setup = scalar(@values)." rows at $options{pagesize}±$options{context}";
  36         ok(!$failure, "ranges for $setup")
  37                 or BAIL_OUT($failure);
  38
  39         # apply found ranges
  40         my @matches = eval {
  41                 my @contents;
  42                 for (@$ranges) {
  43                         my $match = rangematch($_);
  44                         defined $match or die "Invalid range '$_'";
  45                         push @contents, [ grep { /$match/ } @values ];
  46                 }
  47                 return @contents;
  48         };
  49         ok(first(sub {$_}, @matches), sprintf 'match %d pages', scalar(@$ranges))
  50                 or BAIL_OUT($@);
  51
  52         # debugging report of data relevant to the first page with given size
  53         sub pagecontext {
  54                 my ($size) = @_;
  55                 my $page = firstidx sub { @$_ == $size }, @matches;
  56                 for (max($page - 1, 0) .. min($page + 1)) {
  57                         my $pagevals = $matches[$_];
  58                         printf("# page #%d [%s] (%d): %s\n",
  59                                 $_, $ranges->[$_], scalar(@$pagevals),
  60                                 join(' ', sort @$pagevals),
  61                         );
  62                 }
  63         }
  64
  65         # analyse final page sizes
  66         my $pagesize = scalar(@values) / scalar(@matches);
  67         if (my $limit = ceil($pagesize) + $options{context}) {
  68                 my $largest = max(map { scalar @$_ } @matches);
  69                 cmp_ok($largest, '<=', $limit, "page sizes under $limit")
  70                         or pagecontext($largest);
  71         }
  72         if (my $limit = int($pagesize) - $options{context}) {
  73                 my $smallest = min(map {scalar @$_} @matches);
  74                 cmp_ok($smallest, '>=', $limit, "page sizes over $limit")
  75                         or pagecontext($smallest);
  76         }
  77 }
  78