• Your recent searches
Algorithm-CP-IZ
13 results

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN 

4
5
6
7
8
9
10
11
12
13
14
15
16
17
        - 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;

IZ.xs  view on Meta::CPAN 

200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
  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)

IZ.xs  view on Meta::CPAN 

229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
 
  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)

IZ.xs  view on Meta::CPAN 

258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
 
  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;
}

MANIFEST  view on Meta::CPAN 

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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 

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
    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 

47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
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 

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
 
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 

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
    $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 

293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
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 

389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    );
 
    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 

561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
    );
 
    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 

876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
 
    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 

905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
 
    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 

935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
 
    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 

969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
 
    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 

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
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 

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
    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 =~ /(.*)::([^:]*)$/;

ppport.h  view on Meta::CPAN 

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
--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

ppport.h  view on Meta::CPAN 

103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
 
=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.

ppport.h  view on Meta::CPAN 

686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
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

ppport.h  view on Meta::CPAN 

770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
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|

ppport.h  view on Meta::CPAN 

2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
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|

ppport.h  view on Meta::CPAN 

2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
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};

ppport.h  view on Meta::CPAN 

3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
  }
 
  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:");

ppport.h  view on Meta::CPAN 

3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
 
  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';

ppport.h  view on Meta::CPAN 

3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
        $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||{}}};

ppport.h  view on Meta::CPAN 

3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
  $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;

ppport.h  view on Meta::CPAN 

3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
#  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

ppport.h  view on Meta::CPAN 

4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
#  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

ppport.h  view on Meta::CPAN 

4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
# 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))

ppport.h  view on Meta::CPAN 

4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
# 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)

ppport.h  view on Meta::CPAN 

5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
#    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

t/01int.t  view on Meta::CPAN 

191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
  $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 

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
    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 

506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
                           { 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 

656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
 
    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 

750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
                          {
                              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 

775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
    # 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 

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
    $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 

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
    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 

239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
 
    $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 

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
 
    $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 

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    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 

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
}
 
# 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 

193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
}
 
# 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 

257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
}
 
# 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 = $@;

t/07vs.t  view on Meta::CPAN 

243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
    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

t/07vs.t  view on Meta::CPAN 

297
298
299
300
301
302
303
304
305
306
307
308
309
    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 2.028 seconds using v1.01-cache-2.11-cpan-87723dcf8b7 )