t/stringpm.t - metacpan.org

#!/usr/bin/perl -w

use strict;
use Test;

BEGIN 
  { 
  $| = 1;
  chdir 't' if -d 't';
  unshift @INC, '../blib/arch';
  unshift @INC, '../lib';			# to run manually
  plan tests => 266;
  }

use Math::String;
use Math::BigInt;

my (@args,$try,$rc,$x,$y,$z,$i);
$| = 1;
while (<DATA>) 
  {
  chop;
  @args = split(/:/,$_,99);

  # print join(' ',@args),"\n";
  # test String => Number
  $try = "\$x = Math::String->new('$args[0]', [ $args[1] ] )->bstr()";
  $rc = eval $try; 

  # stringify returns undef instead of NaN
  if ($args[2] eq 'NaN')
    {
    print "# For '$try'\n" if (!ok_undef($rc));
    }
  else
    {
    print "# For '$try'\n" if (!ok "$rc" , $args[2]);
    }
 
  # test Number => String
  next if $args[2] eq 'NaN'; # dont test NaNs reverse 
  $try = "\$x = Math::String::from_number('$args[3]', [ $args[1] ]);";
              
  $rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , "$args[0]");
  
  # test output as_number()
  if (defined $args[3])
    {
    $try = "\$x = Math::String->new('$args[0]', [ $args[1] ] )->as_number()";
    $rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , $args[3]);
    }
  # test is_valid()
  $try  = "\$x = Math::String->new('$args[0]',[ $args[1] ]);";
  $try .= "\$x = \$x->is_valid();";
  $rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , 1);

  }
close DATA;

##############################################################################
# check wether cmp and <=> work
$x = Math::String->new ('a');	# 1
$y = Math::String->new ('z');	# 26
$z = Math::String->new ('a');	# 1 again

ok ($x < $y, 1);	# ok (1 < 26, 1)
ok ($x > $y, '');	# ok (1 > 26, '')
ok ($x <=> $y, -1); 	# ok (1 <=> 26, -1)
ok ($y <=> $x, 1); 	# ok (26 <=> 1, 1)
ok ($x <=> $x, 0); 	# ok (1 <=> 1, 1)
ok ($x <=> $z, 0); 	# ok (1 <=> 1, 1)

ok ($x lt $y, 1); 	# ok ('a' lt 'z', 1);
ok ($x gt $y, '');	# ok ('z' lt 'a', '');
ok ($x cmp $y, -1);	# ok ('a' cmp 'z', -1);
ok ($y cmp $x, 1);	# ok ('z' cmp 'a', 1);
ok ($x cmp $x, 0);
ok ($x cmp $z, 0);

# overloading of <, <=, =>, >, <=>, ==, !=
$x = Math::String->new('a'); 
ok ($x == 'a',1); ok ($x != '',1);

##############################################################################
# check if negative numbers give same output as positives
$try =  "\$x = Math::String::from_number(-12, ['0'..'9']); \$x->as_number();";
$rc = eval $try;
print "# For '$try'\n" if (!ok "$rc" , '-12');
$try =  '$x = Math::String::from_number(-12,["0".."9"]);';
$try .= '$y = Math::String::from_number(12,["0".."9"]); "true" if "$x" eq "$y";';
$rc = eval $try;
print "# For '$try'\n" if (!ok "$rc" , 'true');

##############################################################################
# check wether ++ and -- work
$try =  '$x = Math::String->new("z",["a".."z"]);';
$try =  '$y = $x; $y++; "true" if $x < $y;';

$rc = eval $try;
print "# For '$try'\n" if (!ok "$rc" , 'true');
  
$try =  '$x = Math::String->new("z",["a".."z"]);';
$try =  '$y = $x; $y++; $y--; "true" if $x == $y;';
$rc = eval $try;
print "# For '$try'\n" if (!ok "$rc" , 'true');

###############################################################################
# stress-test ++ and -- since they use caching

# compare to build in ++
$x = Math::String->new('');
ok ($x,''); $a = 'a'; for ($i = 0; $i < 27; $i++) { ok (++$x,$a++); }

