1#! /usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More; 7 8BEGIN { 9 binmode Test::More->builder->output, ':utf8'; 10 binmode Test::More->builder->failure_output, ':utf8'; 11} 12 13my $alphabet = join '', map { chr } 32 .. 126; 14 15my %tmfa = ( 16 null => [], 17 empty => [ '' ], 18 a => [ 'a' ], 19 alphabet => [ $alphabet ], 20 prefixes => [ qw<foo foobar> ], 21 section => [ "\xA7" ], 22); 23 24my @tests = ( 25 [null => 0, '', 0], 26 [null => 1, '', 0], 27 [null => 2, '', 0], 28 [null => 0, 'foo', 0], 29 [null => 1, 'foo', 0], 30 [null => 2, 'foo', 0], 31 [null => 3, 'foo', 0], 32 [null => 4, 'foo', 0], 33 [empty => 0, '', 1], 34 [empty => 1, '', 0], 35 [empty => 2, '', 0], 36 [empty => 0, 'foo', 1], 37 [empty => 1, 'foo', 1], 38 [empty => 2, 'foo', 1], 39 [empty => 3, 'foo', 1], 40 [empty => 4, 'foo', 0], 41 [a => 0, '', 0], 42 [a => 1, '', 0], 43 [a => 0, 'a', 1], 44 [a => 1, 'a', 0], 45 [a => 2, 'a', 0], 46 [a => 0, $alphabet, 0], 47 [a => 1, $alphabet, 0], 48 [a => 2, $alphabet, 0], 49 [a => 64, $alphabet, 0], 50 [a => 65, $alphabet, 1], 51 [a => 66, $alphabet, 0], 52 [a => 95, $alphabet, 0], 53 [a => 96, $alphabet, 0], 54 [a => 97, $alphabet, 0], 55 [alphabet => 0, '', 0], 56 [alphabet => 1, '', 0], 57 [alphabet => 0, $alphabet, 1], 58 [alphabet => 1, $alphabet, 0], 59 [alphabet => 0, "$alphabet.", 1, 'right-padded alphabet'], 60 [alphabet => 1, "$alphabet.", 0, 'right-padded alphabet'], 61 [alphabet => 0, ".$alphabet", 0, 'left-padded alphabet'], 62 [alphabet => 1, ".$alphabet", 1, 'left-padded alphabet'], 63 [alphabet => 2, ".$alphabet", 0, 'left-padded alphabet'], 64 [alphabet => 0, ".$alphabet.", 0, 'left-padded alphabet'], 65 [alphabet => 1, ".$alphabet.", 1, 'both-padded alphabet'], 66 [alphabet => 2, ".$alphabet.", 0, 'both-padded alphabet'], 67 [prefixes => 0, '', 0], 68 [prefixes => 1, '', 0], 69 [prefixes => 0, 'f', 0], 70 [prefixes => 0, 'fo', 0], 71 [prefixes => 0, 'foo', 1], 72 [prefixes => 0, 'foob', 1], 73 [prefixes => 0, 'fooba', 1], 74 [prefixes => 0, 'foobar', 1], 75 [prefixes => 0, 'foobarx', 1], 76 [prefixes => 1, '', 0], 77 [prefixes => 1, 'f', 0], 78 [prefixes => 1, 'fo', 0], 79 [prefixes => 1, 'foo', 0], 80 [prefixes => 1, 'foob', 0], 81 [prefixes => 1, 'fooba', 0], 82 [prefixes => 1, 'foobar', 0], 83 [prefixes => 1, 'foobarx', 0], 84 [section => 0, '', 0], 85 [section => 1, '', 0], 86 [section => 0, 'foo', 0], 87 [section => 0, "\xA7.1.2", 1], 88 [section => 1, "\xA7.1.2", 0], 89 [section => 0, " \xA7.1.2", 0], 90 [section => 1, " \xA7.1.2", 1], 91 [section => 0, "\xA9\xA7", 0], 92 [section => 1, "\xA9\xA7", 1], 93 [section => 2, "\xA9\xA7", 0], 94 [section => 3, "\xA9\xA7", 0], 95 [section => 4, "\xA9\xA7", 0], 96); 97 98plan tests => 1 + @tests; 99 100use_ok('Text::Match::FastAlternatives'); 101 102$_ = Text::Match::FastAlternatives->new(@$_) for values %tmfa; 103 104for my $t (@tests) { 105 my ($matcher, $pos, $target, $expected, $noun) = @$t; 106 $noun ||= $target eq '' ? 'empty string' 107 : $target eq $alphabet ? 'alphabet' 108 : "'$target'"; 109 my $message = $expected ? "$matcher matches $noun at $pos" 110 : "$matcher doesn't match $noun at $pos"; 111 my $result = $tmfa{$matcher}->match_at($target, $pos); 112 ok(!$result == !$expected, $message); 113} 114