1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 41897; 7 8############################################################################### 9# Read and load configuration file and backend library. 10 11use Config::Tiny (); 12 13my $config_file = 'xt/author/lib.ini'; 14my $config = Config::Tiny -> read('xt/author/lib.ini') 15 or die Config::Tiny -> errstr(); 16 17# Read the library to test. 18 19our $LIB = $config->{_}->{lib}; 20 21die "No library defined in file '$config_file'" 22 unless defined $LIB; 23die "Invalid library name '$LIB' in file '$config_file'" 24 unless $LIB =~ /^[A-Za-z]\w*(::\w+)*\z/; 25 26# Load the library. 27 28eval "require $LIB"; 29die $@ if $@; 30 31############################################################################### 32 33can_ok($LIB, '_digit'); 34 35use lib 't'; 36use Math::BigInt::Lib::TestUtil qw< randstr >; 37 38# Generate test data. 39 40my @data; 41 42sub add_test_cases { 43 my $x = shift; 44 my $n = length $x; 45 46 # Digits from right to left (positive index 0 .. N-1). 47 48 for (my $i = 0 ; $i < $n ; ++$i) { 49 my $digit = substr $x, $n - 1 - $i, 1; 50 push @data, [ $x, $i, $digit ]; 51 } 52 53 # Digits from left to right (negative index -1 .. -N). 54 55 for (my $i = -1 ; $i >= -$n ; --$i) { 56 my $digit = substr $x, -1 - $i, 1; 57 push @data, [ $x, $i, $digit ]; 58 } 59} 60 61for (my $x = 0 ; $x <= 100 ; ++ $x) { 62 add_test_cases(sprintf "%u", $x); 63} 64 65for (my $n = 4 ; $n <= 100 ; ++ $n) { 66 add_test_cases(randstr($n, 10)); 67} 68 69# List context. 70 71for (my $i = 0 ; $i <= $#data ; ++ $i) { 72 my ($in0, $in1, $out0) = @{ $data[$i] }; 73 74 my ($x, @got); 75 76 my $test = qq|\$x = $LIB->_new("$in0"); | 77 . qq|\@got = $LIB->_digit(\$x, $in1);|; 78 79 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 80 81 eval $test; 82 is($@, "", "'$test' gives emtpy \$\@"); 83 84 subtest "_digit() in list context: $test", sub { 85 plan tests => 3, 86 87 cmp_ok(scalar @got, "==", 1, 88 "'$test' gives one output arg"); 89 90 is(ref($got[0]), "", 91 "'$test' output arg is a scalar"); 92 93 is($got[0], $out0, 94 "'$test' output arg has the right value"); 95 }; 96} 97 98# Scalar context. 99 100for (my $i = 0 ; $i <= $#data ; ++ $i) { 101 my ($in0, $in1, $out0) = @{ $data[$i] }; 102 103 my ($x, $got); 104 105 my $test = qq|\$x = $LIB->_new("$in0"); | 106 . qq|\$got = $LIB->_digit(\$x, $in1);|; 107 108 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 109 110 eval $test; 111 is($@, "", "'$test' gives emtpy \$\@"); 112 113 subtest "_digit() in scalar context: $test", sub { 114 plan tests => 2, 115 116 is(ref($got), "", 117 "'$test' output arg is a scalar"); 118 119 is($got, $out0, 120 "'$test' output arg has the right value"); 121 }; 122} 123