# inc/dec with sep chars
$x = Math::String->new('', Math::String::Charset->new( { 
  start => ['foo', 'bar', 'baz' ], sep => ' ' } ));
ok ($x,''); 
ok (++$x,'foo');
ok (++$x,'bar');
ok (++$x,'baz');
ok (++$x,'foo foo');
ok (++$x,'foo bar');
ok (++$x,'foo baz');
ok (++$x,'bar foo');
ok (++$x,'bar bar');
ok ($x,'bar bar');
ok (--$x,'bar foo');
ok (--$x,'foo baz');
ok (--$x,'foo bar');
ok (--$x,'foo foo');
ok (--$x,'baz');
ok (--$x,'bar');
ok (--$x,'foo');
ok (--$x,'');
ok (--$x,'foo');		# -1, negative
ok (--$x,'bar');		# -2, negative
ok (--$x,'baz');		# -3, negative
ok (--$x,'foo foo');		# -4, negative
ok (--$x,'foo bar');		# -5, negative
ok (--$x,'foo baz');		# -6, negative
ok (--$x,'bar foo');		# -7, negative
ok (--$x,'bar bar');		# -8, negative
ok (--$x,'bar baz');		# -9, negative
ok (--$x,'baz foo');		# -10, negative
ok (--$x,'baz bar');		# -11, negative
ok (--$x,'baz baz');		# -12, negative
ok (--$x,'foo foo foo');	# -13, negative
ok (--$x,'foo foo bar');	# -14, negative
ok (--$x,'foo foo baz');	# -15, negative
ok (--$x,'foo bar foo');	# -16, negative

# for minlen
$x = Math::String->new('', Math::String::Charset->new( { 
  start => ['a', 'b', 'c' ], minlen => 2, } ));
ok_undef ($x);

$x = Math::String->new('aa', Math::String::Charset->new( { 
  start => ['a', 'b', 'c' ], minlen => 2, } ));
ok ($x,'aa');		# smallest possible
ok_undef (--$x,'hm2'); 

##############################################################################
# extended tests for inc/dec with sep chars

$x = Math::String->new('', Math::String::Charset->new( { 
  start => ['foo', 'bar', 'baz', 'bon', 'bom' ], sep => ' ' } ));
ok ($x,''); 
ok (++$x,'foo');
ok (++$x,'bar');
ok (++$x,'baz');
ok (++$x,'bon');
ok (++$x,'bom');
ok (++$x,'foo foo');
ok (++$x,'foo bar');
ok (++$x,'foo baz');
ok (++$x,'foo bon');
ok (++$x,'foo bom');
ok (++$x,'bar foo');
ok (++$x,'bar bar');

ok (--$x,'bar foo');
ok (--$x,'foo bom');
ok (--$x,'foo bon');
ok (--$x,'foo baz');
ok (--$x,'foo bar');
ok (--$x,'foo foo');
ok (--$x,'bom');
ok (--$x,'bon');
ok (--$x,'baz');
ok (--$x,'bar');
ok (--$x,'foo');
ok (--$x,'');			# 0

ok (--$x,'foo');
ok (--$x,'bar');
ok (--$x,'baz');
ok (--$x,'bon');
ok (--$x,'bom');
ok (--$x,'foo foo');
ok (--$x,'foo bar');
ok (--$x,'foo baz');
ok (--$x,'foo bon');
ok (--$x,'foo bom');
ok (--$x,'bar foo');
ok (--$x,'bar bar');

# next() for negative strings:

ok (++$x,'bar foo');
ok (++$x,'foo bom');
ok (++$x,'foo bon');
ok (++$x,'foo baz');
ok (++$x,'foo bar');
ok (++$x,'foo foo');
ok (++$x,'bom');
ok (++$x,'bon');
ok (++$x,'baz');
ok (++$x,'bar');

##############################################################################
# check wether bior(),bxor(), band() word
$x = Math::String->new("a");
$y = Math::String->new("b"); $z = $y | $x;
print "# For '\$z = $y | $x'\n" if (!ok "$z" , 'c');

