Algorithm-CP-IZ
view release on metacpan or search on metacpan
- Add support for cs_Reguar (iZ-C 3.7)
0.05 Fri Jul 12 2019
- Support iZ-C 3.6 APIs
0.03 Sun Aug 27 2017
- Now $iz->restore_context_until can restore values even if $iz->search is called.
0.02 Mon Nov 07 2015
- Change default directories for header and include in Makefile.PL
- Avoid error "during global destruction."
0.01 Mon Oct 12 14:31:13 2015
- first release;
ENTER;
SAVETMPS;
PUSHMARK(sp);
PUTBACK;
count = call_sv((SV*)ext, G_SCALAR);
SPAGAIN;
ret = -1;
if (count == 0) {
croak("eventAllKnownPerlWrapper: error");
}
ret = sv_true(POPs);
FREETMPS;
LEAVE;
return (IZBOOL)ret;
}
static IZBOOL eventKnownPerlWrapper(int val, int index, CSint **tint, int size, void *ext)
XPUSHs(sv_2mortal(newSViv(val)));
XPUSHs(sv_2mortal(newSViv(index)));
PUTBACK;
count = call_sv((SV*)ext, G_SCALAR);
SPAGAIN;
ret = -1;
if (count == 0) {
croak("eventKnownPerlWrapper: error");
}
ret = sv_true(POPs);
FREETMPS;
LEAVE;
return (IZBOOL)ret;
}
static IZBOOL eventNewMinMaxNeqPerlWrapper(CSint* vint, int index, int oldValue, CSint **tint, int size, void *ext)
XPUSHs(sv_2mortal(newSViv(index)));
XPUSHs(sv_2mortal(newSViv(oldValue)));
PUTBACK;
count = call_sv((SV*)ext, G_SCALAR);
SPAGAIN;
ret = -1;
if (count == 0) {
croak("eventNewMinMaxNeqPerlWrapper: error");
}
ret = sv_true(POPs);
FREETMPS;
LEAVE;
return (IZBOOL)ret;
}
lib/Algorithm/CP/IZ/ValueSelector.pm
Makefile.PL
MANIFEST
ppport.h
README
t/00basic.t
t/01int.t
t/02search.t
t/03demon.t
t/04constraint.t
t/05error.t
t/06stringify.t
t/07vs.t
t/08ng.t
t/09notify.t
t/number-place.t
t/send-more-money.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
fallback/const-xs.inc view on Meta::CPAN
IV iv;
/* NV nv; Uncomment this if you need to return NVs */
/* const char *pv; Uncomment this if you need to return PVs */
INPUT:
SV * sv;
const char * s = SvPV(sv, len);
PPCODE:
/* Change this to constant(aTHX_ s, len, &iv, &nv);
if you need to return both NVs and IVs */
type = constant(aTHX_ s, len, &iv);
/* Return 1 or 2 items. First is error message, or undef if no error.
Second, if present, is found value */
switch (type) {
case PERL_constant_NOTFOUND:
sv =
sv_2mortal(newSVpvf("%s is not a valid Algorithm::CP::IZ macro", s));
PUSHs(sv);
break;
case PERL_constant_NOTDEF:
sv = sv_2mortal(newSVpvf(
"Your vendor has not defined Algorithm::CP::IZ macro %s, used",
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
our $VERSION = '0.07';
sub AUTOLOAD {
# This AUTOLOAD is used to 'autoload' constants from the constant()
# XS function.
my $constname;
our $AUTOLOAD;
($constname = $AUTOLOAD) =~ s/.*:://;
croak "&Algorithm::CP::IZ::constant not defined" if $constname eq 'constant';
my ($error, $val) = constant($constname);
if ($error) { croak $error; }
{
no strict 'refs';
# Fixed between 5.005_53 and 5.005_61
#XXX if ($] >= 5.00561) {
#XXX *$AUTOLOAD = sub () { $val };
#XXX }
#XXX else {
*$AUTOLOAD = sub { $val };
#XXX }
}
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
require XSLoader;
XSLoader::load('Algorithm::CP::IZ', $VERSION);
# Preloaded methods go here.
# Autoload methods go after =cut, and are processed by the autosplit program.
my $Instances = 0;
sub _report_error {
my $msg = shift;
croak __PACKAGE__ . ": ". $msg;
}
sub new {
my $class = shift;
if ($Instances > 0) {
_report_error("another instance is working.");
}
Algorithm::CP::IZ::cs_init();
$Instances++;
bless {
_vars => [],
_cxt0 => [],
_cxt => [],
_const_vars => {},
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
$self->backtrack(undef, 0, sub { pop(@$cxt) });
return $ret;
}
sub restore_context {
my $self = shift;
my $cxt = $self->{_cxt};
if (@$cxt == 0) {
_report_error("restore_context: bottom of context stack");
}
Algorithm::CP::IZ::cs_restoreContext();
}
sub restore_context_until {
my $self = shift;
my $label = shift;
validate([$label], ["I"],
"Usage: restore_context_until(int_label)");
my $cxt = $self->{_cxt};
if (@$cxt == 0) {
_report_error("restore_context_until: invalid label");
}
Algorithm::CP::IZ::cs_restoreContextUntil($label);
}
sub forget_save_context {
my $self = shift;
my $cxt = $self->{_cxt};
if (@$cxt == 0) {
_report_error("forget_save_context: bottom of context stack");
}
Algorithm::CP::IZ::cs_forgetSaveContext();
}
sub forget_save_context_until {
my $self = shift;
my $label = shift;
validate([$label], ["I"],
"Usage: forget_save_context_until(int_label)");
my $cxt = $self->{_cxt};
if (@$cxt == 0) {
_report_error("forget_save_context_until: invalid label");
}
Algorithm::CP::IZ::cs_forgetSaveContextUntil($label);
}
sub restore_all {
my $self = shift;
Algorithm::CP::IZ::cs_restoreAll();
# pop must be after cs_restoreContext to save cs_backtrack context.
$self->{_cxt} = [];
}
sub accept_context {
my $self = shift;
my $cxt = $self->{_cxt};
if (@$cxt == 0) {
_report_error("accept_context: bottom of context stack");
}
Algorithm::CP::IZ::cs_acceptContext();
# pop must be after cs_acceptContext to save cs_backtrack context.
pop(@$cxt);
}
sub accept_context_until {
my $self = shift;
my $label = shift;
validate([$label], ["I"],
"Usage: accept_context_until(int_label)");
my $cxt = $self->{_cxt};
if (@$cxt == 0) {
_report_error("accept_context_until: invalid label");
}
while (@$cxt >= $label) {
Algorithm::CP::IZ::cs_acceptContext();
# pop must be after cs_acceptContext to save cs_backtrack context.
pop(@$cxt);
}
}
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
my $name;
if (!ref $p1 && @_ == 0) {
return $self->_const_var($p1);
}
elsif (ref $p1 && ref $p1 eq 'ARRAY') {
$name = shift;
$ptr = $self->_create_int_from_domain($p1);
unless ($ptr) {
my $param_str = join(", ", @$p1);
_report_error("cannot create variable from [$param_str]");
}
}
else {
my $min = $p1;
my $max = shift;
$name = shift;
$ptr = $self->_create_int_from_min_max($min, $max);
unless ($ptr) {
my $param_str = join(", ", $min, $max);
_report_error("cannot create variable from ($param_str)");
}
}
my $ret = Algorithm::CP::IZ::Int->new($ptr);
if (defined $name) {
$ret->name($name);
}
$self->_register_variable($ret);
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
);
my @keys = sort keys %$params;
for my $k (@keys) {
if (exists $checker{$k}) {
my $func = $checker{$k};
&$func($params->{$k});
}
else {
_report_error("search: Unknown Key $k in params");
}
}
return 1;
}
sub search {
my $self = shift;
my $var_array = shift;
my $params = shift;
validate([$var_array, $params], ["vA0", sub {_validate_search_params($var_array, @_)}],
"Usage: search([variables], {key=>value,...}");
my $array = [map { $$_ } @$var_array];
my $max_fail = -1;
my $find_free_var_id = 0;
my $find_free_var_func = sub { die "search: Internal error"; };
my $criteria_func;
my $value_selectors;
my $max_fail_func;
my $ngs;
my $notify;
if ($params->{FindFreeVar}) {
my $ffv = $params->{FindFreeVar};
if (ref $ffv) {
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
);
my @keys = sort keys %$params;
for my $k (@keys) {
if (exists $checker{$k}) {
my $func = $checker{$k};
&$func($params->{$k});
}
else {
_report_error("find_all: Unknown Key $k in params");
}
}
return 1;
}
sub find_all {
my $self = shift;
my $var_array = shift;
my $found_func = shift;
my $params = shift;
validate([$var_array, $found_func, $params],
["vA0", "C", \&_validate_find_all_params],
"find_all: usage: find_all([vars], &callback_func, {params})");
my $array = [map { $$_ } @$var_array];
my $find_free_var_id = 0;
my $find_free_var_func = sub { die "find_all: Internal error"; };
if ($params->{FindFreeVar}) {
my $ffv = $params->{FindFreeVar};
if (ref $ffv) {
$find_free_var_id = -1;
$find_free_var_func = sub {
return &$ffv($var_array);
};
}
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
return _argv_func(\@rest, $N, $arg2_func, $argv_func);
}
sub Add {
my $self = shift;
my @params = @_;
my $usage_msg = 'usage: Add(v1, v2, ...)';
if (@params < 1) {
_report_error($usage_msg);
}
for my $v (@params) {
validate([$v], ["V"], $usage_msg);
}
if (@params == 1) {
return $params[0] if (ref $params[0]);
return $self->_const_var(int($params[0]));
}
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
return $ret;
}
sub Mul {
my $self = shift;
my @params = @_;
my $usage_msg = 'usage: Mul(v1, v2, ...)';
if (@params < 1) {
_report_error($usage_msg);
}
for my $v (@params) {
validate([$v], ["V"], $usage_msg);
}
if (@params == 1) {
return $params[0] if (ref $params[0]);
return $self->_const_var(int($params[0]));
}
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
return $ret;
}
sub Sub {
my $self = shift;
my @params = @_;
my $usage_msg = 'usage: Sub(v1, v2, ...)';
if (@params < 1) {
_report_error($usage_msg);
}
for my $v (@params) {
validate([$v], ["V"], $usage_msg);
}
if (@params == 1) {
return $params[0] if (ref $params[0]);
return $self->_const_var(int($params[0]));
}
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
return $ret;
}
sub Div {
my $self = shift;
my @params = @_;
my $usage_msg = 'usage: Div(v1, v2)';
if (@params != 2) {
_report_error($usage_msg);
}
for my $v (@params) {
validate([$v], ["V"], $usage_msg);
}
if (@params == 1) {
return $params[0] if (ref $params[0]);
return $self->_const_var(int($params[0]));
}
lib/Algorithm/CP/IZ/NoGoodSet.pm view on Meta::CPAN
use Algorithm::CP::IZ::RefVarArray;
use Algorithm::CP::IZ::NoGoodElement;
use Carp qw(croak);
sub new {
my $class = shift;
my ($var_array, $prefilter, $ext) = @_;
# this object must be created by $iz->create_no_good_set
defined($var_array) or croak "internal error";
my $parray = Algorithm::CP::IZ::RefVarArray->new($var_array);
my $self = {
_var_array => $var_array,
_parray => $parray,
_prefilter => $prefilter,
_ext => $ext,
};
bless $self, $class;
}
lib/Algorithm/CP/IZ/ParamValidator.pm view on Meta::CPAN
vA0 => sub { _is_array_of_var_or_int(0, @_) },
vA1 => sub { _is_array_of_var_or_int(1, @_) },
);
sub validate {
my $params = shift;
my $types = shift;
my $hint = shift;
unless (@$params == @$types) {
local @CARP_NOT; # to report internal error
croak __PACKAGE__ . ": n of type does not match with params.";
}
for my $i (0..@$params-1) {
my $rc;
if (ref $types->[$i] eq 'CODE') {
$rc = &{$types->[$i]}($params->[$i]);
}
else {
unless ($Validator{$types->[$i]}) {
local @CARP_NOT; # to report internal error
croak __PACKAGE__ . ": Parameter type($i) " . ($types->[$i] // "undef") . " is not defined.";
}
$rc = &{$Validator{$types->[$i]}}($params->[$i]);
}
unless ($rc) {
my ($package, $filename, $line, $subroutine, $hasargs,
$wantarray, $evaltext, $is_require, $hints, $bitmask, $hinthash) = caller(1);
$subroutine =~ /(.*)::([^:]*)$/;
--version show version
--patch=file write one patch file with changes
--copy=suffix write changed copies with suffix
--diff=program use diff program and options
--compat-version=version provide compatibility with Perl version
--cplusplus accept C++ comments
--quiet don't output anything except fatal errors
--nodiag don't show diagnostics
--nohints don't show hints
--nochanges don't suggest changes
--nofilter don't filter input files
--strip strip all script and doc functionality from
ppport.h
--list-provided list provided API
--list-unsupported list unsupported API
=head2 --cplusplus
Usually, F<ppport.h> will detect C++ style comments and
replace them with C style comments for portability reasons.
Using this option instructs F<ppport.h> to leave C++
comments untouched.
=head2 --quiet
Be quiet. Don't print anything except fatal errors.
=head2 --nodiag
Don't output any diagnostic messages. Only portability
alerts will be printed.
=head2 --nohints
Don't output any hints. Hints often contain useful portability
notes. Warnings will still be displayed.
PL_copline|5.019002||p
PL_curcop|5.004050||p
PL_curpad||5.005000|
PL_curstash|5.004050||p
PL_debstash|5.004050||p
PL_defgv|5.004050||p
PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
PL_error_count|5.019002||p
PL_expect|5.019002||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_in_my_stash|5.019002||p
PL_in_my|5.019002||p
PL_keyword_plugin||5.011002|
PL_last_in_gv|||n
PL_laststatval|5.005000||p
PL_lex_state|5.019002||p
PL_lex_stuff|5.019002||p
PadnamePV||5.019003|
PadnameSV||5.019003|
PadnameTYPE|||
PadnameUTF8||5.019003|
PadnamelistARRAY||5.019003|
PadnamelistMAX||5.019003|
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_context_layers||5.009004|
PerlIO_eof||5.007003|
PerlIO_error||5.007003|
PerlIO_fileno||5.007003|
PerlIO_fill||5.007003|
PerlIO_flush||5.007003|
PerlIO_get_base||5.007003|
PerlIO_get_bufsiz||5.007003|
PerlIO_get_cnt||5.007003|
PerlIO_get_ptr||5.007003|
PerlIO_read||5.007003|
PerlIO_seek||5.007003|
PerlIO_set_cnt||5.007003|
ptr_table_new||5.009005|
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
put_byte|||
put_latin1_charclass_innards|||
pv_display|5.006000||p
pv_escape|5.009004||p
pv_pretty|5.009004||p
pv_uni_display||5.007003|
qerror|||
qsortsvu|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
re_intuit_start||5.019001|
re_intuit_string||5.006000|
re_op_compile|||
readpipe_override|||
realloc||5.007002|n
reentrant_free||5.019003|
warner_nocontext|||vn
warner|5.006000|5.004000|pv
warn|||v
was_lvalue_sub|||
watch|||
whichsig_pvn||5.015004|
whichsig_pv||5.015004|
whichsig_sv||5.015004|
whichsig|||
win32_croak_not_implemented|||n
with_queued_errors|||
wrap_op_checker||5.015008|
write_to_stderr|||
xmldump_all_perl|||
xmldump_all|||
xmldump_attr|||
xmldump_eval|||
xmldump_form|||
xmldump_indent|||v
xmldump_packsubs_perl|||
xmldump_packsubs|||
xmldump_sub_perl|||
xmldump_sub|||
xmldump_vindent|||
xs_apiversion_bootcheck|||
xs_version_bootcheck|||
yyerror_pvn|||
yyerror_pv|||
yyerror|||
yylex|||
yyparse|||
yyunlex|||
yywarn|||
);
if (exists $opt{'list-unsupported'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $API{$f}{todo};
}
my $s = $warnings != 1 ? 's' : '';
my $warn = $warnings ? " ($warnings warning$s)" : '';
info("Analysis completed$warn");
if ($file{changes}) {
if (exists $opt{copy}) {
my $newfile = "$filename$opt{copy}";
if (-e $newfile) {
error("'$newfile' already exists, refusing to write copy of '$filename'");
}
else {
local *F;
if (open F, ">$newfile") {
info("Writing copy of '$filename' with changes to '$newfile'");
print F $c;
close F;
}
else {
error("Cannot open '$newfile' for writing: $!");
}
}
}
elsif (exists $opt{patch} || $opt{changes}) {
if (exists $opt{patch}) {
unless ($patch_opened) {
if (open PATCH, ">$opt{patch}") {
$patch_opened = 1;
}
else {
error("Cannot open '$opt{patch}' for writing: $!");
delete $opt{patch};
$opt{changes} = 1;
goto fallback;
}
}
mydiff(\*PATCH, $filename, $c);
}
else {
fallback:
info("Suggested changes:");
if (!defined $diff) {
$diff = run_diff('diff -u', $file, $str);
}
if (!defined $diff) {
$diff = run_diff('diff', $file, $str);
}
if (!defined $diff) {
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
return;
}
print F $diff;
}
sub run_diff
{
my($prog, $file, $str) = @_;
my $tmp = 'dppptemp';
$diff .= $_;
}
close F;
unlink $tmp;
return $diff;
}
unlink $tmp;
}
else {
error("Cannot open '$tmp' for writing: $!");
}
return undef;
}
sub rec_depend
{
my($func, $seen) = @_;
return () unless exists $depends{$func};
$seen = {%{$seen||{}}};
$opt{quiet} and return;
$opt{diag} and print @_, "\n";
}
sub warning
{
$opt{quiet} and return;
print "*** ", @_, "\n";
}
sub error
{
print "*** ERROR: ", @_, "\n";
}
my %given_hints;
my %given_warnings;
sub hint
{
$opt{quiet} and return;
my $func = shift;
# endif
#endif
#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
/* It is very unlikely that anyone will try to use this with Perl 6
(or greater), but who knows.
*/
#if PERL_REVISION != 5
# error ppport.h only works with Perl version 5
#endif /* PERL_REVISION != 5 */
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef dTHX
# define dTHX dNOOP
#endif
#ifndef dTHXa
# define dTHXa(x) dNOOP
# define PL_compiling compiling
# define PL_copline copline
# define PL_curcop curcop
# define PL_curstash curstash
# define PL_debstash debstash
# define PL_defgv defgv
# define PL_diehook diehook
# define PL_dirty dirty
# define PL_dowarn dowarn
# define PL_errgv errgv
# define PL_error_count error_count
# define PL_expect expect
# define PL_hexdigit hexdigit
# define PL_hints hints
# define PL_in_my in_my
# define PL_laststatval laststatval
# define PL_lex_state lex_state
# define PL_lex_stuff lex_stuff
# define PL_linestr linestr
# define PL_na na
# define PL_perl_destruct_level perl_destruct_level
# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
# define PL_linestr D_PPP_my_PL_parser_var(linestr)
# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
# define PL_bufend D_PPP_my_PL_parser_var(bufend)
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
#else
/* ensure that PL_parser != NULL and cannot be dereferenced */
# define PL_parser ((void *) 1)
#endif
#ifndef mPUSHs
# define mPUSHs(s) PUSHs(sv_2mortal(s))
# else
# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
# endif
#endif
/* Replace perl_eval_pv with eval_pv */
#ifndef eval_pv
#if defined(NEED_eval_pv)
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
PUSHMARK(sp);
eval_sv(sv, G_SCALAR);
SvREFCNT_dec(sv);
SPAGAIN;
sv = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(GvSV(errgv)))
croak(SvPVx(GvSV(errgv), na));
return sv;
}
#endif
#endif
#ifndef vload_module
#if defined(NEED_vload_module)
# define UVof "lo"
# define UVxf "lx"
# define UVXf "lX"
# elif IVSIZE == INTSIZE
# define IVdf "d"
# define UVuf "u"
# define UVof "o"
# define UVxf "x"
# define UVXf "X"
# else
# error "cannot define IV/UV formats"
# endif
#endif
#ifndef NVef
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
/* Not very likely, but let's try anyway. */
# define NVef PERL_PRIeldbl
# define NVff PERL_PRIfldbl
# define NVgf PERL_PRIgldbl
$iz->save_context;
is($v->NotInInterval(5, 8), 1);
is(join(",", @{$v->domain}), "0,1,2,3,4,9,10");
is($v->NotInInterval(0, 200), 0);
$iz->restore_context;
}
# error
{
my $err = 1;
eval {
my $i = $iz->create_int("a");
$err = 0;
};
my $msg = $@;
is($err, 1);
ok($msg =~ /^Algorithm::CP::IZ:/);
}
# error
{
my $err = 1;
eval {
my $i = $iz->create_int([]);
$err = 0;
};
my $msg = $@;
is($err, 1);
ok($msg =~ /^Algorithm::CP::IZ:/);
t/02search.t view on Meta::CPAN
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);
t/02search.t view on Meta::CPAN
{ 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 });
};
t/02search.t view on Meta::CPAN
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
t/02search.t view on Meta::CPAN
{
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);
t/02search.t view on Meta::CPAN
# 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)
t/03demon.t view on Meta::CPAN
$iz->event_all_known([$v1, $v2], $handler, "abc");
$v1->Eq(5);
is($fire, '');
$v2->Eq(7);
is($fire, 'abc');
}
# event_all_known error
{
my $iz = Algorithm::CP::IZ->new();
my $v1 = $iz->create_int(0, 10);
my $v2 = $iz->create_int(0, 10);
my $handler = sub {
return 1;
};
my $err = 1;
t/03demon.t view on Meta::CPAN
is($handler_index, 0);
is($var_value, 5);
$v2->Eq(7);
is($fire, 'abc');
is($handler_value, 7);
is($handler_index, 1);
is($var_value, 7);
}
# event_known error
{
my $iz = Algorithm::CP::IZ->new();
my $v1 = $iz->create_int(0, 10);
my $v2 = $iz->create_int(0, 10);
my $known_handler = sub {
return 1;
};
my $err = 1;
t/03demon.t view on Meta::CPAN
$v2->Le(3);
is($fire, 'abc');
is($handler_max, 10);
is($handler_index, 1);
is($var_max, 3);
is($var_name, "v2");
}
# event_new_max error
{
my $iz = Algorithm::CP::IZ->new();
my $v1 = $iz->create_int(0, 10, "v1");
my $v2 = $iz->create_int(0, 10, "v2");
my $new_max_handler = sub {
return 1;
};
my $err = 1;
t/03demon.t view on Meta::CPAN
$v2->Neq(3);
is($fire, 'abc');
is($handler_neq, 3);
is($handler_index, 1);
is($var_domain, "0,1,2,4,5,6,7,8,9,10");
is($var_name, "v2");
}
# event_neq error
{
my $iz = Algorithm::CP::IZ->new();
my $v1 = $iz->create_int(0, 10, "v1");
my $v2 = $iz->create_int(0, 10, "v2");
my $fire = '';
my $handler_index = 99;
my $handler_neq = 99;
my $var_domain = "?";
my $var_name = "?";
t/04constraint.t view on Meta::CPAN
for my $i (11..50) {
my $iz = Algorithm::CP::IZ->new();
my @vars = map{$iz->create_int($_, $_)} (1..$i);
my $sum = (($i + 1) * $i) / 2;
my $v = $iz->Add(@vars);
is($v->value, $sum);
}
}
# Add error
{
my $iz = Algorithm::CP::IZ->new();
my @vars = map{$iz->create_int($_, $_)} (1..2);
my $err = 1;
eval {
my $v = $iz->Add();
$err = 0;
};
my $msg = $@;
t/04constraint.t view on Meta::CPAN
}
# Mul
{
my $iz = Algorithm::CP::IZ->new();
my $v = $iz->Mul(1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 3);
is($v->value, 6 * 6 * 6 * 6 * 6);
}
# Mul error
{
my $iz = Algorithm::CP::IZ->new();
my @vars = map{$iz->create_int($_, $_)} (1..2);
my $err = 1;
eval {
my $v = $iz->Mul();
$err = 0;
};
my $msg = $@;
t/04constraint.t view on Meta::CPAN
}
# Sub
{
my $iz = Algorithm::CP::IZ->new();
my $v1 = $iz->Sub(5, 2, 1);
is($v1->value, 2);
}
# Sub error
{
my $iz = Algorithm::CP::IZ->new();
my @vars = map{$iz->create_int($_, $_)} (1..2);
my $err = 1;
eval {
my $v = $iz->Sub();
$err = 0;
};
my $msg = $@;
t/04constraint.t view on Meta::CPAN
}
# Div (segfault in cs_Div)
{
my $iz = Algorithm::CP::IZ->new();
# my $v1 = $iz->Div(7, 2);
# ok(!defined($v1));
ok(1);
}
# Div error
{
my $iz = Algorithm::CP::IZ->new();
my @vars = map{$iz->create_int($_, $_)} (1..2);
my $err = 1;
eval {
my $v = $iz->Div();
$err = 0;
};
my $msg = $@;
my $v2 = $iz->create_int(0, 5);
my $vs = $iz->create_value_selector_simple("TestVS");
eval {
my $rc = $iz->search([$v1, $v2],
{ ValueSelectors
=> [$vs, $vs], }
);
};
# error
ok($@);
}
# bad value 2
SKIP: {
my $iz = Algorithm::CP::IZ->new;
skip "old iZ", 0
unless (defined($iz->get_version)
&& $iz->IZ_VERSION_MAJOR >= 3
my $v2 = $iz->create_int(0, 5);
my $vs = $iz->create_value_selector_simple("TestVS");
eval {
my $rc = $iz->search([$v1, $v2],
{ ValueSelectors
=> [$vs, $vs], }
);
};
# error
ok($@);
}
( run in 0.354 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )