The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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');
  }