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 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# Load the library. 27 28eval "require $LIB"; 29die $@ if $@; 30 31############################################################################### 32 33can_ok($LIB, '_is_zero'); 34 35# Generate test data. 36 37my @data; 38 39for (my $x = 0 ; $x <= 10 ; ++ $x) { 40 push @data, [ $x, $x == 0 ]; 41} 42 43for (my $e = 2 ; $e <= 10 ; ++ $e) { 44 my $x = "1" . ("0" x $e); 45 push @data, [ $x, $x == 0 ]; 46} 47 48# List context. 49 50for (my $i = 0 ; $i <= $#data ; ++ $i) { 51 my ($in0, $out0) = @{ $data[$i] }; 52 53 my ($x, @got); 54 55 my $test = qq|\$x = $LIB->_new("$in0"); | 56 . qq|\@got = $LIB->_is_zero(\$x);|; 57 58 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 59 60 eval $test; 61 is($@, "", "'$test' gives emtpy \$\@"); 62 63 subtest "_is_zero() in list context: $test", sub { 64 plan tests => 3, 65 66 cmp_ok(scalar @got, "==", 1, 67 "'$test' gives one output arg"); 68 69 is(ref($got[0]), "", 70 "'$test' output arg is a scalar"); 71 72 ok($got[0] && $out0 || !$got[0] && !$out0, 73 "'$test' output arg has the right value"); 74 }; 75} 76 77# Scalar context. 78 79for (my $i = 0 ; $i <= $#data ; ++ $i) { 80 my ($in0, $out0) = @{ $data[$i] }; 81 82 my ($x, $got); 83 84 my $test = qq|\$x = $LIB->_new("$in0"); | 85 . qq|\$got = $LIB->_is_zero(\$x);|; 86 87 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 88 89 eval $test; 90 is($@, "", "'$test' gives emtpy \$\@"); 91 92 subtest "_is_zero() in scalar context: $test", sub { 93 plan tests => 2, 94 95 is(ref($got), "", 96 "'$test' output arg is a scalar"); 97 98 ok($got && $out0 || !$got && !$out0, 99 "'$test' output arg has the right value"); 100 }; 101} 102