The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w
$|++;

use strict;

# usage: specify the types a range is - the range must NOT be
# of any type you do not mention (except NRR::Range), so e.g.:
#  check_type($range, 'Simple, Trivial' );
# checks for !Empty, !Compound. a TrivialRange should match. so:
#  check_type( $trivial, 'Trivial' ) -> returns false (also a Simple)
#  check_type( $trivial, 'Simple' ) -> returns false (also a Trivial)
# also note check_type($r, "foo bar") == check_type($r, qw ( foo bar ) );
sub check_type {
  my ($range, @yes_types) = @_;
  @yes_types = map { s/^\s*//; s/\s*$//; $_ } map { split /,/, $_ } @yes_types;
  my %types;
  $types{$_} = 0  for  ( qw ( Empty Simple Trivial Compound ) );
  $types{$_} = 1  for  ( '', map { s/^(.)/\u$1/; $_ } @yes_types );
  my $ret = 1;
  foreach my $key (keys %types) {
    my $type = $key;
    if ( $range->isa( "Number::Range::Regex::${type}Range" ) != $types{$key} ) {
      warn "check_type: error: range is not a ${type}Range";
      $ret = 0;
    }
  }
  return $ret;
}

sub strip_regex_bloat {
  my $str = (@_);
  # depending on the version of perl, we may get one or more
  # (?-xism: ... ) wrappers around the regex
  while($str =~ /^\(\?\-xism\:/) {
    $str = substr($str, 8, -1)
  }
  return $str;
}

sub test_rangeobj_exhaustive {
  my ($tr) = @_;
  my $regex = $tr->regex();
  die "cannot exhaustively test infinite/compound ranges"  if  !defined $tr->{min} or !defined $tr->{max};
  return  if  ($tr->{min}-1) =~ /^$regex$/;
  for(my $c=$tr->{min}; $c<=$tr->{max}; ++$c) {
    if("$c" !~ /^$regex$/) {
      warn "failed (exhaustive) test tr($tr->{min}, $tr->{max}, $tr->regex}) - failed $c =~ /^$regex$/\n";
      return;
    }
  }
  return  if  ($tr->{max}+1) =~ /^$regex$/;
  return $tr;
}

sub test_range_random {
  my($min, $max, $trials, $verbose, $opts) = @_;
  die "cannot randomly test infinite/compound ranges"  if  !defined $min or !defined $max;
  my $range = regex_range($min, $max);
  return  unless  $range;
  my $spread = $max - $min;
  my $test_start_min = $min - int( $spread / 2 );
  $test_start_min = 0  if  $test_start_min < 0;
  my @tests;
  return  if  ($min-1) =~ /^$range$/;
  return  if  $min !~ /^$range$/;
  for(my $trial=0; $trial<$trials; $trial++) {
    my $c = $test_start_min + int rand $spread * 2;
    push @tests, $c  if  $verbose;
    my $desired = ($c >= $min) && ($c <= $max);
    my $actual  = "$c" =~ /^$range$/;
    unless( ($desired and $actual) or (!$desired && !$actual) ) {
      warn "failed (random) test $c =~ /^$range$/\n";
      return;
    }
  }
  return  if  $max !~ /^$range$/;
  return  if  ($max+1) =~ /^$range$/;
  warn "\ninfo (***safe to ignore***): range $range seems to have worked for [$min..$max] in $trials trials (/***safe to ignore***)\n"  if  $verbose;
#  warn "\ninfo (***safe to ignore***): range $range seems to have worked for [$min..$max] in $trials trials. tested: ".join(", ", sort @tests)." (/***safe to ignore***)\n"  if  $verbose;
  return $range; 
}

sub test_range_partial {
  my $opts = ref($_[-1]) eq 'HASH' ? pop @_ : {};
  my($min, $max, @tranges) = @_;
  my $range = regex_range($min, $max);
  return  unless  $range;
  return  if  defined $min && ($min-1) =~ /^$range$/;
  return  if  defined $min && $min !~ /^$range$/;
  foreach my $test (@tranges) { 
    my ($tmin, $tmax) = ($test->[0], $test->[1]);
    for(my $c=$tmin; $c<=$tmax; ++$c) {
      my $desired = 1;
      $desired = $desired && ($c >= $min)  if  defined $min;
      $desired = $desired && ($c <= $max)  if  defined $max;
      my $actual  = "$c" =~ /^$range$/;
      unless( ($desired and $actual) or (!$desired && !$actual) ) {
        warn "failed (partial range) test $c =~ /^$range$/, min: $min, max: $max\n";
        return;
      }
    }
  }
  return  if  defined $max && $max !~ /^$range$/;
  return  if  defined $max && ($max+1) =~ /^$range$/;
  return $range; 
}

sub test_range_exhaustive {
  my($min, $max, $opts) = @_;
  die "cannot exhaustively test infinite/compound ranges"  if  !defined $min or !defined $max;
  my $range = regex_range($min, $max);
  return  unless  $range;
  return  if  ($min-1) =~ /^$range$/;
  for(my $c=$min; $c<=$max; ++$c) {
    if("$c" !~ /^$range$/) {
      warn "failed (exhaustive) test $c =~ /^$range$/, min: $min, max: $max\n";
      return;
    }
  }
  return  if  ($max+1) =~ /^$range$/;
  return $range;
}

sub test_all_ranges_exhaustively {
  my ($min_min, $max_max) = @_;
  for my $start ($min_min..$max_max) {
    for my $end ($start..$max_max) {
      my $range = test_range_exhaustive( $start, $end );
      return unless $range;
    }
  }
  return 1;
}

sub test_range_regex {
  my($min, $max, $regex, $opts) = @_;
  die "cannot test infinite/compound ranges"  if  !defined $min or !defined $max;
  return  unless  $regex;
  return  if  ($min-1) =~ /^$regex$/;
  for(my $c=$min; $c<=$max; ++$c) {
    if("$c" !~ /^$regex$/) {
      warn "failed (range_regex) test $c =~ /^$regex$/, min: $min, max: $max\n";
      return;
    }
  }
  return  if  ($max+1) =~ /^$regex$/;
  return $regex;
}



1;