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