$x = Math::String->new("b");
$y = Math::String->new("c"); $z = $y & $x;
print "# For '\$z = $y & $x'\n" if (!ok "$z" , 'b');

$x = Math::String->new("d");
$y = Math::String->new("e"); $z = $y ^ $x;
print "# For '\$z = $y ^ $x'\n" if (!ok "$z" , 'a');

##############################################################################
# check objectify of additional params

$x = Math::String->new('x');
$x->badd('a');			# 24 +1

ok ($x->as_number(),25);
$x->badd(1);			# can't add numbers 
				# ('1' is not a valid Math::String here!)
ok ($x->as_number(),'NaN');

ok ($x->order(),1);		# SIMPLE

$x = Math::String->new('x');
$x->badd( new Math::BigInt (1) ); # 24 +1 = 25
ok ($x,'y');

###############################################################################
# check if new() strips additional sep chars at front/end before caching

foreach (' foo bar ','foo bar ',' foo bar')
  {
  $try = "\$x = Math::String->new('$_',";
  $try .= ' { sep => " ", start => ["foo","bar"] } ); "$x";';
  $rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , 'foo bar' );
  }

##############################################################################
# check if output of bstr is again a valid Math::String
for ($i = 1; $i<42; $i++)
  {
  $try = "\$x = Math::String::from_number($i,['0'..'9']);";
  $try .= "\$x = Math::String->new(\"\$x\",['0'..'9'])->as_number();";
  $rc = eval $try;
  print "# For '$try'\n" if (!ok "$rc" , $i );
  }

##############################################################################
# check overloading of cmp

$try = "\$x = Math::String->new('a'); 'true' if \$x eq 'a';";
$rc = eval $try;
print "# For '$try'\n" if (!ok "$rc" , "true" );

# check wether cmp works for other objects
$try = "\$x = Math::String->new('00',['0'..'9']);";
$try .= "\$y = Math::BigInt->new('10');";
$try .= "'false' if \$x ne \$y;";
$rc = eval $try;
print "# For '$try'\n" if (!ok "$rc" , "false" );

##############################################################################
# check $string->length()

$try = "\$x = Math::String->new('abcde'); \$x->length();";
$rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , 5 );

$try = "\$x = Math::String->new('foo bar foo ',";
$try .= " { sep => ' ', start => ['foo','bar'] } ); \$x->length();";
$rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , 3 );

$try = "\$x = Math::String->new('foo bar ',";
$try .= ' { sep => " ", start => ["foo","bar"] } ); "$x";';
$rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , 'foo bar' );

$try = "\$x = Math::String->new('foobarfoo', ['foo','bar']); \$x->length();";
$rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , 3 );

$try = "\$x = Math::String->new(''); \$x->length();";
$rc = eval $try; print "# For '$try'\n" if (!ok "$rc" , 0 );

##############################################################################
# as_number

$x = Math::String->new('abc'); 
ok (ref($x->as_number()),'Math::BigInt');

##############################################################################
# numify

$x = Math::String->new('abc'); 
ok (ref($x->numify()),''); ok ($x->numify(),731);

##############################################################################
# bzero, binf, bnan, bone

$x = Math::String->new('abc'); $x->bzero();
ok (ref($x),'Math::String'); ok ($x,''); ok ($x->sign(),'+');
$x = Math::String->new('abc'); $x->bnan();
ok (ref($x),'Math::String'); ok_undef ($x->bstr()); ok ($x->sign(),'NaN');
$x = Math::String->new('abc'); $x->binf();
ok (ref($x),'Math::String'); ok_undef ($x->bstr()); ok ($x->sign(),'+inf');

$x = Math::String::bzero(); 
ok (ref($x),'Math::String'); ok ($x,''); ok ($x->sign(),'+');
$x = Math::String::bnan();
ok (ref($x),'Math::String'); ok_undef ($x->bstr()); ok ($x->sign(),'NaN');
$x = Math::String::binf();
ok (ref($x),'Math::String'); ok_undef ($x->bstr()); ok ($x->sign(),'+inf');

