# -*- mode: perl; -*- use strict; use warnings; use Test::More tests => 1597; ############################################################################### # Read and load configuration file and backend library. use Config::Tiny (); my $config_file = 'xt/author/lib.ini'; my $config = Config::Tiny -> read('xt/author/lib.ini') or die Config::Tiny -> errstr(); # Read the library to test. our $LIB = $config->{_}->{lib}; die "No library defined in file '$config_file'" unless defined $LIB; die "Invalid library name '$LIB' in file '$config_file'" unless $LIB =~ /^[A-Za-z]\w*(::\w+)*\z/; # Load the library. eval "require $LIB"; die $@ if $@; ############################################################################### can_ok($LIB, '_is_even'); use lib 't'; use Math::BigInt::Lib::TestUtil qw< randstr >; # Generate test data. my @data; for (my $x = 0 ; $x <= 100 ; ++ $x) { push @data, [ $x, $x % 2 == 0 ]; } for (my $n = 3 ; $n <= 300 ; ++ $n) { my $x = randstr($n, 10); # random big integer my $b = substr($x, -1, 1) % 2 == 0; push @data, [ $x, $b ]; } # List context. for (my $i = 0 ; $i <= $#data ; ++ $i) { my ($in0, $out0) = @{ $data[$i] }; my ($x, @got); my $test = qq|\$x = $LIB->_new("$in0"); | . qq|\@got = $LIB->_is_even(\$x);|; diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; eval $test; is($@, "", "'$test' gives emtpy \$\@"); subtest "_is_even() in list context: $test", sub { plan tests => 3, cmp_ok(scalar @got, "==", 1, "'$test' gives one output arg"); is(ref($got[0]), "", "'$test' output arg is a scalar"); ok($got[0] && $out0 || !$got[0] && !$out0, "'$test' output arg has the right value"); }; } # Scalar context. for (my $i = 0 ; $i <= $#data ; ++ $i) { my ($in0, $out0) = @{ $data[$i] }; my ($x, $got); my $test = qq|\$x = $LIB->_new("$in0"); | . qq|\$got = $LIB->_is_even(\$x);|; diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; eval $test; is($@, "", "'$test' gives emtpy \$\@"); subtest "_is_even() in scalar context: $test", sub { plan tests => 2, is(ref($got), "", "'$test' output arg is a scalar"); ok($got && $out0 || !$got && !$out0, "'$test' output arg has the right value"); }; }