1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 35945; 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(s) 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, '_xor'); 49 50my @data; 51 52# Small numbers. 53 54for (my $x = 0; $x <= 64 ; ++ $x) { 55 for (my $y = 0; $y <= 64 ; ++ $y) { 56 push @data, [ $x, $y, $x ^ $y ]; 57 } 58} 59 60# Add data in data file. 61 62(my $datafile = $0) =~ s/\.t/.dat/; 63open DATAFILE, $datafile or die "$datafile: can't open file for reading: $!"; 64while (<DATAFILE>) { 65 s/\s+\z//; 66 next if /^#/ || ! /\S/; 67 push @data, [ split /:/ ]; 68} 69close DATAFILE or die "$datafile: can't close file after reading: $!"; 70 71# List context. 72 73for (my $i = 0 ; $i <= $#data ; ++ $i) { 74 my ($in0, $in1, $out0) = @{ $data[$i] }; 75 76 my ($x, $y, @got); 77 78 my $test = qq|\$x = $LIB->_new("$in0"); | 79 . qq|\$y = $LIB->_new("$in1"); | 80 . qq|\@got = $LIB->_xor(\$x, \$y);|; 81 82 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 83 84 eval $test; 85 is($@, "", "'$test' gives emtpy \$\@"); 86 87 subtest "_xor() in list context: $test", sub { 88 plan tests => 9; 89 90 cmp_ok(scalar @got, '==', 1, 91 "'$test' gives one output arg"); 92 93 is(ref($got[0]), $REF, 94 "'$test' output arg is a $REF"); 95 96 is($LIB->_check($got[0]), 0, 97 "'$test' output is valid"); 98 99 is($LIB->_str($got[0]), $out0, 100 "'$test' output arg has the right value"); 101 102 SKIP: { 103 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 104 105 isnt(refaddr($got[0]), refaddr($y), 106 "'$test' output arg is not the second input arg"); 107 } 108 109 is(ref($x), $REF, 110 "'$test' first input arg is still a $REF"); 111 112 if ($LIB->_str($x) eq $in0) { 113 pass("'$test' first input value is unmodified"); 114 } elsif ($LIB->_str($x) eq $out0) { 115 pass("'$test' first input value is the output value"); 116 } else { 117 fail("'$test' first input value is neither unmodified nor the" . 118 " output value"); 119 diag(" got: '", $LIB->_str($x), "'"); 120 if ($in0 eq $out0) { 121 diag(" expected: '$in0' (first input and output value)"); 122 } else { 123 diag(" expected: '$in0' (first input value) or '$out0'", 124 " (output value)"); 125 } 126 } 127 128 is(ref($y), $REF, 129 "'$test' second input arg is still a $REF"); 130 131 is($LIB->_str($y), $in1, 132 "'$test' second input arg is unmodified"); 133 }; 134} 135 136# Scalar context. 137 138for (my $i = 0 ; $i <= $#data ; ++ $i) { 139 my ($in0, $in1, $out0) = @{ $data[$i] }; 140 141 my ($x, $y, $got); 142 143 my $test = qq|\$x = $LIB->_new("$in0"); | 144 . qq|\$y = $LIB->_new("$in1"); | 145 . qq|\$got = $LIB->_xor(\$x, \$y);|; 146 147 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 148 149 eval $test; 150 is($@, "", "'$test' gives emtpy \$\@"); 151 152 subtest "_xor() in scalar context: $test", sub { 153 plan tests => 8; 154 155 is(ref($got), $REF, 156 "'$test' output arg is a $REF"); 157 158 is($LIB->_check($got), 0, 159 "'$test' output is valid"); 160 161 is($LIB->_str($got), $out0, 162 "'$test' output arg has the right value"); 163 164 SKIP: { 165 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 166 167 isnt(refaddr($got), refaddr($y), 168 "'$test' output arg is not the second input arg"); 169 } 170 171 is(ref($x), $REF, 172 "'$test' first input arg is still a $REF"); 173 174 if ($LIB->_str($x) eq $in0) { 175 pass("'$test' first input value is unmodified"); 176 } elsif ($LIB->_str($x) eq $out0) { 177 pass("'$test' first input value is the output value"); 178 } else { 179 fail("'$test' first input value is neither unmodified nor the" . 180 " output value"); 181 diag(" got: '", $LIB->_str($x), "'"); 182 if ($in0 eq $out0) { 183 diag(" expected: '$in0' (first input and output value)"); 184 } else { 185 diag(" expected: '$in0' (first input value) or '$out0'", 186 " (output value)"); 187 } 188 } 189 190 is(ref($y), $REF, 191 "'$test' second input arg is still a $REF"); 192 193 is($LIB->_str($y), $in1, 194 "'$test' second input arg is unmodified"); 195 }; 196} 197