Algorithm-CP-IZ
view release on metacpan or search on metacpan
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal((SV*)newRV(ext)));
XPUSHs(sv_2mortal((SV*)newSViv(maxFails)));
PUTBACK;
call_method("search_start", G_DISCARD);
FREETMPS;
LEAVE;
}
static void searchNotify_searchEnd(IZBOOL result, int nbFails, int maxFails, CSint** allvars, int nbVars, void* ext) {
dTHX;
dSP;
ENTER;
(int)alen,
currentArray2IndexFunc,
max_fail,
(nf_ref ? INT2PTR(CSsearchNotify*, SvIV(nf_ref)) : NULL));
Safefree(array);
Safefree(vs_array);
OUTPUT:
RETVAL
int
cs_searchValueSelectorRestartNG(av, vs, findvar_id, findvar_ref, max_fail_func, max_fail, ngs, nf_ref)
AV *av
AV *vs
int findvar_id
SV* findvar_ref
SV* max_fail_func
int max_fail
SV* ngs
SV* nf_ref
PREINIT:
CSint** array;
croak("search: Bad FindFreeVar value");
}
currentArray2IndexFunc = findFreeVarTbl[findvar_id];
}
if (max_fail < 0)
max_fail = INT_MAX;
maxFailPerlFunc = max_fail_func;
RETVAL = cs_searchValueSelectorRestartNG(array,
vs_array,
(int)alen,
currentArray2IndexFunc,
maxFailFuncPerlWrapper,
NULL,
max_fail,
INT2PTR(CSnoGoodSet*, SvIV(ngs)),
(nf_ref ? INT2PTR(CSsearchNotify*, SvIV(nf_ref)) : NULL));
Safefree(array);
Safefree(vs_array);
void*
cs_createSearchNotify(obj)
SV* obj
CODE:
RETVAL = cs_createSearchNotify(SvRV(obj));
OUTPUT:
RETVAL
void
searchNotify_set_search_start(notify)
SV* notify
CODE:
cs_searchNotifySetSearchStart(INT2PTR(void*, SvIV(notify)),
searchNotify_searchStart);
void
searchNotify_set_search_end(notify)
SV* notify
CODE:
cs_searchNotifySetSearchEnd(INT2PTR(void*, SvIV(notify)),
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
}
my $i = 0;
for my $v (@$array) {
my $vs = $value_selectors->[$i];
$vs->prepare($i);
$i++;
}
if ($max_fail_func) {
return Algorithm::CP::IZ::cs_searchValueSelectorRestartNG(
$array,
$value_selectors,
$find_free_var_id,
$find_free_var_func,
$max_fail_func,
$max_fail,
defined($ngs) ? $ngs->{_ngs} : 0,
defined($notify) ? $notify->{_ptr} : 0);
}
else {
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
$$parray, scalar(@$var_array));
my $ret = Algorithm::CP::IZ::Int->new($ptr);
$self->_register_variable($ret);
return $ret;
}
sub Cumulative {
my $self = shift;
my ($starts, $durations, $resources, $limit) = @_;
validate([$starts, $durations, $resources, $limit, 1],
["vA0", "vA0", "vA0", "V", sub {
@$starts == @$durations && @$durations == @$resources
}],
"Usage: Cumulative([starts], [durations], [resources], limit)");
@$starts = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$starts;
@$durations = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$durations;
@$resources = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$resources;
$limit = ref $limit ? $limit : $self->_const_var(int($limit));
my $pstarts = $self->_create_registered_var_array($starts);
my $pdurs = $self->_create_registered_var_array($durations);
my $pres = $self->_create_registered_var_array($resources);
my $ret = Algorithm::CP::IZ::cs_Cumulative($$pstarts, $$pdurs, $$pres,
scalar(@$starts), $$limit);
return $ret;
}
sub Disjunctive {
my $self = shift;
my ($starts, $durations) = @_;
validate([$starts, $durations, 1],
["vA0", "vA0", sub {
@$starts == @$durations
}],
"Usage: Disjunctive([starts], [durations])");
@$starts = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$starts;
@$durations = map { ref $_ ? $_ : $self->_const_var(int($_)) } @$durations;
my $pstarts = $self->_create_registered_var_array($starts);
my $pdurs = $self->_create_registered_var_array($durations);
my $ret = Algorithm::CP::IZ::cs_Disjunctive($$pstarts, $$pdurs,
scalar(@$starts));
return $ret;
}
sub Regular {
my $self = shift;
my ($x, $d, $q0, $F) = @_;
validate([scalar(@_), $x,
$d,
$q0, $F
lib/Algorithm/CP/IZ.pm view on Meta::CPAN
=item ValueSelectors
Arrayref of Algorithm::CP::IZ::ValueSelector instances created via
get_value_selector or create_value_selector_simple method.
(If ValueSelector is specified, this parameter is ignored.)
=item MaxFailFunc
CodeRef of subroutine which returns maxfail for restart.
=item NoGoodSet
A Algorithm::CP::IZ::NoGoodSet instance which collects NoGoods.
=item Notify
Specify a notify object receives following notification by search function.
search_start
search_end
before_value_selection
after_value_selection
enter
leave
found
if OBJECT is a object, method having notification name will be called.
if OBJECT is a hashref, notification name must be a key of hash and
lib/Algorithm/CP/IZ/SearchNotify.pm view on Meta::CPAN
package Algorithm::CP::IZ::SearchNotify;
use strict;
use warnings;
use Carp qw(croak);
my @method_names = qw(
search_start
search_end
before_value_selection
after_value_selection
enter
leave
found
);
sub new {
my $class = shift;
lib/Algorithm/CP/IZ/SearchNotify.pm view on Meta::CPAN
return $self;
}
sub set_var_array {
my $self = shift;
my $var_array = shift;
$self->{_var_array} = $var_array;
}
sub search_start {
my $self = shift;
my ($max_fails) = @_;
&{$self->{_methods}->{search_start}}($max_fails, $self->{_var_array});
}
sub search_end {
my $self = shift;
my ($result, $nb_fails, $max_fails) = @_;
&{$self->{_methods}->{search_end}}($result, $nb_fails, $max_fails, $self->{_var_array});
}
sub before_value_selection {
_invlist_invert_prop|||
_invlist_invert|||
_invlist_len|||
_invlist_populate_swatch|||
_invlist_search|||
_invlist_subtract|||
_invlist_union_maybe_complement_2nd|||
_invlist_union|||
_is_uni_FOO||5.017008|
_is_uni_perl_idcont||5.017008|
_is_uni_perl_idstart||5.017007|
_is_utf8_FOO||5.017008|
_is_utf8_mark||5.017008|
_is_utf8_perl_idcont||5.017008|
_is_utf8_perl_idstart||5.017007|
_new_invlist_C_array|||
_new_invlist|||
_pMY_CXT|5.007003||p
_swash_inversion_hash|||
_swash_to_invlist|||
_to_fold_latin1|||
_to_uni_fold_flags||5.013011|
_to_upper_title_latin1|||
_to_utf8_fold_flags||5.015006|
_to_utf8_lower_flags||5.015006|
av_tindex||5.017009|
av_top_index||5.017009|
av_undef|||
av_unshift|||
ax|||n
bad_type_gv|||
bad_type_pv|||
bind_match|||
block_end|||
block_gimme||5.004000|
block_start|||
blockhook_register||5.013003|
boolSV|5.004000||p
boot_core_PerlIO|||
boot_core_UNIVERSAL|||
boot_core_mro|||
bytes_cmp_utf8||5.013007|
bytes_from_utf8||5.007001|
bytes_to_uni|||n
bytes_to_utf8||5.006001|
call_argv|5.006000||p
dXSTARG|5.006000||p
deb_curcv|||
deb_nocontext|||vn
deb_stack_all|||
deb_stack_n|||
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
defelem_target|||
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n
deprecate_commaless_var_list|||
despatch_signals||5.007001|
destroy_matcher|||
die_nocontext|||vn
die_sv||5.013001|
keyword|||
leave_scope|||
lex_bufutf8||5.011002|
lex_discard_to||5.011002|
lex_grow_linestr||5.011002|
lex_next_chunk||5.011002|
lex_peek_unichar||5.011002|
lex_read_space||5.011002|
lex_read_to||5.011002|
lex_read_unichar||5.011002|
lex_start||5.009005|
lex_stuff_pvn||5.011002|
lex_stuff_pvs||5.013005|
lex_stuff_pv||5.013006|
lex_stuff_sv||5.011002|
lex_unstuff||5.011002|
listkids|||
list|||
load_module_nocontext|||vn
load_module|5.006000||pv
localize|||
package_version|||
package|||
packlist||5.008001|
pad_add_anon||5.008001|
pad_add_name_pvn||5.015001|
pad_add_name_pvs||5.015001|
pad_add_name_pv||5.015001|
pad_add_name_sv||5.015001|
pad_alloc_name|||
pad_alloc|||
pad_block_start|||
pad_check_dup|||
pad_compname_type||5.009003|
pad_findlex|||
pad_findmy_pvn||5.015001|
pad_findmy_pvs||5.015001|
pad_findmy_pv||5.015001|
pad_findmy_sv||5.015001|
pad_fixup_inner_anons|||
pad_free|||
pad_leavemy|||
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|
reentrant_init||5.019003|
reentrant_retry||5.019003|vn
reentrant_size||5.019003|
ref_array_or_hash|||
refcounted_he_chain_2hv|||
skipspace_flags|||
softref2xv|||
sortcv_stacked|||
sortcv_xsub|||
sortcv|||
sortsv_flags||5.009003|
sortsv||5.007003|
space_join_names_mortal|||
ss_dup|||
stack_grow|||
start_force|||
start_glob|||
start_subparse||5.004000|
stdize_locale|||
strEQ|||
strGE|||
strGT|||
strLE|||
strLT|||
strNE|||
str_to_version||5.006000|
strip_return|||
strnEQ|||
strnNE|||
study_chunk|||
sub_crush_depth|||
sublex_done|||
sublex_push|||
sublex_start|||
sv_2bool_flags||5.013006|
sv_2bool|||
sv_2cv|||
sv_2io|||
sv_2iuv_common|||
sv_2iuv_non_preserve|||
sv_2iv_flags||5.009001|
sv_2iv|||
sv_2mortal|||
sv_2num|||
if (exists $opt{'api-info'}) {
my $f;
my $count = 0;
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
for $f (sort { lc $a cmp lc $b } keys %API) {
next unless $f =~ /$match/;
print "\n=== $f ===\n\n";
my $info = 0;
if ($API{$f}{base} || $API{$f}{todo}) {
my $base = format_version($API{$f}{base} || $API{$f}{todo});
print "Supported at least starting from perl-$base.\n";
$info++;
}
if ($API{$f}{provided}) {
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
print "Support by $ppport provided back to perl-$todo.\n";
print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
print "\n$hints{$f}" if exists $hints{$f};
print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
$info++;
imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
sv = va_arg(*args, SV*);
}
}
{
const line_t ocopline = PL_copline;
COP * const ocurcop = PL_curcop;
const int oexpect = PL_expect;
#if (PERL_BCDVERSION >= 0x5004000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
#elif (PERL_BCDVERSION > 0x5003000)
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
veop, modname, imop);
#else
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
modname, imop);
#endif
PL_expect = oexpect;
PL_copline = ocopline;
PL_curcop = ocurcop;
}
}
#endif
#endif
#endif
#define load_module DPPP_(my_load_module)
#define Perl_load_module DPPP_(my_load_module)
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
void
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
{
va_list args;
va_start(args, ver);
vload_module(flags, name, ver, &args);
va_end(args);
}
#endif
#endif
#ifndef newRV_inc
# define newRV_inc(sv) newRV(sv) /* Replace */
#endif
return rv;
}
#endif
#endif
/* Hint: newCONSTSUB
* Returns a CV* as of perl-5.7.1. This return value is not supported
* by Devel::PPPort.
*/
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
#if defined(NEED_newCONSTSUB)
static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
static
#else
extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
line_t oldline = PL_curcop->cop_line;
PL_curcop->cop_line = D_PPP_PL_copline;
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash)
PL_curstash = PL_curcop->cop_stash = stash;
newSUB(
#if (PERL_BCDVERSION < 0x5003022)
start_subparse(),
#elif (PERL_BCDVERSION == 0x5003022)
start_subparse(0),
#else /* 5.003_23 onwards */
start_subparse(FALSE, 0),
#endif
newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
);
PL_hints = oldhints;
PL_curcop->cop_stash = old_cop_stash;
PL_curstash = old_curstash;
#endif
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
void
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
#endif
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
void
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#ifdef PERL_IMPLICIT_CONTEXT
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
void
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
{
dTHX;
va_list args;
va_start(args, pat);
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
SvSETMAGIC(sv);
va_end(args);
}
#endif
#endif
#endif
/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
void
DPPP_(my_warner)(U32 err, const char *pat, ...)
{
SV *sv;
va_list args;
PERL_UNUSED_ARG(err);
va_start(args, pat);
sv = vnewSVpvf(pat, &args);
va_end(args);
sv_2mortal(sv);
warn("%s", SvPV_nolen(sv));
}
#define warner Perl_warner
#define Perl_warner_nocontext Perl_warner
#endif
/*
* The grok_* routines have been modified to use warn() instead of
* Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
* which is why the stack variable has been renamed to 'xdigit'.
*/
#ifndef grok_bin
#if defined(NEED_grok_bin)
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_2 = UV_MAX / 2;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
/* strip off leading b or 0b.
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_hex
#if defined(NEED_grok_hex)
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_16 = UV_MAX / 16;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
const char *xdigit;
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Hexadecimal number > 0xffffffff non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#endif
#ifndef grok_oct
#if defined(NEED_grok_oct)
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
static
#else
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
UV value = 0;
NV value_nv = 0;
const UV max_div_8 = UV_MAX / 8;
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
bool overflowed = FALSE;
for (; len-- && *s; s++) {
/* gcc 2.95 optimiser not smart enough to figure that this subtraction
break;
}
if ( ( overflowed && value_nv > 4294967295.0)
#if UVSIZE > 4
|| (!overflowed && value > 0xffffffff )
#endif
) {
warn("Octal number > 037777777777 non-portable");
}
*len_p = s - start;
if (!overflowed) {
*flags = 0;
return value;
}
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
if (result)
*result = value_nv;
return UV_MAX;
}
#endif
#define Perl_my_snprintf DPPP_(my_my_snprintf)
#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
int
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
{
dTHX;
int retval;
va_list ap;
va_start(ap, format);
#ifdef HAS_VSNPRINTF
retval = vsnprintf(buffer, len, format, ap);
#else
retval = vsprintf(buffer, format, ap);
#endif
va_end(ap);
if (retval < 0 || (len > 0 && (Size_t)retval >= len))
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
return retval;
}
#define my_sprintf DPPP_(my_my_sprintf)
#define Perl_my_sprintf DPPP_(my_my_sprintf)
#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
int
DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
{
va_list args;
va_start(args, pat);
vsprintf(buffer, pat, args);
va_end(args);
return strlen(buffer);
}
#endif
#endif
#ifdef NO_XSLOCKS
# ifdef dJMPENV
if (escaped != NULL)
*escaped= pv - str;
return SvPVX(dsv);
}
#endif
#endif
#ifndef pv_pretty
#if defined(NEED_pv_pretty)
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
static
#else
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
#endif
#ifdef pv_pretty
# undef pv_pretty
#endif
#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
#define Perl_pv_pretty DPPP_(my_pv_pretty)
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
char *
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
const STRLEN max, char const * const start_color, char const * const end_color,
const U32 flags)
{
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
STRLEN escaped;
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
sv_setpvs(dsv, "");
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, "<");
if (start_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
if (end_color != NULL)
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
if (dq == '"')
sv_catpvs(dsv, "\"");
else if (flags & PERL_PV_PRETTY_LTGT)
sv_catpvs(dsv, ">");
t/02search.t view on Meta::CPAN
my $v1 = $iz->ScalProd([$s, $e, $n, $d], [1000, 100, 10, 1]);
my $v2 = $iz->ScalProd([$m, $o, $r, $e], [1000, 100, 10, 1]);
my $v3 = $iz->ScalProd([$m, $o, $n, $e, $y], [10000, 1000, 100, 10, 1]);
my $v4 = $iz->Add($v1, $v2);
$v3->Eq($v4);
my $func_called = 0;
my $vs = $iz->get_value_selector(&Algorithm::CP::IZ::CS_VALUE_SELECTOR_MIN_TO_MAX);
my $restart = 0;
# cannot solve by MaxFail
$iz->save_context;
my $rc1 = $iz->search([$s, $e, $n, $d, $m, $o, $r, $y],
{
ValueSelectors =>
[map { $vs } 1..8],
MaxFail => 1,
MaxFailFunc => sub {
$func_called++;
return ++$restart;
},
});
is($rc1, 0);
$iz->restore_context;
# cannot solve by MaxFailFunc
$iz->save_context;
my $rc2 = $iz->search([$s, $e, $n, $d, $m, $o, $r, $y],
{
ValueSelectors =>
t/02search.t view on Meta::CPAN
MaxFail => 100,
MaxFailFunc => sub {
$func_called++;
return 1; # always 1
}
});
is($rc2, 0);
$iz->restore_context;
# solved
$restart = 0;
my $rc = $iz->search([$s, $e, $n, $d, $m, $o, $r, $y],
{
ValueSelectors =>
[map { $vs } 1..8],
MaxFailFunc => sub {
$func_called++;
return ++$restart;
}
});
ok($func_called > 0);
is($rc, 1);
ok($iz->get_nb_fails < 10000);
ok($iz->get_nb_choice_points > 0);
my $l1 = join(" ", map { $_->value } ($s, $e, $n, $d));
t/02search.t view on Meta::CPAN
my $v3 = $iz->ScalProd([$m, $o, $n, $e, $y], [10000, 1000, 100, 10, 1]);
my $v4 = $iz->Add($v1, $v2);
$v3->Eq($v4);
my $func_called = 0;
my $vs = $iz->get_value_selector(&Algorithm::CP::IZ::CS_VALUE_SELECTOR_MIN_TO_MAX);
my $array = [$s, $e, $n, $d, $m, $o, $r, $y];
my $ngs = $iz->create_no_good_set($array, undef, 100, undef);
my $restart = 0;
my $rc = $iz->search($array,
{
ValueSelectors => [map { $vs } 1..8],
MaxFailFunc => sub {
$func_called++;
return ++$restart;
},
NoGoodSet => $ngs,
});
ok($func_called > 0);
is($rc, 1);
ok($iz->get_nb_fails < 10000);
ok($iz->get_nb_choice_points > 0);
# don't register this NoGood
return 0;
}
package main;
my $obj = TestNG->new;
my $ngs = $iz->create_no_good_set($array,
sub { $obj->prefilter(@_); },
100, undef);
my $restart = 0;
my $rc = $iz->search($array,
{
ValueSelectors => [map { $vs } 1..8],
MaxFailFunc => sub {
$func_called++;
return ++$restart;
},
NoGoodSet => $ngs,
});
ok($func_called > 0);
is($rc, 1);
ok($iz->get_nb_fails < 10000);
ok($iz->get_nb_choice_points > 0);
my $var_array = shift;
my $nElem = scalar @$ng;
return 1;
}
package main;
my $obj = TestNG2->new;
my $ngs = $iz->create_no_good_set($array,
sub { $obj->prefilter(@_); },
100, undef);
my $restart = 0;
my $rc = $iz->search($array,
{
ValueSelectors => [map { $vs } 1..8],
MaxFailFunc => sub {
$func_called++;
return ++$restart;
},
NoGoodSet => $ngs,
});
ok($func_called > 0);
is($rc, 1);
ok($iz->get_nb_fails < 10000);
ok($iz->get_nb_choice_points > 0);
t/09notify.t view on Meta::CPAN
$v3->Eq($v4);
package TestObj;
sub new {
my $class = shift;
bless {}, $class;
}
my %called;
sub search_start {
my $self = shift;
my $array = shift;
$called{search_start}++;
}
sub search_end {
my $self = shift;
my $array = shift;
$called{search_end}++;
# 9567 + 1085 = 10652
# SEND MORE MONEY
t/09notify.t view on Meta::CPAN
$iz->save_context;
my $rc1 = $iz->search([$d, $e, $n, $y, $m, $o, $r, $s],
{
ValueSelectors =>
[map { $vs } 1..8],
MaxFail => 100,
Notify => $sn,
});
is($rc1, 1);
is($called{search_start}, 1);
is($called{search_end}, 1);
is($called{search_end_solution}, "95671082");
$iz->restore_context;
# notify by hash
my $search_start2 = 0;
my $sn2 = $iz->create_search_notify(
{
search_start => sub {
$search_start2++;
}
});
$iz->save_context;
my $rc2 = $iz->search([$d, $e, $n, $y, $m, $o, $r, $s],
{
ValueSelectors =>
[map { $vs } 1..8],
Notify => $sn2,
});
is($search_start2, 1);
is($rc2, 1);
$iz->restore_context;
# fail by found
my $sn3 = $iz->create_search_notify(
{
found => sub {
return 0;
( run in 0.502 second using v1.01-cache-2.11-cpan-0d8aa00de5b )