#!/usr/bin/perl -w
# for Math::String::Charset.pm (simple set)
use Test;
use strict;
BEGIN
{
$| = 1;
unshift @INC, '../lib'; # to run manually
chdir 't' if -d 't';
plan tests => 155;
}
use Math::String::Charset;
$Math::String::Charset::die_on_error = 0; # we better catch them
my $a;
my $c = 'Math::String::Charset';
###############################################################################
# invalid input combinations
$a = $c->new( { type => 3 } );
ok ($a->error(),"Illegal type '3'");
$a = $c->new( { type => -1 } );
ok ($a->error(),"Illegal type '-1'");
$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, bi => 'foo' } );
ok ($a->error(),"Illegal type '1' used with 'bi'");
$a = $c->new( { order => 1, type => 0, end => ' ' } );
ok ($a->error(),"Illegal combination of order '1' and 'end'");
$a = $c->new( { charlen => 2, sep => 'a' } );
ok ($a->error(),"Can not have both 'sep' and 'charlen' in new()");
$a = $c->new( { bi => {}, sets => 'b' } );
ok ($a->error(),"Can not have both 'bi' and 'sets' in new()");
###############################################################################
# simple charset's
$a = $c->new( ['a'..'z'] );
ok ($a->error(),"");
ok ($a->order(),1); ok ($a->type(),0);
my $ok = 0;
my $aa = [ 'a'..'z' ];
my @ab = $a->start();
for (my $i = 0; $i < @$aa; $i++)
{
$ok ++ if $aa->[$i] ne $ab[$i];
}
ok ($ok,0);
ok ($a->length(),26);
$a = $c->new( ['a'..'c'] );
ok ($a->error(),"");
ok ($a->length(),3);
ok ($a->class(0),1);
ok ($a->class(1),3);
ok ($a->class(2),3*3);
ok ($a->class(3),3*3*3);
ok ($a->class(4),3*3*3*3);
ok ($a->first(),'');
ok ($a->last(),'');
ok ($a->first(0),'');
ok ($a->last(0),'');
ok ($a->first(1),'a');
ok ($a->last(1),'c');
ok ($a->first(2),'aa');
ok ($a->last(2),'cc');
ok ($a->first(3),'aaa');
ok ($a->last(3),'ccc');
ok ($a->lowest(1),1);
ok ($a->lowest(2),1+3);
ok ($a->lowest(3),1+3+3*3);
ok ($a->lowest(4),1+3+3*3+3*3*3);
ok ($a->highest(1),3);
ok ($a->highest(2),3+3*3);
ok ($a->highest(3),3+3*3+3*3*3);
ok ($a->highest(4),3+3*3+3*3*3+3*3*3*3);
ok ($a->str2num(''),0);
ok ($a->str2num('a'),1);
ok ($a->str2num('aa'),1+3);
ok ($a->str2num('aaa'),1+3+3*3);
ok ($a->str2num('cba'),1+2*3+3*3*3);
ok ($a->num2str(0),'');
ok ($a->num2str(1),'a');
ok ($a->num2str(2),'b');
ok ($a->num2str(3),'c');
ok ($a->num2str(1+2),'c');
ok ($a->num2str(1+3),'aa');
ok ($a->num2str(1+3+2*3+2),'cc');
ok ($a->num2str(1+3+3*3),'aaa');
ok ($a->num2str(1+3+2*3*3),'baa');
ok ($a->num2str(1+2*3+3*3*3),'cba');
# is valid
ok_undef ($a->{_sep});
ok ($a->is_valid('abcbca'),1);
ok ($a->is_valid(),0); # undef string is never valid
ok ($a->is_valid('abcxbca'),0);
ok ($a->is_valid('abcx'),0);
ok ($a->is_valid('xabca'),0);
ok ($a->is_valid('a'),1);
###############################################################################
# char()
ok ($a->char(0),'a');
ok ($a->char(1),'b');
ok ($a->char(-1),'c');
ok_undef ($a->char(3));
# map()
ok ($a->map('a'),0);
ok_undef ($a->map('ab'));
ok ($a->map('b'),1);
ok ($a->map('c'),2);
ok_undef ($a->map('d'));
# check charlength
$a = $c->new( ['a','b','foo','c'] );
if ($a->error() !~ /Illegal.*char.*length.*not/)
{
ok ($a->error(),"not '" . $a->error() . "'");
}
else
{
ok (1,1);
}
$a = $c->new( ['foo','bar','baz'] );
ok ($a->error(),'');
ok ($a->char(0),'foo');
ok ($a->char(1),'bar');
ok ($a->char(-1),'baz');
ok ($a->num2str(1),'foo');
ok ($a->num2str(2),'bar');
ok ($a->num2str(3),'baz');
ok ($a->num2str(3+1),'foofoo');
ok ($a->str2num('foo'),1);
ok ($a->str2num('foofoo'),1+3);
ok ($a->str2num('foobaz'),1+3+2);
ok ($a->str2num('barfoo'),1+3+3);
ok ($a->is_valid('barfoo'),1);
ok ($a->is_valid('barfoobar'),1);
ok ($a->is_valid('barfotbar'),0);
ok ($a->is_valid('barfoofot'),0);
ok ($a->is_valid('fotbarfoo'),0);
ok ($a->is_valid('bar'),1);
ok ($a->is_valid(''),1);
ok ($a->is_valid('fuh'),0);
###############################################################################
# first/last with sep char
$a = $c->new( { start => ['a'..'z'], sep => '-' } );
ok ($a->first(0),''); ok ($a->last (0),'');
ok ($a->first(1),'a'); ok ($a->last (1),'z');
ok ($a->first(2),'a-a'); ok ($a->last (2),'z-z');
ok ($a->first(3),'a-a-a'); ok ($a->last (3),'z-z-z');
$a = $c->new( { start => [qw/FOO BAR/], sep => '-' } );
ok ($a->first(0),''); ok ($a->last (0),'');
ok ($a->first(1),'FOO'); ok ($a->last (1),'BAR');
ok ($a->first(2),'FOO-FOO'); ok ($a->last (2),'BAR-BAR');
ok ($a->first(3),'FOO-FOO-FOO'); ok ($a->last (3),'BAR-BAR-BAR');
###############################################################################
# min/max len
$a = $c->new( { start => ['f','o','o'] } );
ok ($a->error(),''); ok ($a->minlen(),'-inf'); ok ($a->maxlen(),'inf');
$a = $c->new( { start => ['f','o','o'],
minlen => 2, maxlen => 4, } );
ok ($a->error(),''); ok ($a->minlen(),2); ok ($a->maxlen(),4);
ok ($a->is_valid('fooo'),1);
ok ($a->is_valid('foo'),1);
ok ($a->is_valid('fo'),1);
ok ($a->is_valid(''),0); # 0 is smaller than minlen
ok ($a->is_valid('f'),0);
ok ($a->is_valid('fooof'),0);
$a = $c->new( { start => ['f','o','o'],
minlen => 2, maxlen => 1, } );
ok ($a->error(),'Maxlen is smaller than minlen!');
###############################################################################
# simple charset's with sep char
ok_undef ($a->{_sep});
$a = $c->new( { start => ['hans','mag','blumen'],
sep => ' ',} );
ok ($a->{_sep},' ');
ok ($a->{_order},1);
ok ($a->num2str(3+1),'hans hans');
ok ($a->str2num('hans hans'),3+1);
ok ($a->str2num('hans hans hans'),3+3*3+1);
ok ($a->str2num('hans mag blumen'),3+3*3+6);
# front/end stripping
ok ($a->str2num(' hans mag blumen'),3+3*3+6);
ok ($a->str2num('hans mag blumen '),3+3*3+6);
ok ($a->str2num(' hans mag blumen '),3+3*3+6);
$a = $c->new( { start => ['foooo','bar','buuh'],
sep => ' ',} );
ok ($a->error(),"");
ok ($a->is_valid('foooo bar buuh'),1);
ok ($a->is_valid('fooo bar buuh'),0);
ok ($a->is_valid(' foooo bar buuh bar buuh '),1);
$a = $c->new( { start => ['foo','bar'], sep => '',} );
ok ($a->error(),"Field 'sep' must not be empty");
###############################################################################
# normalize
$a = $c->new( { start => ['foo','bar'], sep => ' ',} );
ok ($a->norm(' foo bar '),'foo bar');
ok ($a->norm('foo bar '), 'foo bar');
ok ($a->norm(' foo bar'), 'foo bar');
ok ($a->norm('foo bar'), 'foo bar');
$a = $c->new( { start => ['foo','bar'],} );
ok ($a->norm('foo bar baz'), 'foo bar baz'); # no check for validity
###############################################################################
# map
$a = $c->new( ['0'..'9'] );
for ('0'..'9')
{
ok ($a->map($_),$_);
}
###############################################################################
# scale
$a = $c->new( { start => ['a'..'z'], 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'));
###############################################################################
# Perl 5.005 does not like ok ($x,undef)
sub ok_undef
{
my $x = shift;
ok (1,1) and return if !defined $x;
ok ($x,'undef');
}