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