BEGIN {
$^W= 1;
plan(
tests
=> 26,
);
}
Filter
MapCar MapCarE MapCarU MapCarMin
NestedLoops
NextPermute NextPermuteNum
)
;
ok(1);
my
$res
=
do
{
my
@mt
;
Filter {
die
}
@mt
;
};
ok(
$res
,
""
);
ok(
eval
{ Filter {
die
} 1; 1 },
undef
);
ok( $@,
"/(?i:^died at )/"
);
ok( (Filter {
chop
}
"test"
),
"tes"
);
ok( (Filter {
chop
}
"test"
,
"me"
),
"tesm"
);
ok( (Filter {y/a-z/A-Z/}
"x"
,
"y"
),
"XY"
);
{
my
@list
= (
''
,
qw/ a bc d /
);
ok( (Filter {s/(.)/\U$1/}
@list
),
"ABcD"
);
my
@new
= Filter {
$_
.=
@_
}
@list
;
ok(
"@new"
,
"0 a0 bc0 d0"
);
ok(
"@list"
,
" a bc d"
);
}
{
my
@list
=
qw/ X Y Z /
;
my
@new
= MapCarE {
@_
} [
qw/ a b c /
], [1..3], \
@list
;
ok(
"@new"
,
"a 1 X b 2 Y c 3 Z"
);
@new
= MapCarMin {
@_
} [
qw/ a b c /
], [1..3], \
@list
;
ok(
"@new"
,
"a 1 X b 2 Y c 3 Z"
);
@new
= MapCarU {
@_
} [
qw/ a b c /
], [1..3], \
@list
;
ok(
"@new"
,
"a 1 X b 2 Y c 3 Z"
);
@new
= MapCar {
@_
} [
qw/ a b c /
], [1..3], \
@list
;
ok(
"@new"
,
"a 1 X b 2 Y c 3 Z"
);
@new
= MapCarMin {
@_
} [
qw/ a b c /
], [1], \
@list
;
ok(
"@new"
,
"a 1 X"
);
@new
= MapCarU {
@_
} [
qw/ a b c /
], [1], \
@list
;
ok(
$new
[4],
undef
);
ok(
$new
[7],
undef
);
$new
[4]=
$new
[7]=
'u'
;
ok(
"@new"
,
"a 1 X b u Y c u Z"
);
@new
= MapCar {
@_
} [
qw/ a b c /
], [1], \
@list
;
ok(
"@new"
,
"a 1 X b Y c Z"
);
}
ok( 0+NestedLoops( [[]],
sub
{1} ), 0 );
{
my
@res
= NestedLoops(
[ [2,3], [5,7], [11,13], ],
sub
{
pop
() *
pop
() *
pop
();
},
);
ok(
"@res"
,
"110 130 154 182 165 195 231 273"
);
my
$res
= NestedLoops(
[ [1..2], [1..5], [1..7], ],
sub
{
@_
},
);
ok(
$res
, 2*3*5*7 );
@res
= NestedLoops(
[ [1..2], [1..5], [1..7], ],
{
OnlyWhen
=> 1 },
sub
{
join
''
,
@_
},
);
ok( 0+
@res
, 2*(1+5*(1+7)) );
$res
= NestedLoops(
[ [1..2], [1..5], [1..7], ],
{
OnlyWhen
=> 1 },
sub
{
@_
},
);
ok(
$res
, 2*(1+5*(2+3*7)) );
my
$len
= 3;
my
$cnt
= 0;
for
(
'0'
x
$len
..
'9'
x
$len
) {
$cnt
++
if
! /(.).*\1/;
}
my
$iter
= NestedLoops(
[ [0..9],
(
sub
{ [
$_
+1..9] } ) x (
$len
-1),
],
);
$res
= 0;
my
@list
;
while
(
@list
=
$iter
->() ) {
do
{
$res
++;
}
while
( NextPermute(
@list
) );
}
ok(
$res
,
$cnt
);
$res
= NestedLoops(
[ [0..9],
(
sub
{
my
%used
;
@used
{
@_
}= (1) x
@_
;
return
[
grep
!
$used
{
$_
}, 0..9 ];
} ) x (
$len
-1),
],
sub
{ 1 },
);
ok(
$res
,
$cnt
);
}