From: Mischa POSLAWSKY Date: Fri, 13 Nov 2009 14:36:00 +0000 (+0100) Subject: subtests X-Git-Url: http://git.shiar.net/perl/list-index.git/commitdiff_plain/923bf7c029470b51452733cd1c17df0b1397e63b subtests --- diff --git a/t/10-ranges.t b/t/10-ranges.t index a1bb115..1ec5d60 100644 --- a/t/10-ranges.t +++ b/t/10-ranges.t @@ -2,50 +2,54 @@ use strict; use warnings; -use Test::More tests => 16; +use Test::More tests => 6; use Test::NoWarnings; use Data::Dump 'pp'; BEGIN { use_ok('List::Index'); } ok(eval { List::Index->VERSION(1) }, 'version 1.00 compatibility'); -{ -my @uniform = 'a'..'z'; -ok(my $index = List::Index->new(\@uniform), 'object (single-char values)'); -is_deeply(\@uniform, ['a'..'z'], 'original data unaltered'); -is_deeply($index->ranges, ['-'], 'single page'); -is_deeply($index->ranges({pages => 3}), [qw(-i j-q r-)], 'given pages'); -is_deeply($index->ranges({pagesize => @uniform / 2.1}), [qw( - -i j-q r- -)], 'equivalent pagesize'); -} - -{ -ok(my $index = List::Index->new(['aa'..'zz', 1..202]), 'non-alphabetic values (uniform)'); -is_deeply($index->ranges, [qw( - -. - .-bp bq-dm dn-fi fj-hf hg-i j-k l-m n-os ot-qp qq-sm sn-uj uk-wf wg-x y- - -)], 'default ranges'); -is_deeply($index->ranges({pagesize => 300}), [qw(-c d-o p-)], 'large pagesize'); -} - -{ -ok(my $index = List::Index->new([qw( - baa1 baa2 baa3 baaa bbc cbc daaa ea eaaa zed -)]), 'variable length values'); -is_deeply($index->ranges({pagesize => 2, context => 0}), [ - qw(-baa. baa.-bbb bbc-daa. daaa-eaa. eaaa-) -], 'no context'); -is_deeply($index->ranges({pagesize => 2}), [ - qw(-a b c d-ea. eaa-) -], 'default context'); # context should be 1 -is_deeply($index->ranges({pagesize => 2, context => 2}), [ - qw(-a b-c d e-) -], 'overlap'); # first item equals second due to large context -is_deeply($index->ranges({pagesize => 2, length => 1}), [ - qw(-a b-c d e-) -], 'single char'); - -#pp($index->ranges({pagesize => 2, context => 2, length => 1})); -} +subtest 'single-char alphabet' => sub { + plan tests => 4; + my @uniform = 'a'..'z'; + my $index = List::Index->new(\@uniform) or return; + is_deeply(\@uniform, ['a'..'z'], 'original data unaltered'); + is_deeply($index->ranges, ['-'], 'single page'); + is_deeply($index->ranges({pages => 3}), [qw(-i j-q r-)], 'given pages'); + is_deeply($index->ranges({pagesize => @uniform / 2.1}), [qw( + -i j-q r- + )], 'equivalent pagesize'); +}; + +subtest 'uniform alphanumeric' => sub { + plan tests => 2; + my $index = List::Index->new(['aa'..'zz', 1..202]) or return; + is_deeply($index->ranges, [qw( + -. + .-bp bq-dm dn-fi fj-hf hg-i j-k l-m n-os ot-qp qq-sm sn-uj uk-wf wg-x y- + + )], 'default ranges'); + is_deeply($index->ranges({pagesize => 300}), [qw(-c d-o p-)], 'large pagesize'); +}; + +subtest 'context' => sub { + plan tests => 4; + my $index = List::Index->new([qw( + baa1 baa2 baa3 baaa bbc cbc daaa ea eaaa zed + )]) or return; + is_deeply($index->ranges({pagesize => 2, context => 0}), [ + qw(-baa. baa.-bbb bbc-daa. daaa-eaa. eaaa-) + ], 'no context'); + is_deeply($index->ranges({pagesize => 2}), [ + qw(-a b c d-ea. eaa-) + ], 'default context'); # context should be 1 + is_deeply($index->ranges({pagesize => 2, context => 2}), [ + qw(-a b-c d e-) + ], 'overlap'); # first item equals second due to large context + is_deeply($index->ranges({pagesize => 2, length => 1}), [ + qw(-a b-c d e-) + ], 'single char'); + + #pp($index->ranges({pagesize => 2, context => 2, length => 1})); +}; + diff --git a/t/20-links.t b/t/20-links.t index 6843205..f22937a 100644 --- a/t/20-links.t +++ b/t/20-links.t @@ -2,82 +2,98 @@ use strict; use warnings; -use Test::More tests => 47; +use Test::More tests => 13; use Test::NoWarnings; use Data::Dump 'pp'; BEGIN { use_ok('List::Index' => 'rangematch'); } my @RANGETESTS = ( - # single prefix - [ q => 'q'], - ['#foo.!$' => '\#foo\.\!\$'], - [ '-' => ''], - [ '' => ''], - # end only - [ -q => '(?:(?![q-z])|q)'], - [ -qqq => '(?:(?![q-z])|q(?![q-z])|qq(?![q-z])|qqq)'], - # start only - [ 'q-' => '[q-z]'], - ['qqq-' => '(?:[r-z]|q[r-z]|qq[q-z])'], - ['zzz-' => 'zz[z-z]'], - # prefixed range - [ 'q-q' => 'q'], - [ 'qq-qq' => 'qq'], - [ 'qq-qqx' => '(?:qq(?![x-z])|qqx)'], - [ 'q-qx' => '(?:q(?![x-z])|qx)'], - # end within prefix - ['qqq-qq' => 'qq[q-z]'], - ['qqq-q' => '(?:q[r-z]|qq[q-z])'], - # interchar range - [ 'q-x' => '[q-x]'], - ['qqq-xxx' => '(?:[r-w]|q[r-z]|qq[q-z]|x(?![x-z])|xx(?![x-z])|xxx)'], - ['qqq-xqq' => '(?:[r-w]|q[r-z]|qq[q-z]|x(?![q-z])|xq(?![q-z])|xqq)'], - # interchar mixed length - ['qqq-xq' => '(?:[r-w]|q[r-z]|qq[q-z]|x(?![q-z])|xq)'], - [ 'qq-xqq' => '(?:[r-w]|q[q-z]|' . 'x(?![q-z])|xq(?![q-z])|xqq)'], - [ 'q-xxx' => '(?:[q-w]|x(?![x-z])|xx(?![x-z])|xxx)'], - ['qqq-x' => '(?:[r-x]|q[r-z]|qq[q-z])'], - ['qaa-qb' => '(?:qa[a-z]|qb)'], - ['qaa-qq' => '(?:q[b-p]|qa[a-z]|qq)'], - # reversed - [ 'x-q' => undef], - ['xxx-qqq' => undef], - ['xxx-q' => undef], - ['qqq-qc' => undef], + ['single prefix', + [ q => 'q'], + ['#foo.!$' => '\#foo\.\!\$'], + [ '-' => ''], + [ '' => ''], + ], + ['end only', + [ -q => '(?:(?![q-z])|q)'], + [ -qqq => '(?:(?![q-z])|q(?![q-z])|qq(?![q-z])|qqq)'], + ], + ['start only', + [ 'q-' => '[q-z]'], + ['qqq-' => '(?:[r-z]|q[r-z]|qq[q-z])'], + ['zzz-' => 'zz[z-z]'], + ], + ['prefixed range', + [ 'q-q' => 'q'], + [ 'qq-qq' => 'qq'], + [ 'qq-qqx' => '(?:qq(?![x-z])|qqx)'], + [ 'q-qx' => '(?:q(?![x-z])|qx)'], + ], + ['end within prefix', + ['qqq-qq' => 'qq[q-z]'], + ['qqq-q' => '(?:q[r-z]|qq[q-z])'], + ], + ['interchar range', + [ 'q-x' => '[q-x]'], + ['qqq-xxx' => '(?:[r-w]|q[r-z]|qq[q-z]|x(?![x-z])|xx(?![x-z])|xxx)'], + ['qqq-xqq' => '(?:[r-w]|q[r-z]|qq[q-z]|x(?![q-z])|xq(?![q-z])|xqq)'], + ], + ['interchar mixed length', + ['qqq-xq' => '(?:[r-w]|q[r-z]|qq[q-z]|x(?![q-z])|xq)'], + [ 'qq-xqq' => '(?:[r-w]|q[q-z]|' . 'x(?![q-z])|xq(?![q-z])|xqq)'], + [ 'q-xxx' => '(?:[q-w]|x(?![x-z])|xx(?![x-z])|xxx)'], + ['qqq-x' => '(?:[r-x]|q[r-z]|qq[q-z])'], + ['qaa-qb' => '(?:qa[a-z]|qb)'], + ['qaa-qq' => '(?:q[b-p]|qa[a-z]|qq)'], + ], + ['reversed', + [ 'x-q' => undef], + ['xxx-qqq' => undef], + ['xxx-q' => undef], + ['qqq-qc' => undef], + ], - # non-alphabetic offset - [ '.-' => ''], - ['...-' => '(?:[a-z]|[^a-z][a-z])'], - [ '.q-' => '(?:[a-z]|[^a-z][q-z])'], - [ '.q-.' => '[^a-z][q-z]'], - # limit - ['.q.-q' => '(?:[a-q]|[^a-z][q-z])'], - ['..z-q' => '(?:[a-q]|[^a-z][a-z]|[^a-z][^a-z][z-z])'], - ['.q.-z' => '(?:[a-z]|[^a-z][q-z])'], - ['.q.-zz' => '(?:[a-y]|[^a-z][q-z]|' . 'z(?![z-z])|zz)'], - ['.q..-zz' => '(?:[a-y]|[^a-z][r-z]|[^a-z]q' . '[a-z]|z(?![z-z])|zz)'], - # non-alpha limit - ['.q.-z.' => '(?:[a-y]|[^a-z][q-z]|' . 'z(?![a-z]))'], - [ '..-.' => '(?:[^a-z](?![a-z]))'], - [ '.-.' => '(?![a-z])'], - [ '-.' => '(?![a-z])'], - [ '-...' => '(?![a-z])(?!.[a-z])(?!..[a-z])'], - [ '-q.' => '(?:(?![q-z])|q(?![a-z]))'], - [ '-q..' => '(?:(?![q-z])|q(?![a-z])(?!.[a-z]))'], -# [ '..-...' => '(?:[^a-z](?![a-z])|[^a-z][^a-z](?![a-z]))'], -# [ '.-...' => '[^a-z][^a-z](?![a-z])'], - # - [ 'a-.' => undef], + ['non-alphabetic offset', + [ '.-' => ''], + ['...-' => '(?:[a-z]|[^a-z][a-z])'], + [ '.q-' => '(?:[a-z]|[^a-z][q-z])'], + [ '.q-.' => '[^a-z][q-z]'], + ], + ['limit', + ['.q.-q' => '(?:[a-q]|[^a-z][q-z])'], + ['..z-q' => '(?:[a-q]|[^a-z][a-z]|[^a-z][^a-z][z-z])'], + ['.q.-z' => '(?:[a-z]|[^a-z][q-z])'], + ['.q.-zz' => '(?:[a-y]|[^a-z][q-z]|' . 'z(?![z-z])|zz)'], + ['.q..-zz' => '(?:[a-y]|[^a-z][r-z]|[^a-z]q' . '[a-z]|z(?![z-z])|zz)'], + ], + ['non-alpha limit', + ['.q.-z.' => '(?:[a-y]|[^a-z][q-z]|' . 'z(?![a-z]))'], + [ '..-.' => '(?:[^a-z](?![a-z]))'], + [ '.-.' => '(?![a-z])'], + [ '-.' => '(?![a-z])'], + [ '-...' => '(?![a-z])(?!.[a-z])(?!..[a-z])'], + [ '-q.' => '(?:(?![q-z])|q(?![a-z]))'], + [ '-q..' => '(?:(?![q-z])|q(?![a-z])(?!.[a-z]))'], + # [ '..-...' => '(?:[^a-z](?![a-z])|[^a-z][^a-z](?![a-z]))'], + # [ '.-...' => '[^a-z][^a-z](?![a-z])'], + [ 'a-.' => undef], + ], ); for (@RANGETESTS) { - my ($in, $out) = @$_; - is( - eval { rangematch($in) }, - defined $out ? "(?i-xsm:^$out)" : undef, - (length $in ? $in : q{''}) . (!defined $out && ' failure') - ); - diag($@) if $@; + my ($name, @tests) = @$_; + subtest $name => sub { + plan tests => scalar @tests; + for (@tests) { + my ($in, $out) = @$_; + is( + eval { rangematch($in) }, + defined $out ? "(?i-xsm:^$out)" : undef, + (length $in ? $in : q{''}) . (!defined $out && ' failure') + ); + diag($@) if $@; + } + }; }