error results from the CPAN

error

Algorithm-CP-IZ

view release on metacpan or search on metacpan

use strict;
use warnings;

use Test::More tests => 122;
BEGIN { use_ok('Algorithm::CP::IZ') };

{
    my $iz = Algorithm::CP::IZ->new();
    my $v = $iz->create_int(0, 10);
    $iz->search([$v]);

    is($v->min, 0);
    is($v->max, 0);
    is($v->value, 0);
    is($v->nb_elements, 1);
}

# default search
{
    my $iz = Algorithm::CP::IZ->new();

    my $v1 = $iz->create_int(0, 10);
    my $v2 = $iz->create_int(0, 10);
    $iz->AllNeq([$v1, $v2]);
    my $rc = $iz->search([$v1, $v2]);

    is($rc, 1);
    is($v1->value, 0);
    is($v2->value, 1);
}

# search error
{
    my $iz = Algorithm::CP::IZ->new();
    my $err = 1;
    eval {
	my $rc = $iz->search(["x"]);
	$err = 0;
    };

    my $msg = $@;
    is($err, 1);
    ok($msg =~ /^Algorithm::CP::IZ:/);

    eval {
	my $rc = $iz->search([undef]);
	$err = 0;
    };

    $msg = $@;
    is($err, 1);
    ok($msg =~ /^Algorithm::CP::IZ:/);
}

# default search (use Default)
{
    use Algorithm::CP::IZ::FindFreeVar;
    my $iz = Algorithm::CP::IZ->new();

    my $v1 = $iz->create_int(0, 10);
    my $v2 = $iz->create_int(0, 10);
    $iz->AllNeq([$v1, $v2]);
    my $rc = $iz->search([$v1, $v2],
			 { FindFreeVar => Algorithm::CP::IZ::FindFreeVar::Default, }
			);

    is($rc, 1);
    is($v1->value, 0);
    is($v2->value, 1);
}

# default search (using NbElements)
{
    use Algorithm::CP::IZ::FindFreeVar;
    my $iz = Algorithm::CP::IZ->new();

    my $v1 = $iz->create_int(0, 10);
    my $v2 = $iz->create_int(0, 5);
    $iz->AllNeq([$v1, $v2]);
    my $rc = $iz->search([$v1, $v2],
			 { FindFreeVar
			   => Algorithm::CP::IZ::FindFreeVar::NbElements, }
			);

    is($rc, 1);

    # v2 must be found first.
    is($v1->value, 1);
    is($v2->value, 0);
}

# search eror (FindFreeVar)

t/02search.t view on Meta::CPAN

    my $v2 = $iz->create_int(1, 2);
    $iz->AllNeq([$v1, $v2]);

    my @r;
    my $callback = sub {
      my $var_array = shift;
      push(@r, [map { $_->value } @$var_array]);
    };

    my $rc = $iz->find_all([$v1, $v2], $callback,
			   { FindFreeVar
			    => Algorithm::CP::IZ::FindFreeVar::NbElements, });

    is($rc, 1);
    is_deeply($r[0], [2, 1]);
    is_deeply($r[1], [3, 1]);
    is_deeply($r[2], [1, 2]);
    is_deeply($r[3], [3, 2]);
}

# find_all using (using NbElements)
{
    my $iz = Algorithm::CP::IZ->new();

    my $v1 = $iz->create_int(1, 3);
    my $v2 = $iz->create_int(1, 2);
    $iz->AllNeq([$v1, $v2]);

    my $func_used = 0;

    my $func = sub {
	my $array = shift;
	my $n = scalar @$array;

	for my $i (0..$n-1) {
	    return $i if ($array->[$i]->is_free);
	}

	$func_used = 1;

	return -1;
    };

    my @r;
    my $callback = sub {
      my $var_array = shift;
      push(@r, [map { $_->value } @$var_array]);
    };

    my $rc = $iz->find_all([$v1, $v2], $callback,
			   { FindFreeVar => $func });

    is($rc, 1);
    is($func_used, 1);
    is_deeply($r[0], [1, 2]);
    is_deeply($r[1], [2, 1]);
    is_deeply($r[2], [3, 1]);
    is_deeply($r[3], [3, 2]);
}

