The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More;

use Error::Base;
my $QRTRUE       = $Error::Base::QRTRUE    ;
my $QRFALSE      = $Error::Base::QRFALSE   ;

#----------------------------------------------------------------------------#

my @td  = (
    {
        -case   => 'null',
        -want   => $QRFALSE,
    },
    
    {
        -case   => 'one',
        -args   => [ 0 ],
        -die    => words(qw/ internal error unpaired /),
    },
    
    {
        -case   => 'two',
        -args   => [ 0, 1 ],
    },
    
    {
        -case   => 'three',
        -args   => [ qw/ a b c / ],
        -die    => words(qw/ internal error unpaired /),
    },
    
    {
        -case   => 'four',
        -args   => [ qw/ a b c d / ],
    },
    
);

#----------------------------------------------------------------------------#

my $tc          ;
my $base        = 'Error-Base: _paired(): ';
my $diag        = $base;
my @rv          ;
my $got         ;
my $want        ;

#----------------------------------------------------------------------------#

# Extra-verbose dump optional for test script debug.
my $Verbose     = 0;
#~    $Verbose++;

for (@td) {
    $tc++;
    my %t           = %{ $_ };
    my $case        = $base . $t{-case};
    
    note( "---- $case" );
    subtest $case => sub {
        
        my @args        = eval{ @{ $t{-args} } };
        my $die         = $t{-die};
        my $want        = $t{-want};
        
        $diag           = 'execute';
        @rv             = eval{ Error::Base::_paired(@args) };
        pass( $diag );          # test didn't blow up
#~         note($@) if $@;         # did code under test blow up?
        
        if    ($die) {
            $diag           = 'should throw';
            $got            = $@;
            $want           = $die;
            like( $got, $want, $diag );
        }
        elsif ($want) {
            $diag           = 'return-like';
            $got            = join qq{\n}, @rv;
            like( $got, $want, $diag );
        } 
        else {
            $diag           = 'return-is';
            $got            = join qq{\n}, @rv;
            $want           = join qq{\n}, @args;
            is( $got, $want, $diag );
        };
        
        # Extra-verbose dump optional for test script debug.
        if ( $Verbose >= 1 ) {
            note( 'explain: ', explain \@rv     );
            note( ''                            );
        };
        
    }; ## subtest
}; ## for

#----------------------------------------------------------------------------#

done_testing($tc);
exit 0;

#============================================================================#

sub words {                         # sloppy match these strings
    my @words   = @_;
    my $regex   = q{};
    
    for (@words) {
        $regex  = $regex . $_ . '.*';
    };
    
    return qr/$regex/is;
};

__END__