$x = Math::String::bone();
ok (ref($x),'Math::String'); ok ($x->bstr(),'a'); ok ($x->sign(),'+');
$x = Math::String::bone(undef,['z'..'a']);
ok (ref($x),'Math::String'); ok ($x->bstr(),'z'); ok ($x->sign(),'+');

##############################################################################
# accuracy/precicison

ok_undef ($Math::String::accuracy);
ok_undef ($Math::String::precision);
ok ($Math::String::div_scale,0);
ok ($Math::String::round_mode,'even');

##############################################################################
# new( { str => 'aaa', num => 123 } );

$x = Math::String->new ( { str => 'aaa', num => 123 } );
ok ($x,'aaa'); ok ($x->as_number(),123); ok ($x->is_valid(),1);
# invalid matching string form is updated (not via ++, since this invalidates
# the cache, and thus syncronizes the two representations)
# This is actually a test of a mis-feature, something that shouldn't work since
# the string is invalid in the first place
$x += 'a'; ok ($x->as_number(),124); ok ($x,'dt'); 

# first/last
$x = Math::String->new('abc');
ok ($x->first(1),'a');
ok ($x->first(2),'aa');
ok ($x->last(1),'z');
ok ($x->last(2),'zz');
# -> and :: syntax
ok (Math::String->first(3),'aaa');
ok (Math::String->last(3),'zzz');
# -> and :: with different charset
ok (Math::String->last(3,[reverse 'a'..'z']),'aaa');
ok (Math::String->last(3,[reverse 'a'..'z']),'aaa');

# check error()
$x = Math::String->new ( { str => 'aaa', num => 123 } ); ok ($x->error(),'');

###############################################################################
# class()
 
$x = Math::String->new('abc');
ok ($x->class(3),26*26*26);
ok ($x->class(0),1);

###############################################################################
# copy() bug with not sharing charset (and inc)
 
my $cs = Math::String::Charset->new( {
  sets => {
   0 => ['a'..'f'],
   1 => ['a'..'f','A'..'F'],
  -1 => ['a'..'f','0'..'3','!','.','?'],
  -2 => ['a'..'f','0'..'3','!','.','?'],
   },
 
  } );
 
$x = Math::String->new('F?',$cs); 
ok (++$x,'aaa');
ok (--$x,'F?');
#$x = Math::String->new('',$cs); $x += 'F?'; 
#ok ($x,'F?');

###############################################################################
# scale() and related stuff

$x = Math::String->new('a'); 
ok_undef ($x->{_scale});
$x->scale(12);
ok ($x->{_set}->{_scale},12);
# not changed:
ok ($x->bstr(),"a");
ok ("$x","a");
# scaled:
ok ($x->as_number(),12);
$x++;
ok ($x->as_number(),24);
ok ("$x", 'b');

$x = Math::String::from_number(2, ['a'..'z']);
ok ($x->as_number(),2);
ok ("$x",'b');

$cs = Math::String::Charset->new(['a'..'z']);
$cs->scale(123);

$x = Math::String::from_number(0,$cs); ok ($x->as_number(),0); ok ($x,'');
$x = Math::String::from_number(123,$cs); ok ($x->as_number(),123); ok ($x,'a');
$x = Math::String::from_number(246,$cs); ok ($x->as_number(),246); ok ($x,'b');
$x = Math::String::from_number(122,$cs); ok ($x->as_number(),0); ok ($x,'');
$x = Math::String::from_number(124,$cs); ok ($x->as_number(),123); ok ($x,'a');

# test that new() => "str, number" => new( str => ..., num => ...) works
$x = Math::String->new('abc', $cs);
my $str = $x->bstr();
my $num = $x->as_number();
$y = Math::String->new( { str => $x->bstr(), num => $x->as_number() }, $cs);

ok ("$x","$y");
ok ($x->as_number(),$y->as_number());

$x->binc(); $y->binc();

ok ("$x","$y");
ok ($x->as_number(),$y->as_number());

# all done

###############################################################################
# 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 1 if !defined $x;
  ok ($x,'undef');
  return 0;
  }

1;

__DATA__
abc:'0'..'9':NaN
abc:'a'..'b':NaN
abc:'a'..'c':abc:18
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)