1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 69001; 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, '_and'); 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} 61 62# List context. 63 64for (my $i = 0 ; $i <= $#data ; ++ $i) { 65 my ($in0, $in1, $in2, $in3, $out0, $out1) = @{ $data[$i] }; 66 67 my ($x, $y, @got); 68 69 my $test = qq|\$x = $LIB->_new("$in0"); | 70 . qq|\$y = $LIB->_new("$in2"); | 71 . qq|\@got = $LIB->_sand(\$x, "$in1", \$y, "$in3");|; 72 73 eval $test; 74 is($@, "", "'$test' gives emtpy \$\@"); 75 76 cmp_ok(scalar @got, '==', 2, 77 "'$test' gives two output args"); 78 79 # First output arg. 80 81 is(ref($got[0]), $REF, 82 "'$test' first output arg is a $REF"); 83 84 is($LIB->_check($got[0]), 0, 85 "'$test' first output arg is valid"); 86 87 is($LIB->_str($got[0]), $out0, 88 "'$test' first output arg has the right value"); 89 90 SKIP: { 91 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 92 93 isnt(refaddr($got[0]), refaddr($y), 94 "'$test' first output arg is not the third input arg") 95 } 96 97 is(ref($x), $REF, 98 "'$test' first input arg is still a $REF"); 99 100 my $strx = $LIB->_str($x); 101 if ($strx eq $in0 || $strx eq $out0) { 102 pass("'$test' first input value is unmodified or equal" . 103 " to the output value"); 104 } else { 105 fail("'$test' first input value is unmodified or equal" . 106 " to the output value"); 107 diag(" got: '", $strx, "'"); 108 if ($in0 eq $out0) { 109 diag(" expected: '$in0' (first input and output value)"); 110 } else { 111 diag(" expected: '$in0' (first input value) or '$out0'", 112 " (first output value)"); 113 } 114 } 115 116 # Second output arg. 117 118 is(ref($got[1]), "", 119 "'$test' second output arg is a scalar"); 120 121 is($got[1], $out1, 122 "'$test' second output arg has the right value"); 123 124 # Other tests. 125 126 is(ref($y), $REF, 127 "'$test' third input arg is still a $REF"); 128 129 is($LIB->_str($y), $in2, 130 "'$test' third input arg is unmodified"); 131} 132