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