# find_all error (callback)
{
    my $iz = Algorithm::CP::IZ->new();

    my $v1 = $iz->create_int(1, 3);
    my $v2 = $iz->create_int(1, 2);
    my $err = 1;
    eval {
	my $rc = $iz->find_all([$v1, $v2], undef,
			       { FindFreeVar => undef });
    };

    my $msg = $@;
    is($err, 1);
    ok($msg =~ /^Algorithm::CP::IZ:/);
}

# find_all error (FindFreeVar)
{
    my $iz = Algorithm::CP::IZ->new();

    my $v1 = $iz->create_int(1, 3);
    my $v2 = $iz->create_int(1, 2);
    my $err = 1;
    eval {
	my $rc = $iz->find_all([$v1, $v2], sub {},
			       { FindFreeVar => undef });
    };

    my $msg = $@;
    is($err, 1);
    ok($msg =~ /^Algorithm::CP::IZ:/);
}

# backtrack
{
    my $iz = Algorithm::CP::IZ->new();
    my $v1 = $iz->create_int(1, 3);
    my $v2 = $iz->create_int(1, 3);
    my $b1called = 0;
    my $b2called = 0;

    my $btvar = undef;
    my $btindex = -999;

    my $b1 = sub {
      my ($v, $i) = @_;
      $b1called = 1;
      $btvar = $v;
      $btindex = $i;
    };

    my $b2 = sub {
      my ($v, $i) = @_;
      $b2called = 1;
      $btvar = $v;
      $btindex = $i;
    };

    $iz->save_context;
    $iz->backtrack($v1, 123, $b1);

    $iz->save_context;
    $iz->backtrack($v2, 456, $b2);


    is($b1called, 0);
    is($b2called, 0);

    $iz->restore_context;
    is($b2called, 1);
    is($v2->key, $btvar->key);
    is($btindex, 456);

    $iz->restore_context;
    is($b1called, 1);
    is($v1->key, $btvar->key);
    is($btindex, 123);

t/02search.t view on Meta::CPAN

    $iz->restore_context_until($label);
    is($v1->nb_elements, 3);

}

# forget save context
{
    my $iz = Algorithm::CP::IZ->new();
    my $v1 = $iz->create_int(0, 10);

    $iz->save_context(); # restored here
    ok($v1->Ge(1));

    $iz->save_context(); # forgotton
    ok($v1->Ge(2));

    $iz->forget_save_context();
    is($v1->min, 2);

    $iz->restore_context;
    is($v1->min, 0);
}

# forget save context until
{
    my $iz = Algorithm::CP::IZ->new();
    my $v1 = $iz->create_int(0, 10);

    $iz->save_context();
    ok($v1->Ge(1));

    $iz->save_context(); # restore here
    ok($v1->Ge(2));

    my $label = $iz->save_context(); # forgotton
    ok($v1->Ge(3));

    $iz->save_context();
    ok($v1->Ge(4));

    $iz->forget_save_context_until($label);
    is($v1->min, 4);

    $iz->restore_context;
    is($v1->min, 1);
}

# cancel (call only)
SKIP: {
    my $iz = Algorithm::CP::IZ->new();

    skip "old iZ", 1
	unless (defined($iz->get_version)
		&& $iz->IZ_VERSION_MAJOR >= 3
		&& $iz->IZ_VERSION_MINOR >= 6);

    $iz->cancel_search;
    ok(1);
}

# FindFreeVar error
{
    my $iz = Algorithm::CP::IZ->new();

    my $rc = -1234;
    my $v = $iz->create_int(0, 9);
    my $vs = $iz->get_value_selector(&Algorithm::CP::IZ::CS_VALUE_SELECTOR_MIN_TO_MAX);

    my $label = $iz->save_context;

    # nothing returned
    eval {
	$rc = $iz->search([$v],
		      {
			  FindFreeVar => sub {
			      return;
			  },
		      });
    };
    # error
    ok($@);
    is($rc, -1234);

    $iz->restore_context_until($label);
    $label = $iz->save_context;
    
    # bad value
    eval {
	$rc = $iz->search([$v],
		      {
			  FindFreeVar => sub {
			      return "x";
			  },
		      });
    };
    # error
    ok($@);
    is($rc, -1234);

    $iz->restore_context_until($label);
    $label = $iz->save_context;
    
    # out of range
    eval {
	$rc = $iz->search([$v],
		      {
			  FindFreeVar => sub {
			      return 1; # must be 0;
			  },
		      });
    };
    ok($@);
    is($rc, -1234);
}

