1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 137; 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, '_check'); 34 35# Generate test data. 36 37my @data; 38 39push @data, ([ "$LIB->_zero()", 1 ], # valid objects 40 [ "$LIB->_one()", 1 ], 41 [ "$LIB->_two()", 1 ], 42 [ "$LIB->_ten()", 1 ]); 43 44for (my $n = 0 ; $n <= 24 ; ++ $n) { 45 push @data, [ qq|$LIB->_new("1| . ("0" x $n) . qq|")|, 1 ]; 46} 47 48push @data, ([ "undef", 0 ], # invalid objects 49 [ "''", 0 ], 50 [ "1", 0 ], 51 [ "[]", 0 ], 52 [ "{}", 0 ]); 53 54# List context. 55 56for (my $i = 0 ; $i <= $#data ; ++ $i) { 57 my ($in0, $out0) = @{ $data[$i] }; 58 59 my ($x, @got); 60 61 my $test = qq|\$x = $in0; | 62 . qq|\@got = $LIB->_check(\$x);|; 63 64 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 65 66 eval $test; 67 is($@, "", "'$test' gives emtpy \$\@"); 68 69 subtest "_check() in list context: $test", sub { 70 plan tests => 3, 71 72 cmp_ok(scalar @got, "==", 1, 73 "'$test' gives one output arg"); 74 75 is(ref($got[0]), "", 76 "'$test' output arg is a scalar"); 77 78 if ($out0) { # valid object 79 ok(! $got[0], "'$test' output arg is false (object OK)") 80 or diag(" got: $got[0]\n expected: (something false)"); 81 } else { # invalid object 82 ok($got[0], "'$test' output arg is true (object not OK)") 83 or diag(" got: $got[0]\n expected: (something true)"); 84 } 85 }; 86} 87 88# Scalar context. 89 90for (my $i = 0 ; $i <= $#data ; ++ $i) { 91 my ($in0, $out0) = @{ $data[$i] }; 92 93 my ($x, $got); 94 95 my $test = qq|\$x = $in0; | 96 . qq|\$got = $LIB->_check(\$x);|; 97 98 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 99 100 eval $test; 101 is($@, "", "'$test' gives emtpy \$\@"); 102 103 subtest "_check() in scalar context: $test", sub { 104 plan tests => 2, 105 106 is(ref($got), "", 107 "'$test' output arg is a scalar"); 108 109 if ($out0) { # valid object 110 ok(! $got, "'$test' output arg is false (object OK)") 111 or diag(" got: $got\n expected: (something false)"); 112 } else { # invalid object 113 ok($got, "'$test' output arg is true (object not OK)") 114 or diag(" got: $got\n expected: (something true)"); 115 } 116 }; 117} 118