1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 2985; 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 42can_ok($LIB, '_from_oct'); 43 44my @data; 45 46# Small numbers. 47 48for (my $x = 0; $x <= 255 ; ++ $x) { 49 push @data, [ sprintf("0%o", $x), $x ]; 50} 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} 61close DATAFILE or die "$datafile: can't close file after reading: $!"; 62 63# List context. 64 65for (my $i = 0 ; $i <= $#data ; ++ $i) { 66 my ($in0, $out0) = @{ $data[$i] }; 67 68 my ($x, @got); 69 70 my $test = qq|\@got = $LIB->_from_oct("$in0");|; 71 72 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 73 74 eval $test; 75 is($@, "", "'$test' gives emtpy \$\@"); 76 77 subtest "_from_oct() in list context: $test", sub { 78 plan tests => 4, 79 80 cmp_ok(scalar @got, '==', 1, 81 "'$test' gives one output arg"); 82 83 is(ref($got[0]), $REF, 84 "'$test' output arg is a $REF"); 85 86 is($LIB->_check($got[0]), 0, 87 "'$test' output is valid"); 88 89 is($LIB->_str($got[0]), $out0, 90 "'$test' output arg has the right value"); 91 }; 92} 93 94# Scalar context. 95 96for (my $i = 0 ; $i <= $#data ; ++ $i) { 97 my ($in0, $out0) = @{ $data[$i] }; 98 99 my ($x, $got); 100 101 my $test = qq|\$got = $LIB->_from_oct("$in0");|; 102 103 diag("\n$test\n\n") if $ENV{AUTHOR_DEBUGGING}; 104 105 eval $test; 106 is($@, "", "'$test' gives emtpy \$\@"); 107 108 subtest "_from_oct() in scalar context: $test", sub { 109 plan tests => 3, 110 111 is(ref($got), $REF, 112 "'$test' output arg is a $REF"); 113 114 is($LIB->_check($got), 0, 115 "'$test' output is valid"); 116 117 is($LIB->_str($got), $out0, 118 "'$test' output arg has the right value"); 119 }; 120} 121