# Criteria error
{
    my $iz = Algorithm::CP::IZ->new();

    my $v1 = $iz->create_int(0, 10);
    my $v2 = $iz->create_int(0, 10);
    $iz->AllNeq([$v1, $v2]);

    my $label = $iz->save_context;

    # nothing returned
    my $rc = -1234;

    eval {
	$rc = $iz->search([$v1, $v2],
			  {
			      Criteria => sub {
				  return;
			      },
			  });
    };
    ok($@);
    is($rc, -1234);

    $iz->restore_context_until($label);
    $label = $iz->save_context;

    eval {
	$rc = $iz->search([$v1, $v2],
			  {
			      Criteria => sub {
				  return "x";
			      },
			  });
    };
    ok($@);
    is($rc, -1234);
}

# MaxFailFunc error
SKIP: {
    my $iz = Algorithm::CP::IZ->new();

    skip "old iZ", 1
	unless (defined($iz->get_version)
		&& $iz->IZ_VERSION_MAJOR >= 3
		&& $iz->IZ_VERSION_MINOR >= 6);

    my $rc = -1234;
    my $v = $iz->create_int(0, 9);
    my $vs = $iz->get_value_selector(&Algorithm::CP::IZ::CS_VALUE_SELECTOR_MIN_TO_MAX);

    my $label = $iz->save_context;

    # nothing returned
    eval {
	$rc = $iz->search([$v],
		      {
			  ValueSelectors => [$vs],
			  MaxFailFunc => sub {
			      return;
			  }
		      });
    };
    # error
    ok($@);
    is($rc, -1234);

    $iz->restore_context_until($label);
    $label = $iz->save_context;

    # not a integer
    eval {
	$rc = $iz->search([$v],
		      {
			  ValueSelectors => [$vs],
			  MaxFailFunc => sub {
			      return "x";
			  }
		      });
    };
    # error
    ok($@);
    is($rc, -1234);
}

# MaxFailFunc only
SKIP: {
    my $iz = Algorithm::CP::IZ->new();

    skip "old iZ", 1
	unless (defined($iz->get_version)
		&& $iz->IZ_VERSION_MAJOR >= 3
		&& $iz->IZ_VERSION_MINOR >= 6);

    my $v = $iz->create_int(0, 9);
    my $vs = $iz->get_value_selector(&Algorithm::CP::IZ::CS_VALUE_SELECTOR_MIN_TO_MAX);

    my $rc = $iz->search([$v],
			 {
			     MaxFailFunc => sub {
				 return 1;
			     }
			 });
    is($rc, 1);
    is($v->value, 0);
}

# search with CriteriaEmulation
{
    my $iz = Algorithm::CP::IZ->new();

    my $criteria_used = 0;
    my $max_fail_used = 0;

    my $func = sub {
      my ($index, $val) = @_;
      $criteria_used = 1;
      if ($index == 0) {
	return $val ==4 ? 0 : 100;
      }
      if ($index == 1) {
	return $val ==5 ? 0 : 100;
      }
      return 0;
    };

    my $v1 = $iz->create_int(0, 10);
    my $v2 = $iz->create_int(0, 10);
    $iz->AllNeq([$v1, $v2]);
    my $rc = $iz->search([$v1, $v2],
			 { Criteria => $func,
			   MaxFailFunc => sub {
			       $max_fail_used = 1;
			       return 1;
			   }
			 }
			);

    is($rc, 1);
    is($criteria_used, 1);
    is($max_fail_used, 1);

( run in 1.444 second using v1.01-cache-2.11-cpan-2398b32b56e )