#!/usr/bin/perl -w # for Math::String::Charset::Nested.pm use Test; use strict; BEGIN { $| = 1; unshift @INC, '../lib'; # to run manually chdir 't' if -d 't'; plan tests => 93; } use Math::String::Charset; use Math::String::Charset::Nested; $Math::String::Charset::Nested::die_on_error = 0; # we better catch them $Math::String::Charset::die_on_error = 0; # we better catch all my $a; ############################################################################### # some valid input combinations via Charset, and the same directly my $c = 'Math::String::Charset::Nested'; for my $c (qw/ Math::String::Charset Math::String::Charset::Nested/) { $a = $c->new( { type => 3 } ); ok ($a->error(),"Illegal type '3'"); $a = Math::String::Charset->new( { type => -1 } ); ok ($a->error(),"Illegal type '-1'"); # Not via grouped # $a = $c->new( { order => 2, type => 1 } ); # ok ($a->error(),"Illegal combination of type '1' and order '2'"); $a = $c->new( { order => 3, type => 0 } ); ok ($a->error(),"Illegal order '3'"); $a = $c->new( { type => 0, sets => 'foo' } ); ok ($a->error(),"Illegal type '0' used with 'sets'"); # $a = $c->new( { type => 1, sep => 'foo' } ); # ok ($a->error(),"Illegal type '1' used with 'sep'"); # $a = $c->new( { type => 1, bi => 'foo' } ); # ok ($a->error(),"Illegal type '1' used with 'bi'"); } ############################################################################### # bi grams # check ones (cross from start/end) and restricting of start $a = Math::String::Charset->new( { start => ['b','c','a', 'q' ], bi => { 'a' => [ 'b', 'c', 'a' ], 'b' => [ 'c', 'b' ], 'c' => [ 'a', 'c' ], 'q' => [ ] # can't be in start }, end => [ 'b','c','a' ], } ); ok ($a->error(),""); ok ($a->isa('Math::String::Charset')); ok (ref($a),$c); ok ($a->class(1),4); # b,c,a,q ok (join(' ',$a->ones()),"b c a q"); ok (join(' ',$a->start()),"b c a"); # q can't be in start, has no followers ok ($a->is_valid('bca'),1); ok ($a->is_valid('dca'),0); # illegal start ok ($a->is_valid('abcd'),0); # illegal end/character ok ($a->is_valid('bac'),0); # illegal bigram 'ba' ok ($a->is_valid('bcb'),0); # illegal bigram 'cb' ok ($a->is_valid('bcabq'),0); # illegal bigram 'bq' ok ($a->is_valid('qa'),0); # illegal bigram 'qa' ok ($a->error(),""); $a = Math::String::Charset->new( { start => ['b','c','a'], bi => { 'a' => [ 'b', 'c', 'a' ], 'b' => [ 'c', 'b' ], 'c' => [ 'a', 'c' ] } } ); ok ($a->error(),""); ok ($a->length(),3); ok (scalar $a->end(),3); my $ok = 0; my $aa = [ 'b','c','a' ]; my @ab = $a->start(); for (my $i = 0; $i < @$aa; $i++) { $ok ++ if $aa->[$i] ne $ab[$i]; } ok ($ok,0); ok ($a->class(1),3); # b,c,a ok ($a->class(2),7); # bc # bb # ca # cc # ab # ac # aa ok ($a->class(3),3*2+2*2+2*3); # 7 combos: # 3 of them end in c => 3 * 2 # 2 of them end in b => 2 * 2 # 2 of them end in a => 2 * 3 # sum: 16 # result: # bca # bcc # bbc # bbb # cab # cac # caa # cca # ccc # abc # abb # aca # acc # aab # aac # aaa ok ($a->class(4),5*3+7*2+4*2); # 16 combos: # 5 times a: 5 * 3 # 7 times c: 7 * 2 # 4 times b: 4 * 2 # sum: 37 ok ($a->str2num(''),0); ok ($a->str2num('b'),1); ok ($a->str2num('c'),2); ok ($a->str2num('a'),3); # check sum of strings starting with a certain string $a->_calc(4); ok ($a->{_scnt}->[1]->{a},1); ok ($a->{_scnt}->[1]->{c},1); ok ($a->{_scnt}->[1]->{b},1); ok ($a->{_scnt}->[2]->{a},3); ok ($a->{_scnt}->[2]->{b},2); ok ($a->{_scnt}->[2]->{c},2); ok ($a->{_scnt}->[3]->{a},7); ok ($a->{_scnt}->[3]->{b},4); ok ($a->{_scnt}->[3]->{c},5); ok ($a->{_scnt}->[4]->{a},16); ok ($a->{_scnt}->[4]->{b},9); ok ($a->{_scnt}->[4]->{c},12); # sum no longer calculated #print "sum 1\n"; #ok ($a->{_ssum}->[1]->{b},0); #ok ($a->{_ssum}->[1]->{c},1); #ok ($a->{_ssum}->[1]->{a},2); #print "sum 2\n"; #ok ($a->{_ssum}->[2]->{b},0); #ok ($a->{_ssum}->[2]->{c},2); #ok ($a->{_ssum}->[2]->{a},4); ##print "sum 3\n"; #ok ($a->{_ssum}->[3]->{b},0); #ok ($a->{_ssum}->[3]->{c},4); #ok ($a->{_ssum}->[3]->{a},9); # print "sum 4\n"; #ok ($a->{_ssum}->[4]->{b},0); #ok ($a->{_ssum}->[4]->{c},9); #ok ($a->{_ssum}->[4]->{a},21); ############################################################################### # restricting ending chars $a = Math::String::Charset->new( { start => ['b','c','a'], bi => { 'a' => [ 'b', 'c', 'a' ], 'b' => [ 'c', 'b' ], 'c' => [ 'a', 'c' ], 'q' => [ ], } } ); ok ($a->error(),""); ok ($a->length(),3); # a,b,c ok (scalar $a->end(),4); # a,b,c,q $a = Math::String::Charset->new( { start => ['b','c','a'], bi => { 'a' => [ 'b', 'c', 'a' ], 'b' => [ 'c', 'b' ], 'c' => [ 'a', 'c', 'x' ], 'q' => [ ], }, end => [ 'a', 'b' ], } ); ok ($a->error(),""); ok ($a->length(),2); # a,b ok (scalar $a->end(),4); # a,b,q,x # check sum of strings starting with a certain string $a->_calc(4); ok ($a->{_scnt}->[1]->{a},1); ok_undef ($a->{_scnt}->[1]->{c}); ok ($a->{_scnt}->[1]->{b},1); ok ($a->{_scnt}->[2]->{a},2); # ab, aa (ac is invalid) ok ($a->{_scnt}->[2]->{b},1); # bb (bc is invalid) ok ($a->{_scnt}->[2]->{c},2); # ca, cx (cc is invalid) # check last(), first() $a = Math::String::Charset->new( { start => ['b','c','a','i'], bi => { 'a' => [ 'c', 'b' ], 'b' => [ 'c', 'b','j' ], 'c' => [ 'a', 'c', 'x' ], 'q' => [ ], 'j' => [ ], }, end => [ 'a', 'b', 'c', 'j' ], } ); ok (ref($a),$c); ok ($a->isa('Math::String::Charset')); ok ($a->error(),""); ok (join(' ',$a->ones()),'b c a'); ok ($a->first(0),''); ok ($a->last(0), ''); ok ($a->first(1),'b'); # ones: b,c,a ok ($a->last(1), 'a'); # ones: b,c,a ok ($a->first(2),'bc'); ok ($a->last(2), 'ab'); ok ($a->first(3),'bca'); ok ($a->last(3), 'abj'); ok ($a->first(4),'bcac'); ok ($a->last(4), 'abbj'); ok ($a->first(5),'bcaca'); ok ($a->last(5), 'abbbj'); $a = Math::String::Charset->new( { start => ['b','c','a','i'], bi => { 'a' => [ 'q', 'j', 'b' ], 'b' => [ 'c', 'b','j' ], 'c' => [ 'a', 'c', 'x' ], 'q' => [ ], 'j' => [ 'b' ], }, end => [ 'a', 'b', 'c', 'j' ], minlen => 2, maxlen => 5, } ); ok ($a->error(),""); ok_undef ($a->first(0)); ok_undef ($a->last(0)); ok_undef ($a->first(1)); ok_undef ($a->last(1)); ok ($a->first(2),'bc'); ok ($a->last(2),'ab'); ok ($a->first(3),'bca'); ok ($a->last(3),'abj'); ok ($a->first(4),'bcaq'); ok ($a->first(5),'bcajb'); ok_undef ($a->first(6)); # XXX: counts in class #ok ($a->class(2),9); # bc, bb, bj, ca, cc, cj, aq, aj, ab #ok ($a->class(3),17); #ok ($a->class(4),36); ############################################################################### # normalize (no-op) ok ($a->norm('hocus'),'hocus'); ############################################################################### # scale $a = $c->new( { start => ['b','c','a','i'], bi => { 'a' => [ 'q', 'j', 'b' ], 'b' => [ 'c', 'b','j' ], 'c' => [ 'a', 'c', 'x' ], 'q' => [ ], 'j' => [ 'b' ], }, scale => 2 } ); ok ($a->error(),""); ok ($a->scale(),2); ############################################################################### # copy $b = $a->copy(); ok (ref($b), $c); ok ($b->error(),""); ok ($b->isa('Math::String::Charset')); ok ($b->isa($c)); ############################################################################### # Perl 5.005 does not like ok ($x,undef) sub ok_undef { my $x = shift; $x = $x->bstr() if ref($x); ok (1,1) and return if !defined $x; ok ($x,'undef'); }