aboutsummaryrefslogtreecommitdiff
path: root/challenge-099/duncan-c-white/opt2-separateRunX/TestMatch.pm
blob: 9cfac08f40afd5ec154d5251a62177a2335bf182 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
package TestMatch;

use strict;
use warnings;
use feature 'say';
use Data::Dumper;
use Function::Parameters;
use Test::More;

use Exporter;
our @ISA = qw(Exporter);

our @EXPORT_OK = qw(match_tests); # Export on demand

use lib qw(.);
use API;

my $debug = 0;

sub setdebug { my($d) = @_; $debug = $d; }


#
# match_tests( $patmatch );
#	Do a load of match tests using the $patmatch->() function, using the
#	pattern only for info: we are really matching the string against
#	the api list.
#
fun match_tests( $patmatch )
{
	# format of each match test: S:P:API(p):expmatch:expmt
	my @matchtests = (
		"abcde:abcde:Tslen=5,A'abcde' 0->a:1:",
		"abcdef:abcde:Tslen=5,A'abcde' 0->a:0:",
		"abcde:abcdef:Tslen=6,A'abcdef' 0->a:0:",
		"abcde:*:C 0 slen-1:1:abcde",
		"abcde:a*e:A'a' 0->a,A'e' slen-1->e,Te>a,C a+1 e-1:1:bcd",
		"abcde:abc*de:A'abc' 0->a,A'de' slen-2->d,Td>a+2,C a+3 d-1:1:__empty__",
		"abcde:a*d:A'a' 0->a,A'd' slen-1->d,Td>a-1,C a+1 d-1:0:",
		"abcde:?b*d:A'd' slen-1->d,A'b' 1->b,C 0,C b+1 d-1:0:",
		"abcde:?b*e:A'e' slen-1->e,A'b' 1->b,C 0,C b+1 e-1:1:a,cd",
		"abcde:a*c?e:A'a' 0->a,A'e' slen-1->e,A'c' e-2->c,".
			"C a+1 c-1,C c+1:1:b,d",
		"hellotherehowareyou:*ll*u:A'u' slen-1->u,M'll' 0->l,Tu>=l,".
		"C 0 l-1,C l+2 u-1:1:he,otherehowareyo",	# my example..
	);

	#say "matchtests=". Dumper(\@matchtests);
	foreach my $test (@matchtests)
	{
		#say "test $test";
		my( $s, $p, $api, $expmatch, $expmts ) = split( /:/, $test );
		$expmatch //= '0';
		my @expectedmt = map { /^__empty__$/ ? '' : $_ }
			split(/,/,$expmts);
		my @api = API::parse( $api );
		my( $match, @mt ) = $patmatch->( $s, @api );
		#say "p=$p, s=$s, match=$match, mt=".Dumper(\@mt);
		is( $match, $expmatch, "match($s,$p)=$expmatch" );
		if( $match )
		{
			my $nmatch = @expectedmt;
			is( scalar(@mt), $nmatch,
				"match($s,$p).#mt==$nmatch" );
			foreach my $i (0..$#mt)
			{
				is( $mt[$i], $expectedmt[$i],
				    "match($s,$p).mt[$i]==$expectedmt[$i]" );
			}
		}
	}
}


1;