1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 17739; 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, '_to_base'); 34 35my @data; 36 37my $max = 0x7fffffff; # 2**31-1 (max value for a 32 bit signed int) 38 39# Small numbers and other simple tests. 40 41for (my $x = 0; $x <= 255 ; ++ $x) { 42 push @data, [ $x, 2, sprintf("%b", $x) ]; 43 push @data, [ $x, 8, sprintf("%o", $x) ]; 44 push @data, [ $x, 10, sprintf("%d", $x) ]; 45 push @data, [ $x, 16, sprintf("%X", $x) ]; 46} 47 48my $collseq = '0123456789' # 48 .. 57 49 . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' # 65 .. 90 50 . 'abcdefghijklmnopqrstuvwxyz' # 97 .. 122 51 . '!"#$%&\'()*+,-./' # 33 .. 47 52 . ':;<=>?@' # 58 .. 64 53 . '[\\]^_`' # 91 .. 96 54 . '{|}~'; # 123 .. 126 55 56for my $base (2 .. 94) { 57 58 # Zero is converted to "0", regardless of base and collation sequence. 59 60 push @data, [ "0", $base, "0" ]; 61 push @data, [ "0", $base, $collseq, "0" ]; 62 63 # Increasing integer powers of the base, with a collation sequence of 64 # "01..." gives "1", "10", "100", "1000", ... 65 66 for (my $pow = 0 ; ; $pow++) { 67 my $x = $base ** $pow; 68 last if $x > $max; 69 push @data, [ $x, $base, '1' . ('0' x $pow) ]; 70 push @data, [ $x, $base, $collseq, '1' . ('0' x $pow) ]; 71 } 72 73 # b^n-1 gives a string containing only one or more of the last character in 74 # the collation sequence. E.g., 75 # b = 2, n = 4, 2^4-1 -> "1111" 76 # b = 10, n = 5, 10^5-1 -> "99999" 77 # b = 16, n = 6, 10^6-1 -> "FFFFFF" 78 79 for (my $pow = 1 ; ; $pow++) { 80 my $x = $base ** $pow - 1; 81 last if $x > $max; 82 my $chr = substr $collseq, $base - 1, 1; 83 push @data, [ $x, $base, $chr x $pow ]; 84 push @data, [ $x, $base, $collseq, $chr x $pow ]; 85 } 86} 87 88# "123" in base "10" is "123" 89# "10203" in base "100" is "123" 90# "1002030" in base "1000" is "123" 91# ... 92 93for my $exp (1 .. 100) { 94 my $sep = "0" x ($exp - 1); 95 my $x = join($sep, "1", "2", "3"); 96 my $base = "1" . ("0" x $exp); 97 my $str = "123"; 98 push @data, [ $x, $base, $collseq, $str ]; 99} 100 101{ 102 my $collseq = '-|'; 103 for my $base (2 .. 100) { 104 for (my $pow = 0 ; ; $pow++) { 105 my $x = $base ** $pow; 106 last if $x > $max; 107 my $str = '|' . ('-' x $pow); 108 push @data, [ $x, $base, $collseq, $str ]; 109 } 110 } 111} 112 113# Add data in data file. 114 115(my $datafile = $0) =~ s/\.t/.dat/; 116open DATAFILE, $datafile or die "$datafile: can't open file for reading: $!"; 117while (<DATAFILE>) { 118 s/\s+\z//; 119 next if /^#/ || ! /\S/; 120 push @data, [ split /:/ ]; 121} 122close DATAFILE or die "$datafile: can't close file after reading: $!"; 123 124# List context. 125 126for (my $i = 0 ; $i <= $#data ; ++ $i) { 127 my @in = @{ $data[$i] }; 128 my $out0 = pop @in; 129 130 my ($x, @got); 131 132 # Collation sequence. Make an escaped version for display purposes. 133 134 my ($cs, $csesc); 135 if (@in == 3) { 136 $cs = $in[2]; 137 ($csesc = $cs) =~ s|([\@\$`"\\])|\\$1|g; 138 } 139 140 # We test with the base given as a scalar and as a reference. We also 141 # accept test data with and without a collation sequence. 142 143 for my $base_as_scalar (0, 1) { 144 145 # To avoid integer overflow, don't test with a large, scalar base. 146 147 next if $base_as_scalar && $in[1] > $max; 148 149 my $test = qq|\$x = $LIB->_new("$in[0]");|; 150 $test .= $base_as_scalar ? qq| \$b = $in[1];| 151 : qq| \$b = $LIB->_new("$in[1]");|; 152 $test .= @in == 3 ? qq| \@got = $LIB->_to_base(\$x, \$b, "$csesc")| 153 : qq| \@got = $LIB->_to_base(\$x, \$b)|; 154 155 $x = $LIB->_new($in[0]); 156 $b = $base_as_scalar ? $in[1] 157 : $LIB->_new($in[1]); 158 @got = @in == 3 ? $LIB->_to_base($x, $b, $cs) 159 : $LIB->_to_base($x, $b); 160 161 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 162 163 subtest "_to_base() in list context: $test", sub { 164 plan tests => 3, 165 166 cmp_ok(scalar @got, '==', 1, 167 "'$test' gives one output arg"); 168 169 is(ref($got[0]), "", 170 "'$test' output arg is a scalar"); 171 172 is($got[0], $out0, 173 "'$test' output arg has the right value"); 174 }; 175 } 176} 177 178# Scalar context. 179 180for (my $i = 0 ; $i <= $#data ; ++ $i) { 181 my @in = @{ $data[$i] }; 182 my $out0 = pop @in; 183 184 my ($x, $got); 185 186 # Collation sequence. Make an escaped version for display purposes. 187 188 my ($cs, $csesc); 189 if (@in == 3) { 190 $cs = $in[2]; 191 ($csesc = $cs) =~ s|([\@\$`"\\])|\\$1|g; 192 } 193 194 # We test with the base given as a scalar and as a reference. We also 195 # accept test data with and without a collation sequence. 196 197 for my $base_as_scalar (0, 1) { 198 199 # To avoid integer overflow, don't test with a large, scalar base. 200 201 next if $base_as_scalar && $in[1] > $max; 202 203 my $test = qq|\$x = $LIB->_new("$in[0]");|; 204 $test .= $base_as_scalar ? qq| \$b = $in[1];| 205 : qq| \$b = $LIB->_new("$in[1]");|; 206 $test .= @in == 3 ? qq| \$got = $LIB->_to_base(\$x, \$b, "$csesc")| 207 : qq| \$got = $LIB->_to_base(\$x, \$b)|; 208 209 $x = $LIB->_new($in[0]); 210 $b = $base_as_scalar ? $in[1] 211 : $LIB->_new($in[1]); 212 $got = @in == 3 ? $LIB->_to_base($x, $b, $cs) 213 : $LIB->_to_base($x, $b); 214 215 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 216 217 subtest "_to_base() in scalar context: $test", sub { 218 plan tests => 2, 219 220 is(ref($got), "", 221 "'$test' output arg is a scalar"); 222 223 is($got, $out0, 224 "'$test' output arg has the right value"); 225 }; 226 } 227} 228