The module includes two test sets.
The first, assert.t, tests for the common failure cases and the source for it is below (or see the copy on search.cpan.org).
use strict; use Test qw( plan ok skip ); BEGIN { # print our plan before module loaded $^W= 1; plan( tests => 85, # todo => [3,4], ); } use Algorithm::Loops qw( Filter MapCar MapCarE MapCarU MapCarMin NestedLoops NextPermute NextPermuteNum ); ok(1); #1# Loaded module my $croak= eval { require Carp; defined &Carp::croak } ? 0 : "Carp::croak() not found"; print "# $@" if $@; my $check; my $lineNum; sub SetLineNum { $lineNum= 1+(caller(0))[2]; } while( <DATA> ) { $lineNum++; chomp; if( m#^[/0]# ) { $check= $_; next; } next if m/^#/; if( s#^:## ) { eval "\n#line $lineNum $0\n$_\n; 1" or die $@; $croak= '' if /croak/; next; } s/[#\d\s]+$//; my( $sub )= /^&?(\w+)/i; ok( eval "\n#line $lineNum $0\n$_\n;1", undef, "fail: $_", ); if( $@ ) { chomp $@; print "# $@\n" } ok( $@, "/^$sub:/", "name: $_" ) if $sub; ok( $@, $check, "mesg: $_" ) if $check; skip( $croak, $@, "/ at ".quotemeta(__FILE__)." line /", "line: $_ +" ) if '' ne $croak; } exit( 0 ); # This code fixes up test numbers below: { seek( DATA, 0, 0 ); while( <DATA> ) { print; last if /^\s*__END__/; } my $croak= 1; my $check= 0; my $n= 2; while( <DATA> ) { if( m#^[/0]# ) { chomp( $check= $_ ); } elsif( /^:/ ) { $croak= 0 if /croak/; } elsif( /^#/ ) { ; } else { if( ! s/\s*#.*//s ) { chomp; } $_ .= ' ' x ( 32 - length ); my( $sub )= /^&?(\w+)/i; my $c= 4 - !$sub - !$check - !$croak; $_ .= join "#", '', $n..$n+$c-1, $/; $n += $c; } print; } } BEGIN { SetLineNum } __END__ /(?i:\bnot enough arg)/ Filter; #2#3#4# MapCar; #5#6#7# MapCarE; #8#9#10# MapCarU; #11#12#13# MapCarMin; #14#15#16# NextPermute; #17#18#19# NextPermuteNum; #20#21#22# /(?i:\bcode reference\b)/ &Filter(); #23#24#25#26# &MapCar(); #27#28#29#30# &MapCarE(); #31#32#33#34# &MapCarU(); #35#36#37#38# &MapCarMin(); #39#40#41#42# NestedLoops [], {}, {}; #43#44#45#46# NestedLoops [], []; #47#48#49#50# /(?i:\boption\S*: xul\b)/ NestedLoops [], {xul=>1}; #51#52#53#54# /(?i:\barray reference\b)/ NestedLoops; #55#56#57#58# MapCar {0} 'ARRAY'; #59#60#61#62# MapCarE {0} {a=>1}; #63#64#65#66# MapCarU {0} sub {1}; #67#68#69#70# MapCarMin {0} \1; #71#72#73#74# :undef &Carp::croak; /(?i:\bdifferent size)/ MapCarE {0} [], [1]; #75#76#77# /(?i:\btoo many\b)/ NestedLoops [], {}, 1, sub {0}; #78#79#80# /(?i:\bvoid context\b)/ NestedLoops [[]], {}; #81#82#83# 0 # Invalid type: NestedLoops [1], {}; #84#85#
Note that the script is actually two scripts in one: The test script and a script to update the "#14#" comments for which test number applies to which line of code.
Since I'm testing fatal errors, all of the code to be tested appears after the __END__ tag. I particularly like the way I manage to report the correct file name and line numbers in the error messages.
Note that part of the code to set the line number offset for the test run is located in the code that renumbers the test cases (which doesn't get run during a test run).
The second, basic.t, tests basic functionality and the source for it is below (or see the copy on search.cpan.org).
use strict; use Test qw( plan ok ); BEGIN { # print our plan before module loaded $^W= 1; plan( tests => 26, # todo => [3,4], ); } use Algorithm::Loops qw( Filter MapCar MapCarE MapCarU MapCarMin NestedLoops NextPermute NextPermuteNum ); ok(1); #1# Loaded module my $res= do { my @mt; Filter {die} @mt; }; ok( $res, "" ); #2# ok( eval{ Filter {die} 1; 1 }, undef ); #3# ok( $@, "/(?i:^died at )/" ); #4# # print "# $@#\n"; ok( (Filter {chop} "test"), "tes" ); #5# ok( (Filter {chop} "test","me"), "tesm" ); #6# ok( (Filter {y/a-z/A-Z/} "x","y"), "XY" ); #7# { my @list= ( '', qw/ a bc d / ); ok( (Filter {s/(.)/\U$1/} @list), "ABcD" ); #8# my @new= Filter {$_.=@_} @list; ok( "@new", "0 a0 bc0 d0" ); #9# ok( "@list", " a bc d" ); #10# } { 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" ); #11# @new= MapCarMin {@_} [qw/ a b c /], [1..3], \@list; ok( "@new", "a 1 X b 2 Y c 3 Z" ); #12# @new= MapCarU {@_} [qw/ a b c /], [1..3], \@list; ok( "@new", "a 1 X b 2 Y c 3 Z" ); #13# @new= MapCar {@_} [qw/ a b c /], [1..3], \@list; ok( "@new", "a 1 X b 2 Y c 3 Z" ); #14# @new= MapCarMin {@_} [qw/ a b c /], [1], \@list; ok( "@new", "a 1 X" ); #15# @new= MapCarU {@_} [qw/ a b c /], [1], \@list; ok( $new[4], undef ); #16# ok( $new[7], undef ); #17# $new[4]= $new[7]= 'u'; ok( "@new", "a 1 X b u Y c u Z" ); #18# @new= MapCar {@_} [qw/ a b c /], [1], \@list; ok( "@new", "a 1 X b Y c Z" ); #19# } ok( 0+NestedLoops( [[]], sub{1} ), 0 ); #20# { my @res= NestedLoops( [ [2,3], [5,7], [11,13], ], sub { pop() * pop() * pop(); }, ); ok( "@res", #21# "110 130 154 182 165 195 231 273" ); my $res= NestedLoops( [ [1..2], [1..5], [1..7], ], sub { @_ }, ); ok( $res, 2*3*5*7 ); #22# @res= NestedLoops( [ [1..2], [1..5], [1..7], ], { OnlyWhen => 1 }, sub { join '', @_ }, ); ok( 0+@res, 2*(1+5*(1+7)) ); #23# $res= NestedLoops( [ [1..2], [1..5], [1..7], ], { OnlyWhen => 1 }, sub { @_ }, ); ok( $res, 2*(1+5*(2+3*7)) ); #24# my $len= 3; #my $t= time(); my $cnt= 0; for( '0'x$len..'9'x$len ) { $cnt++ if ! /(.).*\1/; } #print "# regex: ", time()-$t, "s ($cnt)\n"; #my $t= time(); #for( 0..9 ) { # for( 0..9 ) { # for( 0..9 ) { # for( 0..9 ) { # for( 0..9 ) { # $cnt+=0 if ! /(.).*\1/; # } # } # } # } #} #print "# loops: ", time()-$t, "s\n"; #$t= time(); my $iter= NestedLoops( [ [0..9], ( sub { [$_+1..9] } ) x ($len-1), ], ); $res= 0; my @list; while( @list= $iter->() ) { do { $res++; } while( NextPermute(@list) ); } #print "# outside: ", time()-$t, "s\n"; ok( $res, $cnt ); #25# #$t= time(); $res= NestedLoops( [ [0..9], ( sub { my %used; @used{@_}= (1) x @_; return [ grep !$used{$_}, 0..9 ]; } ) x ($len-1), ], sub { 1 }, ); #print "# used: ", time()-$t, "s\n"; ok( $res, $cnt ); #26# #$t= time(); #$res= NestedLoops( # [ [0..9], # ( sub { [$_+1..9] } ) x 2, # ], # { Permute => 1 }, # sub { 1 }, #); #print "# permute: ", time()-$t, "s\n"; #ok( $res, $cnt ); #x# #$t= time(); #$res= NestedLoops( # [ [0..9], # ( sub { [$_+1..9] } ) x 2, # ], # { PermuteNum => 1 }, # sub { 1 }, #); #print "# numperm: ", time()-$t, "s\n"; #ok( $res, $cnt ); #x# # regex: 3s (30240) # loops: 7s # outside: 28s # permute: 37s # numperm: 38s } __END__ # This code fixes up test numbers above. # Use: perl -x t/basic.t #!/usr/bin/perl -i.tmp -p BEGIN { @ARGV= $0 } s/(?<=#)\d+(?=#)/++$test/ge
Note that it has a quite different way of including the second script that updates the test number comments in the "real" part of the script.
- tyeIn reply to Re: Algorithm::Loops released (tests)
by tye
in thread Algorithm::Loops released
by tye
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |