1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 81; 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 17our $LIB = $config->{_}->{lib}; 18 19die "No library defined in file '$config_file'" 20 unless defined $LIB; 21die "Invalid library name '$LIB' in file '$config_file'" 22 unless $LIB =~ /^[A-Za-z]\w*(::\w+)*\z/; 23 24eval "require $LIB"; 25die $@ if $@; 26 27############################################################################### 28 29can_ok($LIB, '_is_one'); 30 31# Generate test data. 32 33my @data; 34 35for (my $x = 0 ; $x <= 10 ; ++ $x) { 36 push @data, [ $x, $x == 1 ]; 37} 38 39for (my $e = 2 ; $e <= 10 ; ++ $e) { 40 my $x = "1" . ("0" x $e); 41 push @data, [ $x, $x == 1 ]; 42} 43 44# List context. 45 46for (my $i = 0 ; $i <= $#data ; ++ $i) { 47 my ($in0, $out0) = @{ $data[$i] }; 48 49 my ($x, @got); 50 51 my $test = qq|\$x = $LIB->_new("$in0"); | 52 . qq|\@got = $LIB->_is_one(\$x);|; 53 54 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 55 56 eval $test; 57 is($@, "", "'$test' gives emtpy \$\@"); 58 59 subtest "_is_one() in list context: $test", sub { 60 plan tests => 3, 61 62 cmp_ok(scalar @got, "==", 1, 63 "'$test' gives one output arg"); 64 65 is(ref($got[0]), "", 66 "'$test' output arg is a scalar"); 67 68 ok($got[0] && $out0 || !$got[0] && !$out0, 69 "'$test' output arg has the right value"); 70 }; 71} 72 73# Scalar context. 74 75for (my $i = 0 ; $i <= $#data ; ++ $i) { 76 my ($in0, $out0) = @{ $data[$i] }; 77 78 my ($x, $got); 79 80 my $test = qq|\$x = $LIB->_new("$in0"); | 81 . qq|\$got = $LIB->_is_one(\$x);|; 82 83 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 84 85 eval $test; 86 is($@, "", "'$test' gives emtpy \$\@"); 87 88 subtest "_is_one() in scalar context: $test", sub { 89 plan tests => 2, 90 91 is(ref($got), "", 92 "'$test' output arg is a scalar"); 93 94 ok($got && $out0 || !$got && !$out0, 95 "'$test' output arg has the right value"); 96 }; 97} 98