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