1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 7705; 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# Read the reference type the library uses. 27 28our $REF = $config->{_}->{ref}; 29 30die "No reference type defined in file '$config_file'" 31 unless defined $REF; 32die "Invalid reference type '$REF' in file '$config_file'" 33 unless $REF =~ /^[A-Za-z]\w*(::\w+)*\z/; 34 35# Load the library. 36 37eval "require $LIB"; 38die $@ if $@; 39 40############################################################################### 41 42my $scalar_util_ok = eval { require Scalar::Util; }; 43Scalar::Util -> import('refaddr') if $scalar_util_ok; 44 45diag "Skipping some tests since Scalar::Util is not installed." 46 unless $scalar_util_ok; 47 48can_ok($LIB, '_add'); 49 50my @data; 51 52# Small numbers. 53 54for (my $x = 0; $x <= 24 ; ++ $x) { 55 for (my $y = 0; $y <= 24 ; ++ $y) { 56 push @data, [ $x, $y, $x + $y ]; 57 } 58} 59 60# 9 + 11, 99 + 101, 999 + 1001, 9999 + 1001, ... 61 62for (my $p = 1; $p <= 50 ; ++ $p) { 63 my $x = "9" x $p; 64 my $y = "1" . ("0" x ($p - 1)) . "1"; 65 my $z = "2" . ("0" x $p); 66 push @data, [ $x, $y, $z ]; 67} 68 69# 9 + 9, 99 + 99, 999 + 999, 9999 + 9999, ... 70 71for (my $p = 1; $p <= 50 ; ++ $p) { 72 my $x = "9" x $p; 73 my $z = "1" . ("9" x ($p - 1)) . "8"; 74 push @data, [ $x, $x, $z ]; 75} 76 77# Powers of 10. 78 79for (my $p = 0; $p <= 24 ; ++ $p) { 80 for (my $q = 0; $q <= 24 ; ++ $q) { 81 my $x = "1" . ("0" x $p); 82 my $y = "1" . ("0" x $q); 83 my ($max, $min) = $p > $q ? ($p, $q) : ($q, $p); 84 my $z = "1" . ("0" x $max); 85 substr($z, -1 - $min, 1) = substr($z, -1 - $min, 1) + 1; 86 push @data, [ $x, $y, $z ]; 87 } 88} 89 90# Add data in data file. 91 92(my $datafile = $0) =~ s/\.t/.dat/; 93open DATAFILE, $datafile or die "$datafile: can't open file for reading: $!"; 94while (<DATAFILE>) { 95 s/\s+\z//; 96 next if /^#/ || ! /\S/; 97 push @data, [ split /:/ ]; 98} 99close DATAFILE or die "$datafile: can't close file after reading: $!"; 100 101# List context. 102 103for (my $i = 0 ; $i <= $#data ; ++ $i) { 104 my ($in0, $in1, $out0) = @{ $data[$i] }; 105 106 my ($x, $y, @got); 107 108 my $test = qq|\$x = $LIB->_new("$in0"); | 109 . qq|\$y = $LIB->_new("$in1"); | 110 . qq|\@got = $LIB->_add(\$x, \$y);|; 111 112 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 113 114 eval $test; 115 is($@, "", "'$test' gives emtpy \$\@"); 116 117 subtest "_add() in list context: $test", sub { 118 plan tests => 9; 119 120 cmp_ok(scalar @got, '==', 1, 121 "'$test' gives one output arg"); 122 123 is(ref($got[0]), $REF, 124 "'$test' output arg is a $REF"); 125 126 is($LIB->_check($got[0]), 0, 127 "'$test' output is valid"); 128 129 is($LIB->_str($got[0]), $out0, 130 "'$test' output arg has the right value"); 131 132 SKIP: { 133 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 134 135 isnt(refaddr($got[0]), refaddr($y), 136 "'$test' output arg is not the second input arg"); 137 } 138 139 is(ref($x), $REF, 140 "'$test' first input arg is still a $REF"); 141 142 ok($LIB->_str($x) eq $out0 || $LIB->_str($x) eq $in0, 143 "'$test' first input arg has the correct value"); 144 145 is(ref($y), $REF, 146 "'$test' second input arg is still a $REF"); 147 148 is($LIB->_str($y), $in1, 149 "'$test' second input arg is unmodified"); 150 }; 151} 152 153# Scalar context. 154 155for (my $i = 0 ; $i <= $#data ; ++ $i) { 156 my ($in0, $in1, $out0) = @{ $data[$i] }; 157 158 my ($x, $y, $got); 159 160 my $test = qq|\$x = $LIB->_new("$in0"); | 161 . qq|\$y = $LIB->_new("$in1"); | 162 . qq|\$got = $LIB->_add(\$x, \$y);|; 163 164 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 165 166 eval $test; 167 is($@, "", "'$test' gives emtpy \$\@"); 168 169 subtest "_add() in scalar context: $test", sub { 170 plan tests => 8; 171 172 is(ref($got), $REF, 173 "'$test' output arg is a $REF"); 174 175 is($LIB->_check($got), 0, 176 "'$test' output is valid"); 177 178 is($LIB->_str($got), $out0, 179 "'$test' output arg has the right value"); 180 181 SKIP: { 182 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 183 184 isnt(refaddr($got), refaddr($y), 185 "'$test' output arg is not the second input arg"); 186 } 187 188 is(ref($x), $REF, 189 "'$test' first input arg is still a $REF"); 190 191 ok($LIB->_str($x) eq $out0 || $LIB->_str($x) eq $in0, 192 "'$test' first input arg has the correct value"); 193 194 is(ref($y), $REF, 195 "'$test' second input arg is still a $REF"); 196 197 is($LIB->_str($y), $in1, 198 "'$test' second input arg is unmodified"); 199 }; 200} 201